diff -Nru rmatrix-1.6-1.1/ChangeLog rmatrix-1.6-5/ChangeLog --- rmatrix-1.6-1.1/ChangeLog 2015-04-29 16:14:56.000000000 +0000 +++ rmatrix-1.6-5/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,5087 +0,0 @@ -2015-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 diff -Nru rmatrix-1.6-1.1/DESCRIPTION rmatrix-1.6-5/DESCRIPTION --- rmatrix-1.6-1.1/DESCRIPTION 2023-09-18 17:40:02.000000000 +0000 +++ rmatrix-1.6-5/DESCRIPTION 2024-01-11 17:50:15.000000000 +0000 @@ -1,6 +1,7 @@ Package: Matrix -Version: 1.6-1.1 -Date: 2023-09-08 +Version: 1.6-5 +VersionNote: do also bump src/version.h, inst/include/Matrix/version.h +Date: 2024-01-06 Priority: recommended Title: Sparse and Dense Matrix Classes and Methods Description: A rich hierarchy of sparse and dense matrix classes, @@ -34,14 +35,14 @@ comment = "base R's matrix implementation")) Depends: R (>= 3.5.0), methods Imports: grDevices, graphics, grid, lattice, stats, utils -Suggests: MASS, datasets, sfsmisc +Suggests: MASS, datasets, sfsmisc, tools Enhances: SparseM, graph LazyData: no LazyDataNote: not possible, since we use data/*.R and our S4 classes BuildResaveData: no Encoding: UTF-8 NeedsCompilation: yes -Packaged: 2023-09-08 10:37:27 UTC; maechler +Packaged: 2024-01-11 08:36:29 UTC; maechler Author: Douglas Bates [aut] (), Martin Maechler [aut, cre] (), Mikael Jagan [aut] (), @@ -56,4 +57,4 @@ R Core Team [ctb] (base R's matrix implementation) Maintainer: Martin Maechler Repository: CRAN -Date/Publication: 2023-09-18 17:40:02 UTC +Date/Publication: 2024-01-11 17:50:15 UTC diff -Nru rmatrix-1.6-1.1/LICENCE rmatrix-1.6-5/LICENCE --- rmatrix-1.6-1.1/LICENCE 2016-04-09 21:43:46.000000000 +0000 +++ rmatrix-1.6-5/LICENCE 2023-10-25 18:30:15.000000000 +0000 @@ -1,38 +1,37 @@ -Copyrights -========== -The Matrix package, an R package, available from CRAN or R-forge, -consists of basically two parts. +R package Matrix is developed on R-Forge and released on CRAN. It has +two components: -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 +1. The source code of Matrix, excluding external libraries, is contained + primarily in R/*.R, src/*.[ch] (excluding cs.[ch]), man/*.Rd, tests/*.R, vignettes/*.Rnw, + inst/*.R, and inst/include/*. It is licensed under the GNU GPL, + version 3, pasted below. The files were created and are maintained + by Douglas Bates, Martin Maechler, and Mikael Jagan, hence they are: + + Copyright (C) 1999-2020 Douglas Bates, Martin Maechler + Copyright (C) 2021-2023 Douglas Bates, Martin Maechler, Mikael Jagan + +2. Matrix contains patched versions of external libraries CSparse, AMD, + COLAMD, and CHOLMOD, all from the SuiteSparse collection of Timothy + A. Davis. AMD and COLAMD use the BSD 3-clause licence. CSparse and + modules Check, Cholesky, and Core of CHOLMOD use the GNU LGPL licence, + version 2.1 or greater. Modules MatrixOps, Modify, and Supernodal of + CHOLMOD use the GNU GPL licence, version 2 or greater. Licence files + and copyrights are copied under inst/doc/SuiteSparse. + +Douglas M. Bates +University of Wisconsin-Madison +bates@stat.wisc.edu + +Martin Maechler +ETH Zurich +maechler@stat.math.ethz.ch | maechler@r-project.org + +Mikael Jagan +McMaster University +jaganmn@mcmaster.ca - 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 +The following is obtained from http://www.gnu.org/licenses/gpl-3.0.txt : --------------------------------------- GNU GENERAL PUBLIC LICENSE diff -Nru rmatrix-1.6-1.1/MD5 rmatrix-1.6-5/MD5 --- rmatrix-1.6-1.1/MD5 2023-09-18 17:40:02.000000000 +0000 +++ rmatrix-1.6-5/MD5 2024-01-11 17:50:15.000000000 +0000 @@ -1,86 +1,77 @@ -675a3a48a357cb2ee05ed285387b3e85 *ChangeLog -c08385c1c188776e7860eabc52f6a864 *DESCRIPTION -49c7113b5e0e4fbf269132f6a5ff5b06 *LICENCE -a0b1f4e2fffe7a374106106e95c8870c *NAMESPACE -e14b682dccbb80e2bf623a3d34fae07f *R/AllClass.R -4c8d6a5b81402278d7a094a260257777 *R/AllGeneric.R -58b0da3c35dec835dbcdd772f6197200 *R/Auxiliaries.R -64b6b32d567e525a710df88663cf5716 *R/BunchKaufman.R -11e1dfe81dd2885ae4fc521307636ce7 *R/Csparse.R -a4e42ef826f0deaef299125fa813e9a0 *R/HBMM.R -b5e036402e2ab43a18489b9833c9b7e7 *R/Hilbert.R +dead28547ab9f4749a4630fa7e7881e4 *DESCRIPTION +7866cc186e8ad4d6a243c271f64c13fc *LICENCE +ba6604808100abfe8137ad02b0a04f22 *NAMESPACE +d641435295187325a3663988363105bb *R/AllClass.R +41bdc701502b0096f23a48bde2df7b89 *R/AllGeneric.R +863a228d6948c7e1f0efddb4e0fef824 *R/Auxiliaries.R +94b926ced0ed00c0fd056996865155e0 *R/BunchKaufman.R +f20a1e47661e7bf1ea1ffd0dbc145b3a *R/HBMM.R 7acb17192c1c08969822defdd531e35a *R/KhatriRao.R -bfebb90c9cbe5506b0f4a948dc483920 *R/LU.R -8e0b48f68deafcef6eafbf6ba1ad1563 *R/Math.R -41345fee62f4eccd297259c07d270f7b *R/Matrix.R -db5077c13f6bf0b8e7c56e565c00449e *R/MatrixFactorization.R -f60e6ff5c239f081f83e4f4446130cf9 *R/Ops.R -65567af80a9ea6b6ed1b4c2d92542ff7 *R/Rsparse.R +17d0f339b9cd030f13ffc873abde414b *R/LU.R +383391d5e4d12c4c7369abb1990b6b21 *R/Math.R +72a0d8605a295bf56528b844cf59e313 *R/Ops.R 85747aff2573a899b697e2e727120871 *R/SparseM-conv.R -e8e62295fcc919b8a0cce1a12a4441da *R/Summary.R -39a9552c978693810274ec0a96561e56 *R/Tsparse.R +b20351ebc9920c3528219fcc5522f61c *R/Summary.R e0e755ece77810961adf04e91b70230d *R/abIndex.R -4291427447f389de411d421760c6d9bb *R/bandSparse.R -19d707321ebef038faf65306d45fccad *R/bind2.R -3f019415bc3d94223a40f65caee2d2a1 *R/chol.R -50650b1d921b83409cb2967d55c116de *R/coerce.R -9e8b3f2c64ebada9e49fee3ba6339d81 *R/colSums.R +e2d05abaf1f4ebbe1adda99af6863935 *R/all.equal.R +0a3d332743633e23f1f178098be0d5d6 *R/bind2.R +5ba76f2df9a7550ba8762851525fad7f *R/chol.R +9a8bce4a85126b3b3935cdd890ef5bf8 *R/coerce.R +4b3415e4af41dabcbd6048b32280ec29 *R/colSums.R 73f70ce30c4eb94c71d69d824173f8e3 *R/condest.R -385d49abbad3204f9366c7a811f9c4f2 *R/corMatrix.R -9553e4e6794485a47d8936fc3ccba904 *R/denseMatrix.R -48ef1a0bf291282e175ab774a1d14ab7 *R/determinant.R -bc969b71916b43f01a1250b5100c1f70 *R/diagMatrix.R -2a657f0fba86dd942e0b6e05e00a220f *R/dpoMatrix.R -236cd388f8f3f3d6b3a9992a9e906630 *R/dppMatrix.R -bc798f5b87ff89d6052f5e3c74e9207d *R/eigen.R -5dd0f09ac5fa75fbd73f037be77aa402 *R/expm.R -12c4f7baaeea2367df393daf3f5f27ea *R/graph-conv.R -1fbb52146d532d05599db87cc711f1a1 *R/image.R -50a4cee1c5733eaff382eb5aa969663f *R/indMatrix.R -b37364eafcd7a4cf7d2161ad393c8141 *R/is.na.R -5a8aa005abd565123e5dfe3d7c5b6a3e *R/kronecker.R -f26e351d881e373de6ee9fd543c168e0 *R/nearPD.R -eadbe1b23d0b7a33e15565095ee856bc *R/nnzero.R -e6105d14670f0a5e4c3e7b25be79a439 *R/norm.R -819404b4548585bcdfd85f8e09b75843 *R/not.R -4f9b4b6f92ade7ec38929ba3ccfdf43d *R/pMatrix.R -5d38166cdae06444c3050e1904376859 *R/packedMatrix.R -1acdbfecae349fc2ed8f527fc6342cf8 *R/products.R -8f6f722f646ec48cde32970ffbe0a270 *R/qr.R -24205505bb16c0c69bfe8ede4aad871e *R/rankMatrix.R -2524e4f2891176413856a8164315156c *R/rcond.R -3890dacd4dadf9faa2bedd913d8a3094 *R/solve.R -5ec057b00db2ef07b6a7f046f98d6257 *R/spModels.R -cc7f10350a6e0beaed88a4ac7d786584 *R/sparseMatrix.R -d19258800f8d88020f45242668cd9be3 *R/sparseVector.R -569d1895b06e013dfd5ab8b0ce2245a0 *R/subscript.R -9b0dbf3a2d786281c296f4c481668694 *R/symmetricMatrix.R -a56240d3b31a3ca8fa70f764fdb03fd9 *R/triangularMatrix.R -7c3eb913cecc4680447e85661fae48aa *R/unpackedMatrix.R -c6ad8e3b932b94de630d596cb361bbb7 *R/which.R -be1ad5896fedbf6748718db7d69590ea *R/zzz.R -49115eb7869f01b8f0e0c27ee8ca1eab *TODO -7080893e02c49cd296d4424b9be55069 *build/partial.rdb -2963dae5b1cf6830db2b64b70801b1af *build/vignette.rds -f2ad5375e270deeb7b041272dd095032 *cleanup +a848a0850272aac7b5562d679adaea69 *R/construct.R +dc61ddb7ae05aa3133071ba579837c72 *R/denseMatrix.R +79c09a13e4d88aaaf9a55735543441c5 *R/determinant.R +629d04a285348773c4e8bd34308d33cc *R/diagMatrix.R +067989137256de2d8e537d40471aa47a *R/dim.R +6b2a21f53902ea2a062e9b97895ed5a5 *R/eigen.R +8d5d3c7b32c7b9f7d7eebc1be0d76220 *R/expm.R +ab5cc27deac115816214f76aa0ec9bdd *R/graph-conv.R +cc55b09add598ed7fe8c723a5c630b52 *R/image.R +dc8d8f51145233a1d0141dfef262f275 *R/indMatrix.R +ee20f86a83c09162cce6a92ea40b121d *R/is.na.R +bea101095f5f5c9b4705c11056440108 *R/kappa.R +618b44c13d0f660e8a6b91917593f007 *R/kronecker.R +8befb12aeaaa31bc53817f73d4528381 *R/nearPD.R +b3fcccad9e9f23904619a072016db501 *R/nnzero.R +830390da54d850cdb68ce2c47c0de55e *R/not.R +a165f9f3e6f7474e247d42e7b8414fcf *R/objects.R +66c8030926759f87234d58628bafe364 *R/perm.R +3da7275623f7bf2d32d28276a511f765 *R/posdef.R +f77336ef6dbc816ab069a90d482728d9 *R/products.R +3c12768b00d5e2845f55d13c4b00b188 *R/qr.R +49a56dab6ff6e6a943dda3bb4ccf46b7 *R/rankMatrix.R +eb631f40e60461240c94a9eeee347e64 *R/show.R +89b8a1434e8109b332810c2d0d0d6542 *R/solve.R +31b8d3853f6bed848a0714af7e9f94df *R/spModels.R +8418d68302196cfa3f2380a94e4d2a35 *R/sparseMatrix.R +768e95dd230030db02fa41b83c54e37f *R/sparseVector.R +64f26baaf7096cf33df4aaefd58be4d7 *R/subassign.R +e79d7adbfcc224017905e2d9c3306bc3 *R/subscript.R +4e983e0d3d1a87f0e9058bc9cf0b6143 *R/which.R +4b678c1d95b4f8a0f5dd259904ba6bfa *R/zzz.R +af387b75c02032478c85023d8e53cf37 *build/Matrix.pdf +4f3dda2ade8b34ae0296685e81dfc10a *build/stage23.rdb +75b445cb0f3b5549d3132a7236c6d050 *build/vignette.rds +afeec9c25bf3c232f8567ee3f27cf0f6 *cleanup 9f8e37cf17a5d4811d0c28f07148cf7d *data/CAex.R c60c038f2c6d15c5303d81330991c838 *data/KNex.R d6193dad1031a61ebc3d3e38fabd252d *data/USCounties.R 0d65337740b3914f535239cbe6e8a2df *data/datalist a40150a1c71deabec67e61af2b8f7e38 *data/wrld_1deg.R -cdb4729e93f876763153ec2463edb6bd *inst/NEWS.Rd +f4f31b32389050a5f38097160a185de7 *inst/NEWS.Rd d1092f2de709b554fb06b516ee00a885 *inst/doc/Comparisons.R f6c9e4986022f1db4c085b8429d06fca *inst/doc/Comparisons.Rnw -0831b8fa6a31497374fd262e81dd0156 *inst/doc/Comparisons.pdf +1c06a154d9826ce6b0ea20a7786a2bc1 *inst/doc/Comparisons.pdf 3f45bdb5515081392d14b87f4770cb2b *inst/doc/Design-issues.R 2bd2896847fb11eaf102158b8696c884 *inst/doc/Design-issues.Rnw -e22d7f34aeed6a113be34ff5e010b686 *inst/doc/Design-issues.pdf +4d96b8c1ac1f86a3cc193b08b38b53e7 *inst/doc/Design-issues.pdf 3f87d045a10e0afc85a3385bab8f215b *inst/doc/Intro2Matrix.R 448278dab638a78df6eb59270772cbe2 *inst/doc/Intro2Matrix.Rnw -a20abe395eeb95c1d62442d428de4887 *inst/doc/Intro2Matrix.pdf +ddaf6aedae6a73934bdd9c234a6c6d88 *inst/doc/Intro2Matrix.pdf 1a59a7d3257a30349a5e10285ea05a69 *inst/doc/Introduction.R c39a26dfe7ccaafd044e88468155b153 *inst/doc/Introduction.Rnw -3e001d6267967d2b4b948702c83748e4 *inst/doc/Introduction.pdf +506df511b5cfdb6b51d965a19f8997f9 *inst/doc/Introduction.pdf 20ced7019f5a55639aa1af1a2dfa1057 *inst/doc/SuiteSparse/AMD.txt facc21d5bf9bcbf3e57a8b3c7bd1caa0 *inst/doc/SuiteSparse/CHOLMOD.txt a6693872cf6e74e758f3fa327c606fec *inst/doc/SuiteSparse/COLAMD.txt @@ -88,7 +79,7 @@ c7da19803d926fe0e3604c08bedfb3c5 *inst/doc/SuiteSparse/SuiteSparse_config.txt e4e486aee6a99cb21909bb6de32db68d *inst/doc/sparseModels.R 813e0c8cc7a5f7ecff43e5882270a431 *inst/doc/sparseModels.Rnw -0743341434e08d7b802e6a25e1e412e5 *inst/doc/sparseModels.pdf +635d7015f327e21d48f20a6dbd079a1c *inst/doc/sparseModels.pdf dcd11f6947f910f743254824e930b2c7 *inst/external/CAex_slots.rda be886d6bb832210bb654b9ad064fe0ff *inst/external/KNex_slots.rda 90f019ec81e67d7f3542f7ca39bf3f2d *inst/external/USCounties_slots.rda @@ -103,168 +94,175 @@ 697db4242eb44425ce2550fafdc957a8 *inst/external/utm300.rua ca51a0b8b76e7ea3e7881cc8da1390b1 *inst/external/wrld_1deg_slots.rda 5ce5ea63a73e4641173fe37b6a809a01 *inst/external/wrong.mtx -1234c967fd63e727027e38ec6e1f526d *inst/include/Matrix.h -e44c6f2df3e4f633d3755053cef8f993 *inst/include/Matrix_stubs.c -325cf24198f5841f74fae8cd06c3ac26 *inst/include/cholmod.h -5984cc7e4745b2d6729174d2b76cb814 *inst/po/de/LC_MESSAGES/Matrix.mo -12819f9a2f814431414af8eb2bb8ac7d *inst/po/de/LC_MESSAGES/R-Matrix.mo -89cdf80bd3c78c452d2f2e2258c420d3 *inst/po/en@quot/LC_MESSAGES/Matrix.mo -9d369cb6c861e5866e1e916c1195a57f *inst/po/en@quot/LC_MESSAGES/R-Matrix.mo -25d31d83d8b9d4feb3e7cc92f1e40af8 *inst/po/fr/LC_MESSAGES/Matrix.mo -78b115a3ca25e2a60064bff872604303 *inst/po/fr/LC_MESSAGES/R-Matrix.mo -dea834b0df25c9b9b95485c833168cf4 *inst/po/it/LC_MESSAGES/Matrix.mo -4c192700dd62a1e6021a7a6d1ecabe4b *inst/po/it/LC_MESSAGES/R-Matrix.mo -a5808137c897bb6e99263812f37cefe0 *inst/po/ko/LC_MESSAGES/Matrix.mo -082e7797ffed9ce7bdd0228f0b1e7860 *inst/po/ko/LC_MESSAGES/R-Matrix.mo -ea5cf73f875449609da2e7cc07a9d783 *inst/po/lt/LC_MESSAGES/Matrix.mo -63a7b43a7a099516a4d56c0123cbf7cf *inst/po/lt/LC_MESSAGES/R-Matrix.mo -36583d101fb5cf03a056acb37cd06d9f *inst/po/pl/LC_MESSAGES/Matrix.mo -33742611bd067539d33f73d9eec555c9 *inst/po/pl/LC_MESSAGES/R-Matrix.mo -3c1f83c7d331c9013a3435ab8a35984b *inst/test-tools-1.R -5e24110ea94130585e6455fba903eea1 *inst/test-tools-Matrix.R +9a7e9eac66c8e2e4f302ef50e52e7a56 *inst/include/Matrix.h +393d17634a64d5414c62d83cb4b05764 *inst/include/Matrix/Matrix.h +a8f80507036f68ab0180c36e4d874abd *inst/include/Matrix/alloca.h +9453d69ed641a1842043a4b28b677784 *inst/include/Matrix/cholmod-utils.h +573270a60b73ad502ab087e00bb22d91 *inst/include/Matrix/cholmod.h +851b528969721a8bfa532fd9ec412642 *inst/include/Matrix/remap.h +60c91702300acb03cf57dfda5fc26a56 *inst/include/Matrix/stubs.c +7cd2c1c3b9a38364f561a7ae0ff84c3d *inst/include/Matrix/version.h +7d96680b80f7792dda638a3900abab51 *inst/include/Matrix_stubs.c +521f406135ff54057933d9a152482ec7 *inst/include/cholmod.h +f16fb9f317d02aa9f4b0423532a2826c *inst/po/de/LC_MESSAGES/Matrix.mo +e64d7f98b7b164d7519ae7f385ad91ba *inst/po/de/LC_MESSAGES/R-Matrix.mo +283a18fda23fb8628c5e3f8cad1ec439 *inst/po/en@quot/LC_MESSAGES/Matrix.mo +1b3fd5aba1569b97f681c07f53a1453d *inst/po/en@quot/LC_MESSAGES/R-Matrix.mo +215caefb1c998a6ee9fc101523c1b30c *inst/po/fr/LC_MESSAGES/Matrix.mo +205f3b581952a8f3ddbc4d4cafa59ba4 *inst/po/fr/LC_MESSAGES/R-Matrix.mo +aa7f2b397344536699a2bb3a3164f2da *inst/po/it/LC_MESSAGES/Matrix.mo +648f3d77497c576252e81fa04d8ca03c *inst/po/it/LC_MESSAGES/R-Matrix.mo +ec0e2a979284da186be81f9103a684bb *inst/po/ko/LC_MESSAGES/Matrix.mo +d06bf95a913cc6981ddc8d7c7c870b7f *inst/po/ko/LC_MESSAGES/R-Matrix.mo +936d175c18f4fb816fa4a4970bc39367 *inst/po/lt/LC_MESSAGES/Matrix.mo +b4d9022d77514c2a71fc5692ac69c80e *inst/po/lt/LC_MESSAGES/R-Matrix.mo +8e3ad6e4b476f6bea60a6a5429dd20b7 *inst/po/pl/LC_MESSAGES/Matrix.mo +71c78aeb12f673f7e0665cc97cec9c76 *inst/po/pl/LC_MESSAGES/R-Matrix.mo +5d9af34027b624cf8ec958cbfdfe915b *inst/test-tools-1.R +53816ab0f5d228096e37b3aaa3bd6fc0 *inst/test-tools-Matrix.R c54af18acaf2a18fad0cfe5f4fe54e83 *inst/test-tools.R 2f258fd7ae54ca8e0c16d7538fb1810e *man/BunchKaufman-class.Rd cefbc46d17630ba3c2a013206b741886 *man/BunchKaufman-methods.Rd ea7ad17e8de043439cfdeebbb25ff032 *man/CAex.Rd -92742aec0dd21a1508adef2bfd9e52e9 *man/CHMfactor-class.Rd +7e59df3e663ffc1d92e78307739b3339 *man/CHMfactor-class.Rd c867760baa3dee3b88eae2f615327b15 *man/Cholesky-class.Rd -fbd370e8aa1ad5050546229386262c29 *man/Cholesky.Rd -8a49b2c342c55bdc6f73eef0c3ca933f *man/CsparseMatrix-class.Rd +fad43eb7e5b857b535f8cdeeb7f72c46 *man/Cholesky.Rd +967b9180ff69515cf75eeabd0212cc0f *man/CsparseMatrix-class.Rd bec00d32ab2f01ac1a0c10b85bf3508b *man/Diagonal.Rd 0cf81d62916c9f84c70bb3df8bac66f6 *man/Hilbert.Rd 245096209777000baa3d711f452beed0 *man/KNex.Rd 766bcb9db86ea1733136c73bdeb29508 *man/KhatriRao.Rd -b12c4f8ab2d04728448c2a2635999ea7 *man/LU-class.Rd -caf90021f211e90e115958945562fd7c *man/Matrix-class.Rd +b738442c0f0993f176337480e48b9d0d *man/LU-class.Rd +a0a7ddddbe42a96656fcf174d7644ae5 *man/Matrix-class.Rd 27640f6262dab5c41f35014d291dbe19 *man/Matrix-defunct.Rd -4d9be62c8790f355f65a91d04b7aa029 *man/Matrix-deprecated.Rd +f76b61291a35e0f638d309a32a70e376 *man/Matrix-deprecated.Rd 598516534cf2b915ff341b4d63aad61d *man/Matrix.Rd 3c4bf32296b8480193fe30125bca1bb5 *man/MatrixClass.Rd bd3dce068f6b3cc626dd331fd21f873e *man/MatrixFactorization-class.Rd -933982f4da0c6fce86099214626fc49b *man/RsparseMatrix-class.Rd +9342c1c4c46385d83ba6e153e98f93cb *man/RsparseMatrix-class.Rd 64047cfd57b039ebfe665176bbd6556e *man/Schur-class.Rd bb8e14699a2db8acd01a2b1383aadaed *man/Schur.Rd d7da791c3f651790bd3762ceb2426c3c *man/SparseM-conv.Rd 5a159696cf62f4098a1fc9c28d84a7d3 *man/Subassign-methods.Rd -0d51dfb333e9352392a29771f98caf5b *man/TsparseMatrix-class.Rd +afc8dc11f750be8e2baeb2f250502829 *man/TsparseMatrix-class.Rd 878b685a8830a6a9b246e271f08de034 *man/USCounties.Rd -ddecea358ff45f4b0b738cd5b7a11255 *man/Xtrct-methods.Rd +e8742ccaf058cc44a9482cbcdfd50e2f *man/Xtrct-methods.Rd 3de3d37c17171bf90a417615ee83d74b *man/abIndex-class.Rd fcc83ecd00de345e89e3f4fd51544255 *man/abIseq.Rd -87a81e6ff6a73c851b97caa172f46f8e *man/all-methods.Rd -94d835202a4b3b12d68c4a0ff99f041a *man/all.equal-methods.Rd +2b6cb5615438cdc36e89f5b96ff94baf *man/all.equal-methods.Rd 2b5d4a17103a74dd33b0d68b5a35b3b5 *man/atomicVector-class.Rd -359d60fea87181e17bd5ce481b9fe075 *man/band.Rd +6648de3757eb262eb643c87f2d1945bd *man/band.Rd bdbedf88db3709b91fee02404f570928 *man/bandSparse.Rd 0a71443575762f0c15fed79a880e117a *man/bdiag.Rd -4fbba0ea950cc80ab50a1ceae1786a84 *man/boolean-matprod.Rd -8820bdc7063dbab1939d539e2047ff90 *man/cBind.Rd +d9c43ef03b0db490d2548c4889c0ce1b *man/boolean-matprod.Rd +d4d34696eceef2a9fb972a1db930f0a2 *man/cBind.Rd ae7ee7c0dd1c9f4181623dae808f4fe8 *man/chol.Rd -7e249821d5861ea698383a8ffbdb31bf *man/chol2inv-methods.Rd +93ca58a43078f2cf5f20f0dcd586d63e *man/chol2inv-methods.Rd 57cf38160f8d7ca08c3c8e197a4be3fd *man/colSums.Rd cc0baa18fab662acc1dec8136367c98a *man/compMatrix-class.Rd -269260b729b6b2c833e07d940cf5296a *man/condest.Rd -5cd69dfe76f4f79b60c9ebe9200ba53f *man/dMatrix-class.Rd -65c5ab68fe74b8157b7e404c793ace96 *man/ddenseMatrix-class.Rd -cbff27c99b8a529852cd463cf44bb9f1 *man/ddiMatrix-class.Rd -4e54e68164fd2d4825b851e0055e0a34 *man/denseMatrix-class.Rd +37187eb2930421a7a8058dfe28420e4e *man/condest.Rd +d05401de9e47c8b5d36f10891cec5300 *man/dMatrix-class.Rd +af2b6fa724abf84be877a4552095e067 *man/ddenseMatrix-class.Rd +14120a7152aa753135199518d9df7865 *man/ddiMatrix-class.Rd +3185e295c17031665892edfcaad5fed6 *man/denseMatrix-class.Rd 97d2afdab45dca3b2818620845225870 *man/dgCMatrix-class.Rd c0b134f5e751f760f4f60495888439f2 *man/dgRMatrix-class.Rd -04f78c9590627164100a83cef3dab929 *man/dgTMatrix-class.Rd -6e6ba01053338d080ff417e32ae5e78e *man/dgeMatrix-class.Rd +a17c04aa44294870428deb29386a5fa2 *man/dgTMatrix-class.Rd +f0407dddde00f3e54ca4d4b656a3c079 *man/dgeMatrix-class.Rd 837f10f351fac09f984104016461926d *man/diagU2N.Rd -8fbfbf77a839ec51119bbe92ab917d2c *man/diagonalMatrix-class.Rd +287f4956dc7629d18dc3b8c09ddf7d1b *man/diagonalMatrix-class.Rd 1589473042f7a3649b2e231a96222512 *man/dimScale.Rd 326daf4ed53d4314f8b298f88da4ee95 *man/dmperm.Rd -2e7143404410610e11f8715436548e2f *man/dpoMatrix-class.Rd +9dcd996d506f0a1a92259ab658a25192 *man/dpoMatrix-class.Rd 1b4b6104d111472373cfe1acdc605085 *man/drop0.Rd 0e3390f6d482c4a5cd4372639ebe6f6e *man/dsCMatrix-class.Rd b61082a3e562b1a5ac36a25d934df38b *man/dsRMatrix-class.Rd -a8829ce4c56c29c0e50366097d5e6cbf *man/dsparseMatrix-class.Rd -5bd4fc12feb00ba7cd87f47161afff07 *man/dsyMatrix-class.Rd +0dfbd82b81b8881f3ddb4cf6ec8d8433 *man/dsparseMatrix-class.Rd +7f295e2662e5ccb28bc7a3079d8ed7f0 *man/dsyMatrix-class.Rd 8fc3d49bfa636ace0f9f09ff5726521d *man/dtCMatrix-class.Rd 09bad402e9ce15538b62fedc8641da36 *man/dtRMatrix-class-def.Rd a65c8694c345ab574ddd7ca26ab9b986 *man/dtpMatrix-class.Rd -8af3992fc18d22ece4389d7c62d47ae5 *man/dtrMatrix-class.Rd +dbb9523ebdb9c6f90b6d42c5043dc104 *man/dtrMatrix-class.Rd 1571202ebd7ccac77355a3948895ff2b *man/expand.Rd 5349189c7d182d444a83d35768a2e626 *man/expm.Rd 8e94ad028775467cd069de4afe77d804 *man/externalFormats.Rd 02c720f10b2ee80593bc385a9ba7dfb9 *man/facmul.Rd -56fdc48c7312229989d76fc5f8feca17 *man/fastMisc.Rd -26afc26fe69fd0b27010b5395eb26478 *man/forceSymmetric.Rd +59db1566e0cf830e4198c57f977feeb2 *man/fastMisc.Rd +b3a0c135476b28bf7569e96174bbeb8e *man/forceSymmetric.Rd 544ea441f152320cf9a6e94c11ff84c0 *man/formatSparseM.Rd 0f54fb0f3457bb48b78da8521be53128 *man/generalMatrix-class.Rd -9d9c411eb1b43d227b803ba1822f9eec *man/graph2T.Rd +da8ce2fc366523d31ec02e036c8d4690 *man/graph2T.Rd 334d679156521d39c80673b7138736c8 *man/image-methods.Rd -a88c2e0830bf0cdcd7f7e5e88cc07416 *man/indMatrix-class.Rd +35673a6311eb2119721fa1fdf91515a6 *man/indMatrix-class.Rd a1ab8d5ea99ad38051701c106e033a99 *man/index-class.Rd cbb67630dfbac437f9d7e9a7648e03ed *man/invPerm.Rd -84ea1b51c6e07bb0d7e9af78300276a8 *man/is.na-methods.Rd +44270ed554b737f9ebf9050ac16505c0 *man/is.na-methods.Rd 390ef00efc06f4e5ba986179f9be1f28 *man/is.null.DN.Rd -c978a4558f11e7a1cda3025c1faec028 *man/isSymmetric-methods.Rd -0869abcb5ffad5c4e9754f38fa4d7954 *man/isTriangular.Rd +d095e553e6911c14d31a319dfa3c9591 *man/isSymmetric-methods.Rd +767fe8a839b710ff0e6cc278be3f48d2 *man/isTriangular.Rd 73fff25f929d0743e6c80ffa1d714d06 *man/kronecker-methods.Rd -f931efd3427182fa1ac575ece0453746 *man/ldenseMatrix-class.Rd -6be5ccf719c0408051f35a980ca91d04 *man/ldiMatrix-class.Rd -e1e50127d003f6853135e831b3cf6e1d *man/lgeMatrix-class.Rd -a4fbca1aacf78d9aedc8d9f3a9f8fb1f *man/lsparseMatrix-classes.Rd -8940055890f087976b2f29ac7defa18d *man/lsyMatrix-class.Rd -9e4dc854f58f71270f9af97e2dc78eb6 *man/ltrMatrix-class.Rd -8bedd686c06236743ee23aff8ca18a6a *man/lu.Rd -92686b003fab4733d84871d9e3bb2d3e *man/mat2triplet.Rd -d1a60fbcd1a1924707d3e13405f77cbd *man/matrix-products.Rd -eb014475ab32d6aa7ab77d3646881a50 *man/nMatrix-class.Rd -90bb53c58447bcc3561deca8759c9dd6 *man/ndenseMatrix-class.Rd +7fc275d08b1b5122cf363ba3b047b78c *man/ldenseMatrix-class.Rd +fa91e53c4ec47d073e09c126b3739244 *man/ldiMatrix-class.Rd +618fc22c94018fb2b422a93cb5a08ad0 *man/lgeMatrix-class.Rd +4cd7c11599e2b72cee0e1be8ce63d8b2 *man/lsparseMatrix-classes.Rd +ba8662010144ffc10b1f1504f8122950 *man/lsyMatrix-class.Rd +a08a6989e10415fe94aadafeadeeb57c *man/ltrMatrix-class.Rd +03608a3346e9cb3686c9ed0ebecb6f7e *man/lu.Rd +4ca9cecf4789f9d6c063b1a7f0bc91df *man/macros/local.Rd +e4b848a97c4d271ddd245ddb0757e604 *man/mat2triplet.Rd +cbb84c3f84d7ae45ee527fd4c67a90dc *man/matrix-products.Rd +b1c829c1061f4b6d68baa86413b3312e *man/nMatrix-class.Rd +bcc0684524ef635f554b0e473e40c07d *man/ndenseMatrix-class.Rd cc6c44c14a8392071abe325799cc90c2 *man/nearPD.Rd -b6fafc43a55dbcba1738406a18138dc8 *man/ngeMatrix-class.Rd -5d93e1e7b7e779c599853a651acca29d *man/nnzero.Rd -354b48b1a061c4dddb700bda000a9655 *man/norm.Rd +28930b1c705719e6afcab8aea870ec0c *man/ngeMatrix-class.Rd +fa06fd574d4e47d3c17d765b6d7b6018 *man/nnzero.Rd +9ae810a456018192a784228abcececd9 *man/norm.Rd da6e6d571207b17edb907ca23774902f *man/nsparseMatrix-classes.Rd -d6e08b1901d41a1a80a14fc1cc190610 *man/nsyMatrix-class.Rd -344662be961eb20c0fd40af5eac947c7 *man/ntrMatrix-class.Rd +abc1d387f0b990d7b92edf8179a7638a *man/nsyMatrix-class.Rd +9e2a8c507c74de92a095f0850af4826b *man/ntrMatrix-class.Rd 76f34ad30ce23c52a8cdb5e2fd3203d6 *man/number-class.Rd -f45e8aba2132a3080c63deff818ce400 *man/pMatrix-class.Rd -ecf538fedee3729885b6448321d1952c *man/packedMatrix-class.Rd +6ab28432582e3d39abf69ee16493fa9d *man/pMatrix-class.Rd +fb6a793c391cc14f23f368aee00baa9f *man/packedMatrix-class.Rd e4ee4dcf3182e1879220877382b4f963 *man/printSpMatrix.Rd -24377bfc46a53e3a53474d7edbe0e0e3 *man/qr-methods.Rd -6a04be856148260b02945bc116d4d9f6 *man/rankMatrix.Rd -50bc8de6bad0063ff4f3951b24f46635 *man/rcond.Rd +d04bb8807a93274f6dd80c7c0b18d8a9 *man/qr-methods.Rd +6e3a120611604781386e5186158b0873 *man/rankMatrix.Rd +e5d1405bf89e755ca3e9f08fffacc35b *man/rcond.Rd e477841f445dcdc94519c80406941469 *man/rep2abI.Rd 59c06c927969324f27b47585ecb18410 *man/replValue-class.Rd a4109e704374bad3ef6aab75ccb8f8d9 *man/rleDiff-class.Rd 9a4e3ae4ca031791c7c366b5db715334 *man/rsparsematrix.Rd -2ff30722daaf1b16feb57ebecd002703 *man/solve-methods.Rd -d426f8173fa0568bbe90f9da5a5de44e *man/spMatrix.Rd +ea9a120657e97f87769b241dd536764f *man/solve-methods.Rd +753adc3e257e2d4bc9d9cff17779ec15 *man/spMatrix.Rd fd22402875896e84469ab3e8b9a06856 *man/sparse.model.matrix.Rd 19907299c8cad824cc36fec5bf469499 *man/sparseLU-class.Rd -af62cb2d11288e2bfb28aa64864a1fc4 *man/sparseMatrix-class.Rd +f2ec428a78fc56b8281872efcd4e56d5 *man/sparseMatrix-class.Rd f4f5ea8780961c40e4eaa051cbcd0460 *man/sparseMatrix.Rd -dda816080b9f90c17d8072b7ea996a73 *man/sparseQR-class.Rd -b47ee12085cbaa962e4128d1004c12f9 *man/sparseVector-class.Rd +e2fc23af3acb46256f52620a786ee08b *man/sparseQR-class.Rd +e861d6fe9ee84f33de30851bf09b72a1 *man/sparseVector-class.Rd c44929260581afc4a5958dd01a3ce944 *man/sparseVector.Rd 9d3271af3afc2721a3fa48329d959873 *man/symmetricMatrix-class.Rd -4cbe015d861d724127bd6c9a4e160411 *man/symmpart.Rd +7844008e1a149822f8c5f6085bf7510f *man/symmpart.Rd 66409f3da0094a78d44adfb7faf12b17 *man/triangularMatrix-class.Rd -5864f8d5269a692da8b5df7cc5cf982f *man/uniqTsparse.Rd +a1fc3f49b50407991ef4c9be7ee7401e *man/uniqTsparse.Rd b535f1c3a83155c6f97a9f099537a328 *man/unpack.Rd -168ea004de116a8cc59fddaa99284d5c *man/unpackedMatrix-class.Rd +0c8af014b0ee2fab6c08b98eafb59832 *man/unpackedMatrix-class.Rd 9d74e16af8d8612781eb7432f8194b1f *man/unused-classes.Rd -322b3316fdcd601be9327829b04b02c5 *man/updown.Rd +673d3bd30c6c5855e5ec845950ee8fdc *man/updown.Rd 88a8da5ec55171d282a0ca47e0951a51 *man/wrld_1deg.Rd -250784b7f61a898104afe895fc40fa76 *po/Matrix.pot -ebfe49eddc33045b84edcc416eb65ccf *po/R-Matrix.pot -226d84441b0575a63ce68706e244e5f9 *po/R-de.po -004ff8f60eaf5e6376cce3ef839b4d50 *po/R-fr.po -3d58ee9c7265216f10e4dcedd82c80fd *po/R-it.po -8e1e0dcb1022a3fb0a4ffb3791aac4bd *po/R-ko.po -9a36c997c670e186041b5cb9173b6c27 *po/R-lt.po -fb74732dff561bb9f7875d4aea001a04 *po/R-pl.po -652011a342268e4cfb1feb6403f6a976 *po/de.po -9deb406fce2e5f4b37da7aa41d6328ec *po/fr.po -eb651893b8990141ce0411204cf57345 *po/it.po -d7737aae8c92bd1f1c5ce2040c9eb90d *po/ko.po -475842d1e923b5d3b426c77a67b0cc1b *po/lt.po -0faa967405ff482b019cd23192b4ec21 *po/pl.po +20a1c583fe09781cb828778f916696da *po/Matrix.pot +868d688e0641c2965e0d277b960187ac *po/R-Matrix.pot +5e0bef95460914366b1f184347f5f786 *po/R-de.po +0de17281f74bf11c7f37ee23178cb2b0 *po/R-fr.po +261e860c4dcf6528bca1f10e0701b1bb *po/R-it.po +d9b097244348a62df9422a6f978814bc *po/R-ko.po +1a33730601671dd25bb02dab9ab4575c *po/R-lt.po +43872f008f14d5498f9a9fce90c2dca1 *po/R-pl.po +60fbf799f1910b7e43f0e5dd60cd9aaa *po/de.po +4fee617ac2da78f689ac9b947085506b *po/fr.po +8eb96b681aa671d7d6a1f32462d2888c *po/it.po +d8c201b5a23fdca11bcab566b879dcce *po/ko.po +f5c42ed3d1e81aab0c7bbe3872f85312 *po/lt.po +ac472f54cf760d6828cb8cdaa9b3db10 *po/pl.po d564f974ab9d0216714a4e9bb460888a *src/AMD/Include/amd.h 99cad8231a3e300cbfd5561f86cfc35c *src/AMD/Include/amd_internal.h 44b5e7133f7f818d07d17637c8410c51 *src/AMD/Makefile @@ -283,8 +281,6 @@ 56f64a3203f5752b5a012b806f101d8c *src/AMD/Source/amd_valid.c c07546f3d3e2857387fe0cdce6d7b255 *src/AMD/Source/make-Make.R 55d6a34f38b378f64f9bc05c96168890 *src/AMD/Source/make_o.mk -0387bf37d805cc2b0db841a80dc5baae *src/CHMfactor.c -fc25fff2677c0f217ab6bf8d2ec5026f *src/CHMfactor.h d2d49c52f19cae17de0efe9bbd0e50b0 *src/CHOLMOD/Check/License.txt a6a8759ae19d9078ec04530d31c5180b *src/CHOLMOD/Check/cholmod_check.c a790fc8c409f465c93400cbaf8e2ea49 *src/CHOLMOD/Check/cholmod_read.c @@ -380,81 +376,94 @@ 44b5e7133f7f818d07d17637c8410c51 *src/COLAMD/Makefile 7110287b532b98a27a8324742cbf8edd *src/COLAMD/Source/Makefile b4a48a5fb881806aa039010f5f62ca26 *src/COLAMD/Source/colamd.c -0c03a7b41809850d429bdd198fc8b00b *src/Csparse.c -868170badb0f321363a073ddd3f4878a *src/Csparse.h -4cd3e2353565cd8258eec9a153f94de9 *src/Lapack-etc.h -f5280d50bab44fc2a9d831a1b7dfc299 *src/Makevars -59983653e2f8bf5261d25fff4b65276d *src/Mdefines.h -a49464ac8eeb248ba3695e56884d2ee3 *src/Minlines.h -54475435ccf37e987909f4b54b0569c2 *src/Mutils.c -69b9d0f0c22dee1db68b1aba006e5f07 *src/Mutils.h +cf83eea5f65899ece9d5c64868738458 *src/Csparse.c +0de98909758e80a20a1947a4e7d20804 *src/Csparse.h +42a5a13f71df7c64201fc5dfe518e0b4 *src/Lapack-etc.h +978fc87397951d44f82e7908b6671998 *src/Makevars +6c9b4ba256a8beda2c6783290046b412 *src/Matrix-win.def +1a782516965babb6d929ccc81dba4b06 *src/Mdefines.h +101dd13bfa422f3fb71336f95eb61eb4 *src/Minlines.h 34a94c6db1f395da28ca4e94dd9cf9ca *src/SuiteSparse_config/Makefile 0815699f04c57aec0cf1c4f701cfd1d9 *src/SuiteSparse_config/SuiteSparse_config.c dc05db23c181f81d363fb6cc69ac31b2 *src/SuiteSparse_config/SuiteSparse_config.h d41d8cd98f00b204e9800998ecf8427e *src/SuiteSparse_config/SuiteSparse_config.mk -eda0fd2e6e1656b2afa36fcc46cac36d *src/Syms.h -3714d37c755fbf0b5b2a88362b651390 *src/abIndex.c -ea6bdd1b33f38c8c2913eeef6eb21be3 *src/abIndex.h -84396d3e2b788c1fed137493363753f3 *src/bind.c -c9e50e9bbc52a421572bc2fcdcdebd27 *src/bind.h -c468c1c2412e891251be7ac2bc9a8a38 *src/chm_common.c -789d1f059eca917e1c7ae1a1f7d23221 *src/chm_common.h -b10bac31092eb1d003376e95de58cccc *src/coerce.c -76b3f757b1922e237943aa26b2a4d0d2 *src/coerce.h -63633bfc98f4f5776acd25ba5bbb4a15 *src/cs.c +28438ed30c5bcfeb627f207b4bb81b7a *src/Syms.h +adf54d07a4c37305f145130c06afaeba *src/abIndex.c +35bfd5db20bfaed2fe5317dc8c466a4b *src/abIndex.h +2b6c0d590e8364a254f32d84c39a7a46 *src/attrib.c +f957aa1decb3ab62e5768873dacbd08d *src/attrib.h +2c5fba5b2b59e716446291cf65d1beaa *src/bind.c +ae9faa18a9b4d9e424979c2c8018c110 *src/bind.h +6cca0e47eb4327b104a91669926d67f9 *src/chm_common.c +24051279363b37a028c285c20946d43d *src/chm_common.h +77ec5a3483474020d20a39b7bfce0c99 *src/cholmod-etc.c +c5b0558d153b6934275104fa21a43013 *src/cholmod-etc.h +a9604ad03ae7eb048de303d9a2d57fe2 *src/coerce.c +b28b0cb0755257433a153e528a0efe5c *src/coerce.h +ff38f95916965b86bb63a18dc828f884 *src/cs-etc.c +bdeb2fdd1d475a5af6614bcc5e3a6c38 *src/cs-etc.h +e90b77e2b99ecfc3829ae442f64ab69f *src/cs.c 1bcb7a109eed6463413de50e66989bb3 *src/cs.h -457fea0b26ea5d3819e048eb19ad1674 *src/cs_utils.c -0b6112e86dab4fcececbadd2e84582ea *src/cs_utils.h -f0eda49b4ff9a8fcc79706e6854f9443 *src/dense.c -6810e52b4d75a9a43f6b85a1203e667c *src/dense.h -c442af70106a9673970d502d1e732e30 *src/dgCMatrix.c -9c6363fab9794fc489e9e2a3de348963 *src/dgCMatrix.h -7ea019ac469f3fc30dba0fcf73ee0db0 *src/dgeMatrix.c -1bbc6ae9fec9b93ddd1cfe110c024308 *src/dgeMatrix.h -0a3cd80ce7aeeccc5af618f7e73c1da1 *src/factorizations.c -5d497b98b9eca24ffab74491cf7c1345 *src/factorizations.h -5c935cb598473fb6f278ffae2bb42d4b *src/init.c -388486b729a889012275cefe6e8b2703 *src/kappa.c -11f8c54ee15946a13e7036265237ce24 *src/kappa.h -8c5e893eab4915df8cfb4a7e7f9c9f5f *src/packedMatrix.c -c5287ea29bbbdacc847a4b83448dc5cb *src/packedMatrix.h -c5fb792313c6ae67ff24005e70276b70 *src/products.c -263b46d0ac9b2c1b136df13d762aaea2 *src/products.h -6e8b3710ed476bb85ef85f81ea726352 *src/scripts/DEPS.mkf -faaadec1f2d37422d3cf431b86825f45 *src/scripts/SOURCES_C.mkf -02093e0c9308470481280efee3bfc250 *src/sparse.c -670212d8c6024f35bc7d705940c32dc2 *src/sparse.h -4585686e2a84c8e2e6b6d3956d25dbe4 *src/sparseVector.c -b36d9e79333d391b8e484b2bec2bad87 *src/sparseVector.h -5279bc55829b77b7d2cafda2ee25f456 *src/subscript.c -7b5a576185000d1f5c9863d5c24340c0 *src/subscript.h -d6763e20cf1a1e016b696bd4eacd139f *src/t_Csparse_subassign.c -2394f5def013c7e571231935320fa6c3 *src/t_Csparse_validate.c +98f16ec801ccad037f30d9bace8efda7 *src/dense.c +1b283c24487fa2a8a08a5d5a5a8a5728 *src/dense.h +fb5d6b8b559b3c6f369d335d7286afec *src/determinant.c +22ba2bee6a8de4cda0c60534be652beb *src/determinant.h +a185ea4e2e2f70839987babcb9278f2e *src/dgCMatrix.c +8af47c57d737a21b3d359e4106384075 *src/dgCMatrix.h +1dc03c08a01a382c278b10f747ab2ae3 *src/dgeMatrix.c +eb3f4325b448c588de89782c3ac6d8c8 *src/dgeMatrix.h +034fc363412798d349a7bad8296f50ef *src/factorizations.c +e8265b2a487f2c17ab46a4bba3c4fbb9 *src/factorizations.h +3a00ec0197947e526799ddef28b9f265 *src/idz.c +0b015211a474aa369610621fd3c543c2 *src/idz.h +9df4d8eeb26e33b8964bd8c1db8a94af *src/init.c +15d79a179e59c135b44f5967efd8d90f *src/kappa.c +6204a5bcb90a0715baf19669ef9eb940 *src/kappa.h +9bc0932a84ef35921138ccb7e22112d3 *src/objects.c +1278d3c21ed8726e9048f7031fc4cbd5 *src/objects.h +c868b7a3a85521769278f47fc2860c28 *src/perm.c +2ca56d1833e400fe657f963a72c87bd5 *src/perm.h +a612fd75964761da5067c260b4883be4 *src/products.c +1045cb4a68b0bbf5f63395a85f89beba *src/products.h +37883884bc19a49e8585dc4f325c8bbd *src/scripts/DEPS.mkf +8f746c52ccc69697252ccec2c601d667 *src/scripts/SOURCES_C.mkf +16e5ab15e7251f9cac15877574f4993e *src/solve.c +c7e4d0db483efe92dc836aac9ec0e894 *src/solve.h +0a3c1ca9dddfc78eaab799354e06a1ca *src/sparse.c +1e950bcfe739de1fa814cda80a680aa8 *src/sparse.h +e63b80a881df16e35711cd6dfbb56d0b *src/sparseVector.c +024ab3a6d182f9f3e585b802c6e43661 *src/sparseVector.h +239a1593560fe15f100577b5f81814b2 *src/subscript.c +5801e16aa00d9d5188f34e7270057e3b *src/subscript.h +bf38710f2a1be89c059d0d0c62b9327d *src/t_Csparse_subassign.c 9542b498b327ff7c9345ed5df2b9fc01 *src/t_Matrix_rle.c -e9a044bb99b25571fb2c977c719a6d27 *src/unpackedMatrix.c -9e7ec530954ec79ac5c6da1d2a835be4 *src/unpackedMatrix.h -8a4b744a54af7b543c4cda077c976bcc *src/validity.c -fa845b666f6ea178480b10076bba8f09 *src/validity.h -5e6c23f5ac16171e2293f9e60f23e9f2 *tests/Class+Meth.R -8ac5e52a9c5cff6c5f8a986b23573df9 *tests/Simple.R +d1e9d8b116fdc339313a6d2d63f58e5b *src/utils-R.c +46f34227d88921a56c0eb1e5ce4f17ac *src/utils-R.h +7dd32b8add5da5db098536fd6323bfdd *src/utils.c +a819313eb7f9d3c3fc57990d6022b076 *src/utils.h +857a3a8c830efbeef46340ad3c46619b *src/validity.c +9488bc95eb18488965cc74af6674cd76 *src/validity.h +418b002e2b2b78bfabe54f19ddf4b10c *src/version.h +242ec9448d48cc231d1369448e310018 *tests/Class+Meth.R +fc506ccab4036af8ad69cc1dd0b3e987 *tests/Simple.R 5e53e6b4552a116eb3a0d6d2feff0105 *tests/abIndex-tsts.R 0de6da80621eb6de7e56a07e766e9a81 *tests/base-matrix-fun.R -4a7262dc7d786d0197b06f40051942e5 *tests/bind.R -8a0e3bbecd8232cc4aaa85d522325c1a *tests/bind.Rout.save -e431a5493a0ac6546e803de7dc44f2d9 *tests/dg_Matrix.R -e3f13bcff3ce8ea63fc0d9083921ca97 *tests/dpo-test.R +ffe85c58a3ff60c53ae1d66b4720764e *tests/bind.R +c8ab42a19a673f079fda781843914f8a *tests/bind.Rout.save +d8d4dec1de3026e421c1faeee559e6fe *tests/dg_Matrix.R +d9e757825755abd46eaa5bb29f1b9848 *tests/dpo-test.R c8ee301b09c474efe164f0b1455f74a8 *tests/dtpMatrix.R -5d31a7cca56f8d82d168cd6865e2f494 *tests/factorizing.R -9616526bb21286c6eb69f651cea4b4f5 *tests/group-methods.R -090bab1052f33610c6e974ccf68bd1f1 *tests/indexing.R -647558d9a7a1613830cb956350ae3036 *tests/indexing.Rout.save -f595f020a9bb2cc0465e830be551b707 *tests/matprod.R -4285e87a55042493241f86c7d58e25d0 *tests/matr-exp.R -f324f3bd165399e18e5ad2077edfcdd6 *tests/other-pkgs.R -4b193f63aa7508ffd2b09a6180805217 *tests/packed-unpacked.R -e6c06eab86fb799fefb68e81a39b8f88 *tests/spModel.matrix.R -568d10b393acec9a7d78c2a990345f44 *tests/symmDN.R -bb8edd2dd95acbbd2338f0a0614eb048 *tests/validObj.R +3e75f51d54d7ffd38f8a5451cef43c2a *tests/factorizing.R +58db5af64179692469bceceebe17c8e9 *tests/group-methods.R +ecda3b001378e86ba5dff287e0c2f91e *tests/indexing.R +ff1b0ddb4c97e1da3ac465f113919c1d *tests/indexing.Rout.save +3f2ff4d5c0d6f7678047da84d9f9c23c *tests/matprod.R +33d98d8dcdbe8a42f6ee2b28b97a774a *tests/matr-exp.R +dddc7f18c7b0c6404b137941124a2ac7 *tests/other-pkgs.R +6f33d705b9e26359211e9deea270e10b *tests/packed-unpacked.R +21b5499b4f1928d33eeb840b94e69ff4 *tests/spModel.matrix.R +6730c6ccf0899c14ea93bd0559b752d0 *tests/symmDN.R +9aa1a93fa4013f5f69b7129495c7074e *tests/validObj.R 0125b34bc9a1d99bf4062ff55fa705c6 *tests/write-read.R f6c9e4986022f1db4c085b8429d06fca *vignettes/Comparisons.Rnw 2bd2896847fb11eaf102158b8696c884 *vignettes/Design-issues.Rnw diff -Nru rmatrix-1.6-1.1/NAMESPACE rmatrix-1.6-5/NAMESPACE --- rmatrix-1.6-1.1/NAMESPACE 2023-09-08 10:31:25.000000000 +0000 +++ rmatrix-1.6-5/NAMESPACE 2023-10-18 20:44:10.000000000 +0000 @@ -7,10 +7,6 @@ ## (including generic functions for which we define methods), ## but not more ... -## Some of the imports are necessary for when 'Matrix' -## is loaded but not attached: -## $ R --vanilla -e 'require(methods); (M <- Matrix::Matrix(0:1, 3L, 3L)); as(M, "sparseMatrix")' - importFrom("grDevices", colorRampPalette, grey) importFrom("graphics", image, par) @@ -23,10 +19,10 @@ importFrom("methods", .hasSlot, .selectSuperClasses, .slotNames, Arith, Compare, Complex, Logic, Math, Math2, Ops, Summary, as, callGeneric, callNextMethod, canCoerce, cbind2, coerce, - extends, getClass, getClassDef, getGroupMembers, - implicitGeneric, is, isClassDef, kronecker, new, rbind2, + extends, getClassDef, getGroupMembers, + is, isClassDef, kronecker, new, rbind2, setAs, setClass, setClassUnion, setGeneric, setMethod, - setOldClass, setReplaceMethod, setValidity, + setOldClass, setReplaceMethod, signature, show, slot, "slot<-", slotNames, validObject) importFrom("stats", contr.SAS, contr.helmert, contr.poly, contr.sum, @@ -43,6 +39,7 @@ export(.M2C, .M2R, .M2T, + .M2V, .M2diag, .M2gen, .M2kind, @@ -52,7 +49,6 @@ .M2tri, .M2unpacked, .M2v, - .SuiteSparse_version, .bdiag, .dense2sparse, .diag.dsC, @@ -63,6 +59,7 @@ .ind2dense, .ind2sparse, .formatSparseSimple, + .m2V, .m2dense, .m2sparse, .sparse2dense, @@ -79,15 +76,20 @@ Hilbert, KhatriRao, Matrix, + Matrix.Version, MatrixClass, T2graph, abIseq, abIseq1, + aggregateT, anyDuplicatedT, asPerm, + asUniqueT, bandSparse, bdiag, - c.sparseVector, # c() dispatches on first argument only => allow method to be called explicitly if that argument may not be a sparseVector + ## 'c' dispatches on first argument only, so allow direct method calls : + ## c.Matrix, # not yet (see below) + c.sparseVector, colScale, condest, det, @@ -106,6 +108,7 @@ is.null.DN, isLDL, isPerm, + isUniqueT, mat2triplet, nearPD, onenormest, @@ -123,8 +126,7 @@ spMatrix, sparse.model.matrix, sparseMatrix, - sparseVector, - uniqTsparse) + sparseVector) ## Deprecated since Matrix 1.5-4 {Apr 2023} export(..2dge, .C2nC, .T2Cmat, .asmatrix, .dense2sy, @@ -135,8 +137,9 @@ export(cBind, rBind) ## Redundant now but not yet deprecated ... -export(.CR2RC, .CR2T, .T2CR, .dense2g, .dense2kind, .dense2m, .dense2v, - .sparse2g, .sparse2kind, .sparse2m, .sparse2v, .tCR2RC) +export(.CR2RC, .CR2T, .SuiteSparse_version, .T2CR, .dense2g, .dense2kind, + .dense2m, .dense2v, .sparse2g, .sparse2kind, .sparse2m, .sparse2v, + .tCR2RC, uniqTsparse) ## ---- S3 generic functions ------------------------------------------- @@ -147,25 +150,25 @@ ## ---- S3 methods ----------------------------------------------------- ## So that dispatch also happens inside of '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) +S3method(as.array, Matrix) +S3method(as.array, sparseVector) ## Because S4 dispatch is "hard" for c(): -S3method(c, abIndex) +## S3method(c, Matrix) # breaks 7 rev. dep. {2023-09-08} S3method(c, sparseVector) +S3method(c, abIndex) ## For printing return values of our summary() methods: -S3method(print, sparseSummary) S3method(print, diagSummary) +S3method(print, sparseSummary) ## ---- S4 generic functions, methods ---------------------------------- -export(crossprod, tcrossprod) ## *necessary* (once .Primitive in base) +export(crossprod, tcrossprod) # *necessary* (once .Primitive in base) +## MJ: why these and not also export(dim, ...) which are also primitive ?? ## From 'Matrix' {no need to also export(); see WRE} exportMethods("%&%", @@ -196,10 +199,9 @@ exportMethods("!", "%*%", "+", - all, - any, all.equal, as.array, + as.complex, as.integer, as.logical, as.matrix, @@ -303,7 +305,7 @@ nsRMatrix, nsTMatrix, - ## ndiMatrix, + ndiMatrix, lMatrix, @@ -439,7 +441,6 @@ index, number, replValue, # dispatch fails when not exported - xsparseVector, ## "Other" non-virtual {for now just experimental index classes}: abIndex, diff -Nru rmatrix-1.6-1.1/R/AllClass.R rmatrix-1.6-5/R/AllClass.R --- rmatrix-1.6-1.1/R/AllClass.R 2023-06-23 16:21:15.000000000 +0000 +++ rmatrix-1.6-5/R/AllClass.R 2023-09-14 00:01:56.000000000 +0000 @@ -125,7 +125,7 @@ ## Virtual class of dense, _n_onzero pattern matrices setClass("ndenseMatrix", contains = c("nMatrix", "denseMatrix", "VIRTUAL"), slots = c(x = "logical"), - validity = function(object) .Call(ndenseMatrix_validate, object)) + validity = function(object) .Call(nMatrix_validate, object)) ## Virtual class of dense, logical matrices setClass("ldenseMatrix", contains = c("lMatrix", "denseMatrix", "VIRTUAL")) @@ -144,18 +144,6 @@ } # --NOT YET-- -## ....... Virtual Dense ... class intersections ....................... -## {for method dispatch} - -if(FALSE) { -## This is "natural" but gives WARNINGs when other packages use "it" -setClass("geMatrix", contains = c("denseMatrix", "generalMatrix", "VIRTUAL")) -} else { -## This may work better for other packages -## --> setClassUnion() ... below -} - - ## ------ Virtual Sparse ----------------------------------------------- ## Virtual class of sparse matrices @@ -242,27 +230,6 @@ } # --NOT YET-- -## ...... Virtual Sparse ... class intersections ....................... -## {for method dispatch} - -if(FALSE) { -## This is "natural" but gives WARNINGs when other packages use "it" -setClass("nCsparseMatrix", - contains = c("nsparseMatrix", "CsparseMatrix", "VIRTUAL")) -setClass("lCsparseMatrix", - contains = c("lsparseMatrix", "CsparseMatrix", "VIRTUAL")) -setClass("iCsparseMatrix", - contains = c("isparseMatrix", "CsparseMatrix", "VIRTUAL")) -setClass("dCsparseMatrix", - contains = c("dsparseMatrix", "CsparseMatrix", "VIRTUAL")) -setClass("zCsparseMatrix", - contains = c("zsparseMatrix", "CsparseMatrix", "VIRTUAL")) -} else { -## These may work better for other packages -## --> setClassUnion() ... below -} - - ## ====== Non-Virtual Subclasses ======================================= ## ------ Non-Virtual Dense -------------------------------------------- @@ -356,11 +323,6 @@ ## ------ Non-Virtual Sparse ------------------------------------------- -## NB: We should _not_ have .t[CRT]Matrix inherit from .g[CRT]Matrix, -## because a .t[CRT]Matrix could be less than fully stored if diag = "U". -## Methods for .g[CRT]Matrix applied to such .t[CRT]Matrix" could produce -## incorrect results, even though all slots are present. - ## ...... Sparse, nonzero pattern ...................................... ## NB: Unlike [^n]sparseMatrix (below), there is no 'x' slot to validate here. @@ -407,6 +369,11 @@ contains = c("TsparseMatrix", "nsparseMatrix", "symmetricMatrix"), validity = function(object) .Call(sTMatrix_validate, object)) +## Diagonal +setClass("ndiMatrix", contains = c("diagonalMatrix", "nMatrix"), + slots = c(x = "logical"), + validity = function(object) .Call(nMatrix_validate, object)) + ## ...... Sparse, logical .............................................. @@ -509,15 +476,18 @@ ## Diagonal setClass("ddiMatrix", contains = c("diagonalMatrix", "dMatrix")) -if (FALSE) { # TODO +if(FALSE) { # TODO ## CSC, symmetic, positive semidefinite setClass("dpCMatrix", contains = "dsCMatrix", - validity = function(object) TODO("test that 'object' is positive semidefinite")) + validity = function(object) TODO("test positive semidefiniteness")) -## Indicator matrix of a factor -setClass("indicator", contains = "dgCMatrix", - slots = c(levels = "character"), - validity = function(object) TODO("test that there exists a factor 'g' such that identical(object, as(g, \"sparseMatrix\")) is TRUE")) +## CSR, symmetic, positive semidefinite +setClass("dpRMatrix", contains = "dsRMatrix", + validity = function(object) TODO("test positive semidefiniteness")) + +## Triplet, symmetic, positive semidefinite +setClass("dpTMatrix", contains = "dsTMatrix", + validity = function(object) TODO("test positive semidefiniteness")) } # TODO @@ -728,46 +698,10 @@ ## ------ The Mother Class 'sparseVector' ------------------------------ -## "longindex" should allow sparseVector of length >= 2^31, -## which is necessary, e.g., when coercing from large sparseMatrix -## -## > setClass("longindex", contains = "numeric") -## -## but we use "numeric" here instead (for simplicity? efficiency?) ... -## note that "numeric" contains "integer" (whether I like it or not) ... - setClass("sparseVector", contains = "VIRTUAL", slots = c(length = "numeric", i = "numeric"), # 1-based index! prototype = list(length = 0), - validity = function(object) { - len <- object@length - if(length(len) != 1L) - return("'length' slot does not have length 1") - if(!is.finite(len)) - return("'length' slot is not finite") - if(len < 0) - return("'length' slot is negative") - i <- object@i - i.len <- length(i) - if(i.len == 0L) - return(TRUE) - if(i.len > len) - return("'i' slot has length greater than 'length' slot") - i.num <- is.double(i) - if(i.num) - i <- trunc(i) - i.uns <- is.unsorted(i, strictly = TRUE) - if(is.na(i.uns)) - "'i' slot contains NA" - else if(i.uns || i[1L] < 1 || i[i.len] > len) { - m <- if(i.uns) - "'i' slot is not strictly increasing" - else "'i' slot has elements not in 1:<'length' slot>" - if(i.num) - paste0(m, " after truncation towards zero") - else m - } else TRUE - }) + validity = function(object) .Call(sparseVector_validate, object)) ## Allow users to do new("[nlidz]sparseVector", i=, x=) with unsorted 'i' setMethod("initialize", "sparseVector", @@ -797,32 +731,23 @@ ## ------ Non-Virtual Subclasses --------------------------------------- -.valid.xsparseVector <- function(object) { - if(length(object@x) != length(object@i)) - "'i' and 'x' slots do not have equal length" - else TRUE -} - -## No 'x' slot, hence nothing more to validate: setClass("nsparseVector", contains = "sparseVector") setClass("lsparseVector", contains = "sparseVector", slots = c(x = "logical"), - validity = .valid.xsparseVector) + validity = function(object) .Call(lsparseVector_validate, object)) setClass("isparseVector", contains = "sparseVector", slots = c(x = "integer"), - validity = .valid.xsparseVector) + validity = function(object) .Call(isparseVector_validate, object)) setClass("dsparseVector", contains = "sparseVector", slots = c(x = "numeric"), - validity = .valid.xsparseVector) + validity = function(object) .Call(dsparseVector_validate, object)) setClass("zsparseVector", contains = "sparseVector", slots = c(x = "complex"), - validity = .valid.xsparseVector) - -rm(.valid.xsparseVector) + validity = function(object) .Call(zsparseVector_validate, object)) ######################################################################## @@ -923,88 +848,13 @@ "'kind' is not \"int32\", \"double\", or \"rleDiff\"") }) -setClass("determinant", - ## based on S3 class 'det': - slots = c(modulus = "numeric", logarithm = "logical", - sign = "integer", call = "call"), - validity = function(object) { - if(length(logarithm <- object@logarithm) != 1L) - "'logarithm' slot does not have length 1" - else if(is.na(logarithm)) - "'logarithm' is not TRUE or FALSE" - else if(length(modulus <- object@modulus) != 1L) - "'modulus' slot does not have length 1" - else if(logarithm && !is.na(modulus) && modulus < 0) - "logarithm=FALSE but 'modulus' slot is negative" - else if(length(sign <- object@sign)) - "'sign' slot does not have length 1" - else if(is.na(sign) || (sign != -1L && sign != 1L)) - "'sign' slot is not -1 or 1" - else TRUE - }) - ######################################################################## ## 5. Class unions ######################################################################## +## NB: these exist mainly to reduce duplication of methods ## NB: numeric = { double, integer } -## NB: many of these are _not_ exported, on purpose - -## Union of matrix and Matrix: -## * for certain "catch-all" methods; see, e.g., ./products.R -## * note that is(x, "mMatrix") is stricter than length(dim(x)) == 2L, -## which allows, e.g., class 'table' -setClassUnion("mMatrix", - members = c("matrix", "Matrix")) - -if(FALSE) { # --NOT YET-- -## for setMethod("c", "numMatrixLike"), once that works -setClassUnion("numMatrixLike", - members = c("logical", "numeric", "mMatrix")) -} # --NOT YET-- - -if(TRUE) { -## MJ: Somewhat surprisingly, these are not actually used anywhere; -## xsparseVector is only _mentioned_ in ../man/sparseVector-class.Rd. -## Keeping for now, if only for didactic reasons ... - -## Subclasses of Matrix with an 'x' slot: -## NB: the 'x' slot need not contain all of the data (e.g., when diag = "U") -setClassUnion("xMatrix", - members = c("ndenseMatrix", "lMatrix", "iMatrix", - "dMatrix", "zMatrix")) - -## Subclasses of sparseVector with an 'x' slot: -setClassUnion("xsparseVector", - members = c("lsparseVector", "isparseVector", - "dsparseVector", "zsparseVector")) -} - -## Intersection of denseMatrix and generalMatrix: -## * currently only used in ./diagMatrix.R -setClassUnion("geMatrix", - members = c("ngeMatrix", "lgeMatrix", "dgeMatrix")) - -## Intersection of nsparseMatrix and CsparseMatrix: -## * _should_ be closer to its members than nsparseMatrix and CsparseMatrix -## but it is _not_ -## * a "fix" would be to define nCsparseMatrix as a (non-union) virtual class -## _and_ have n[gts]CMatrix extend it -setClassUnion("nCsparseMatrix", - members = c("ngCMatrix", "ntCMatrix", "nsCMatrix")) -setClassUnion("lCsparseMatrix", - members = c("lgCMatrix", "ltCMatrix", "lsCMatrix")) -setClassUnion("dCsparseMatrix", - members = c("dgCMatrix", "dtCMatrix", "dsCMatrix")) - -if(FALSE) { # --NOT YET-- -## CHOLMOD-like sparseMatrix, i.e., excluding diagonalMatrix and indMatrix: -## * would be useful, e.g., in ./products.R for '%&%', -## but at the moment it affects dispatch too much -setClassUnion("CRTsparseMatrix", - members = c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix")) -} # --NOT YET-- ## Atomic vectors: ## * note that is(, "atomicVector") is FALSE @@ -1013,7 +863,7 @@ members = c("logical", "numeric", "complex", "raw", "character")) ## Numeric-like vectors: -## * for methods handling logical and integer as double; see, e.g., ./solve.R +## * for methods handling logical and integer as double setClassUnion("numLike", members = c("logical", "numeric")) @@ -1028,7 +878,6 @@ setClassUnion("replValue", members = c("logical", "numeric", "complex", "raw")) setClassUnion("replValueSp", - ## MJ: why Matrix but not matrix ?? - members = c("replValue", "sparseVector", "Matrix")) + members = c("replValue", "sparseVector", "matrix", "Matrix")) rm(.new, .initialize) diff -Nru rmatrix-1.6-1.1/R/AllGeneric.R rmatrix-1.6-5/R/AllGeneric.R --- rmatrix-1.6-1.1/R/AllGeneric.R 2023-06-19 08:55:16.000000000 +0000 +++ rmatrix-1.6-5/R/AllGeneric.R 2023-09-08 17:04:09.000000000 +0000 @@ -75,18 +75,6 @@ function(x, ...) standardGeneric("pack")) -if(FALSE) -## https://stat.ethz.ch/pipermail/r-devel/2023-June/082666.html -setGeneric("qr.X", - function(qr, complete = FALSE, ncol, ...) - standardGeneric("qr.X"), - useAsDefault = function(qr, complete = FALSE, ncol, ...) { - if(missing(ncol)) - base::qr.X(qr, complete = complete) - else base::qr.X(qr, complete = complete, ncol = ncol) - }, - signature = "qr") - setGeneric("skewpart", function(x) standardGeneric("skewpart")) diff -Nru rmatrix-1.6-1.1/R/Auxiliaries.R rmatrix-1.6-5/R/Auxiliaries.R --- rmatrix-1.6-1.1/R/Auxiliaries.R 2023-08-10 16:35:10.000000000 +0000 +++ rmatrix-1.6-5/R/Auxiliaries.R 2023-12-05 19:58:20.000000000 +0000 @@ -3,93 +3,44 @@ is0 <- function(x) !(is.na(x) | x) isN0 <- function(x) is.na(x) | x -is1 <- function(x) !is.na(x) & x == 1 -isN1 <- function(x) is.na(x) | x != 1 -isT <- function(x) !is.na(x) & x -isNT <- function(x) is.na(x) | !x - -##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 -} - -## Fast alternative to MatrixClass(): -## - if strict=FALSE then gives "...Matrix" or ".sparseVector" or "" -## - if strict= TRUE then may also give one of these: -## "pMatrix", "dp[op]Matrix", "p?corMatrix" -.M.nonvirtual <- function(x, strict = FALSE) - .Call(R_Matrix_nonvirtual, x, strict) - -## "[nlidz]" for Matrix, sparseVector, logical, integer, double, complex 'x'; -## otherwise "" -.M.kind <- function(x) .Call(R_Matrix_kind, x, TRUE) # integer -> "d" -.V.kind <- function(x) .Call(R_Matrix_kind, x, FALSE) # integer -> "i" -## "[gtsd]" for Matrix, sparseVector 'x'; -## otherwise "" -.M.shape <- function(x) .Call(R_Matrix_shape, x) -## "[CRTdi]" for [CRT]sparseMatrix, diagonalMatrix, indMatrix 'x' {resp.}; -## otherwise "" -.M.repr <- function(x) .Call(R_Matrix_repr, x) - -## FIXME: we should use these (and maybe others not yet defined) "everywhere" -.isMatrix <- function(x) - nzchar(cl <- .M.nonvirtual(x)) && substr(cl, 4L, 4L) == "M" -.isVector <- function(x) - nzchar(cl <- .M.nonvirtual(x)) && substr(cl, 8L, 8L) == "V" -.isDense <- function(x) any(.M.repr(x) == c("u", "p")) -.isUnpacked <- function(x) .M.repr(x) == "u" -.isPacked <- function(x) .M.repr(x) == "p" -.isSparse <- function(x) any(.M.repr(x) == c("C", "R", "T", "d", "i")) -.isCRT <- function(x) any(.M.repr(x) == c("C", "R", "T")) -.isC <- function(x) .M.repr(x) == "C" -.isR <- function(x) .M.repr(x) == "R" -.isT <- function(x) .M.repr(x) == "T" -.isDiagonal <- function(x) .M.repr(x) == "d" -.isInd <- function(x) .M.repr(x) == "i" +is1 <- function(x) !is.na(x) & x == 1L +isN1 <- function(x) is.na(x) | x != 1L -## MJ: no longer used -if(FALSE) { -.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) -} -} ## MJ - -.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) -} +allTrue <- function(x) + !is.na(a <- all( x)) && a +allFalse <- function(x) + if(is.atomic(x)) .Call(R_all0, x) else !is.na(a <- any( x)) && !a +all0 <- function(x) + if(is.atomic(x)) .Call(R_all0, x) else !is.na(a <- all(!x)) && a +anyFalse <- function(x) + if(is.atomic(x)) .Call(R_any0, x) else !is.na(a <- all( x)) && !a +any0 <- function(x) + if(is.atomic(x)) .Call(R_any0, x) else !is.na(a <- any(!x)) && a + +## NB: change to using 'typeof' when we define iMatrix +as1 <- function(x, mode. = mode(x)) + switch(mode., + "logical" = TRUE, + "integer" = 1L, + "double" = , + "numeric" = 1, + "complex" = 1+0i, + stop(gettextf("invalid mode \"%s\"", mode.), domain = NA)) + +## NB: change to using 'typeof' when we define iMatrix +as0 <- function(x, mode. = mode(x)) + switch(mode., + "logical" = FALSE, + "integer" = 0L, + "double" = , + "numeric" = 0, + "complex" = 0+0i, + stop(gettextf("invalid mode \"%s\"", mode.), domain = NA)) + +.bail.out.2 <- function(name, cl1, cl2) + stop(gettextf("%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement the missing method", + name, cl1[1L], cl2[1L], "Matrix"), + call. = FALSE, domain = NA) Matrix.verbose <- function() getOption("Matrix.verbose", .MatrixEnv[["verbose"]]) @@ -103,7 +54,7 @@ getOption(paste0("Matrix.", x), default) } ## MJ -Matrix.msg <- function(..., .M.level = 1, call. = FALSE, domain = NULL) { +Matrix.message <- function(..., .M.level = 1, call. = FALSE, domain = NULL) { if(Matrix.verbose() >= .M.level) { m <- if((w <- Matrix.warn()) < 1) @@ -115,220 +66,58 @@ } } -## 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 <- attr(cl, "package"))) 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[is.na(match(sn, 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) -} - -isPerm <- function(p, off = 1L) - .Call(R_isPerm, as.integer(p), as.integer(off)) -signPerm <- function(p, off = 1L) - .Call(R_signPerm, as.integer(p), as.integer(off)) -invertPerm <- function(p, off = 1L, ioff = 1L) - .Call(R_invertPerm, as.integer(p), as.integer(off), as.integer(ioff)) -asPerm <- function(pivot, off = 1L, ioff = 1L, n = length(pivot)) - .Call(R_asPerm, as.integer(pivot), as.integer(off), as.integer(ioff), - as.integer(n)) - -invPerm <- function(p, zero.p = FALSE, zero.res = FALSE) - invertPerm(p, if(zero.p) 0L else 1L, if(zero.res) 0L else 1L) - -mmultDim <- function(d.a, d.b, type = 1L) { - ## Return the 'dim' of the product indicated by 'type': - ## type 1: a %*% b - ## 2: t(a) %*% b {crossprod} - ## 3: a %*% t(b) {tcrossprod} - ## after asserting that ncol() == nrow() - i.a <- 1L + (type != 2L) - i.b <- 1L + (type == 3L) - if(d.a[i.a] != d.b[i.b]) - stop(gettextf("non-conformable matrix dimensions in %s", - deparse(sys.call(sys.parent()))), - call. = FALSE, domain = NA) - c(d.a[-i.a], d.b[-i.b]) -} - -mmultDimnames <- function(dn.a, dn.b, type = 1L) { - ## Return the 'dimnames' of the product indicated by 'type': - ## type 1: a %*% b - ## 2: t(a) %*% b {crossprod} - ## 3: a %*% t(b) {tcrossprod} - c(if(is.null(dn.a)) list(NULL) else dn.a[2L - (type != 2L)], - if(is.null(dn.b)) list(NULL) else dn.b[2L - (type == 3L)]) -} - -## dimnames->Dimnames -.M.DN <- function(x) - if(is.null(dn <- dimnames(x))) list(NULL, NULL) else dn - -## NB: Now exported and documented in ../man/is.null.DN.Rd: -is.null.DN <- function(dn) { - if(is.null(dn)) - return(TRUE) - if(!is.null(names(dn))) - names(dn) <- NULL - identical(dn, list(NULL, NULL)) || - identical(dn, list(ch0 <- character(0L), NULL)) || - identical(dn, list(NULL, ch0)) || - identical(dn, list(ch0, ch0)) -} - -## Is 'dn' valid in the sense of 'validObject()'? -## It is assumed that 'dim' is a length-2 non-negative integer vector. -validDN <- function(dn, dim) - .Call(R_DimNames_validate, dn, dim) - -validDim <- function(dim) - .Call(R_Dim_validate, dim) - -fixupDN <- function(dn) - .Call(R_DimNames_fixup, dn) - -fixupDN.if.valid <- function(dn, dim) { - if(is.character(s <- validDim(dim)) || is.character(s <- validDN(dn, dim))) - stop(s) - fixupDN(dn) -} - -## Is 'dn' symmetric? -## This allows, e.g., list(NULL, nms), _unlike_ identical(dn[1], dn[2]), -## the definition used by base::isSymmetric.matrix ... -isSymmetricDN <- function(dn) - .Call(R_DimNames_is_symmetric, dn) - -symmDN <- function(dn) - .Call(R_symmDN, dn) - -##' @title Symmetrize dimnames -##' @param x A square matrix. -##' @return -##' \code{y} identical to \code{x} except with \code{dny <- dimnames(y)} -##' given by \code{rep(dimnames(x)[J], 2)} rather than \code{dimnames(x)} -##' (where \code{J} is 1 if \code{x} has row names but not column names, -##' and 2 otherwise) and thus satisfying \code{identical(dny[1], dny[2])}. -##' @author Martin Maechler and Mikael Jagan -symmetrizeDimnames <- function(x) { - if(isS4(x)) # assuming is(x, "Matrix") - `dimnames<-`(x, symmDN(x@Dimnames)) - else if(!is.null(dn <- dimnames(x))) # assuming list of length 2 - `dimnames<-`(x, symmDN(dn)) - else x -} - ## MJ: Implement forceTriangular() and export this and that? ## MJ: Notably this provides a model for (maybe, in the future) allowing ## forceSymmetric() ... by truncating the "too long" dimension. forceDiagonal <- function(x, diag = NA_character_) { y <- diag(x, names = FALSE) # FIXME? don't allocate if diag == "U" cl <- switch(typeof(y), - logical = { - if(is.na(diag)) - diag <- if(allTrue(y)) "U" else "N" - "ldiMatrix" }, - integer = { - if(is.na(diag)) - diag <- if(allTrue(y == 1L)) "U" else "N" - storage.mode(y) <- "double" - "ddiMatrix" }, - ## integer = { - ## if(is.na(diag)) - ## diag <- if(allTrue(y == 1L)) "U" else "N" - ## "idiMatrix" }, - double = { - if(is.na(diag)) - diag <- if(allTrue(y == 1)) "U" else "N" - "ddiMatrix" }, + logical = + { + if(is.na(diag)) + diag <- + if(!is.na(a <- all(y )) && a) "U" else "N" + if(.M.kind(x) == "n") "ndiMatrix" else "ldiMatrix" + }, + integer = + { + if(is.na(diag)) + diag <- + if(!is.na(a <- all(y == 1L )) && a) "U" else "N" + storage.mode(y) <- "double" + "ddiMatrix" + }, + ## integer = + ## { + ## if(is.na(diag)) + ## diag <- + ## if(!is.na(a <- all(y == 1L )) && a) "U" else "N" + ## "idiMatrix" + ## }, + double = + { + if(is.na(diag)) + diag <- + if(!is.na(a <- all(y == 1 )) && a) "U" else "N" + "ddiMatrix" + }, complex = - stop("complex \"diagonalMatrix\" not yet implemented"), - ## complex = { - ## if(is.na(diag)) - ## diag <- if(allTrue(y == 1+0i)) "U" else "N" - ## "zdiMatrix" }, - stop(gettextf("cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"", - typeof(y)), + stop(gettextf("complex %s not yet implemented", + "diagonalMatrix"), + domain = NA), + ## complex = + ## { + ## if(is.na(diag)) + ## diag <- + ## if(!is.na(a <- all(y == 1+0i)) && a) "U" else "N" + ## "zdiMatrix" + ## }, + stop(gettextf("cannot coerce matrix of type \"%s\" to %s", + typeof(y), "diagonalMatrix"), domain = NA)) n <- length(y) d <- dim(x) - dn <- .M.DN(x) + dn <- dimnames(x) %||% list(NULL, NULL) if(any(d > n)) { d <- c(n, n) w <- if(d[1L] > n) 1L else 2L @@ -341,9 +130,20 @@ .tCRT <- function(x, lazy = TRUE) .Call(R_sparse_transpose, x, lazy) - -.drop0 <- function(x, tol = 0) - .Call(R_sparse_drop0, x, tol) +.drop0 <- function(x, tol = 0, isM = TRUE) { + if(isM) + return(.Call(R_sparse_drop0, x, tol)) + ## TODO: write sparseVector code in C and respecting 'tol' + if(.M.kind(x) == "n") + return(x) + x.x <- x@x + k <- which(is.na(x.x) | x.x) + if(length(k)) { + x@i <- x@i[k] + x@x <- x.x[k] + } + x +} drop0 <- function(x, tol = 0, is.Csparse = NA, give.Csparse = TRUE) { tryCoerce <- @@ -359,75 +159,12 @@ .Call(R_sparse_drop0, x, as.double(tol)) } -emptyColnames <- function(x, msg.if.not.empty = FALSE) { - ## Useful for compact printing of (parts) of sparse matrices - ## possibly dimnames(x) "==" NULL : - if((nd <- length(d <- dim(x))) < 2L) - return(x) - nc <- d[2L] - if(is.null(dn <- dimnames(x))) - dn <- vector("list", nd) - else if(msg.if.not.empty && - is.character(cn <- dn[[2L]]) && - any(nzchar(cn))) - message(gettextf(" [[ suppressing %d column name%s %s ... ]]", - nc, - if(nc == 1L) "" else "s", - paste0(sQuote(if(nc <= 3L) cn else cn[1:3]), - collapse = ", ")), - domain = NA) - dn[[2L]] <- character(nc) - dimnames(x) <- dn - x -} - indDiag <- function(n, upper = TRUE, packed = FALSE) .Call(R_index_diagonal, n, packed, upper) indTri <- function(n, upper = TRUE, diag = FALSE, packed = FALSE) .Call(R_index_triangle, n, packed, upper, diag) -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 -} - ## For sparseness handling, return a ## 2-column (i,j) matrix of 0-based indices of non-zero entries: @@ -439,7 +176,7 @@ else if(extends(cld, "RsparseMatrix")) .Call(compressed_non_0_ij, M, FALSE) else if(extends(cld, "TsparseMatrix")) { - if(uniqT && is_not_uniqT(M)) + if(uniqT && !isUniqueT(M)) .Call(compressed_non_0_ij, .M2C(M), TRUE) else cbind(M@i, M@j, deparse.level = 0L) } else if(extends(cld, "diagonalMatrix")) { @@ -514,62 +251,46 @@ 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")) - stop(gettextf("not yet implemented for class \"%s\"", dQuote(class.x)), - domain = NA) - .M2T(.M2C(x)) -} - -##' non-exported version with*OUT* check -- called often only if(anyDuplicatedT(.)) -.uniqTsparse <- function(x) .M2T(.M2C(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): -anyDuplicatedT <- function(x, di = dim(x)) - anyDuplicated(.Call(m_encodeInd2, x@i, x@j, di, FALSE, FALSE)) - -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 -} - -## typically used as .type.kind[.M.kind(x)]: -.type.kind <- c("n" = "logical", - "l" = "logical", - "i" = "integer", - "d" = "double", - "z" = "complex") - -## the reverse, a "version of" .M.kind(.): -.kind.type <- c("logical" = "l", - "integer" = "i", - "double" = "d", - "complex" = "z") +anyDuplicatedT <- function(x, ...) { + mn <- prod(d <- x@Dim) + if(mn <= .Machine$integer.max) + anyDuplicated.default( x@j * d[1L] + x@i, ...) + else if(mn <= 0x1p+53) + anyDuplicated.default(as.double(x@j) * d[1L] + x@i, ...) + else anyDuplicated.default(.mapply(c, list(x@i, x@j), NULL), ...) +} + +isUniqueT <- function(x, byrow = FALSE, isT = is(x, "TsparseMatrix")) + isT && !is.unsorted(if(byrow) order(x@i, x@j) else order(x@j, x@i), + strictly = TRUE) + +asUniqueT <- function(x, byrow = FALSE, isT = is(x, "TsparseMatrix")) + if(isUniqueT(x, byrow, isT)) x else .M2T(if(byrow) .M2R(x) else .M2C(x)) + +aggregateT <- function(x) .Call(Tsparse_aggregate, x) + +mat2triplet <- function(x, uniqT = FALSE) { + T <- as(x, "TsparseMatrix") + if(uniqT) + T <- asUniqueT(T, isT = TRUE) + 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) +} + +.validateCsparse <- function(x, sort.if.needed = FALSE) { + if(sort.if.needed) + .Call(CsparseMatrix_validate_maybe_sorting, x) + else .Call(CsparseMatrix_validate, x) +} + +dmperm <- function(x, nAns = 6L, seed = 0L) { + ## NB: result is determined entirely by nonzero pattern of 'x' + stopifnot(length(nAns <- as.integer(nAns)) == 1L, any(nAns == 2L * (1L:3L)), + length(seed <- as.integer(seed)) == 1L, any(seed == -1L:1L)) + x <- if(isS4(x)) .M2gen(.M2C(x), "n") else .m2sparse(x, "ngC") + .Call(Csparse_dmperm, x, nAns, seed) +} ## (matrix|denseMatrix)->denseMatrix as similar as possible to "target" as_denseClass <- function(x, cl, cld = getClassDef(cl)) { @@ -662,8 +383,7 @@ if(sparse && x@Dim[1L] > 0L) x <- switch(x@uplo, U = .Call(R_sparse_band, x, 1L, NULL), - L = .Call(R_sparse_band, x, NULL, -1L), - stop("invalid 'uplo'")) + L = .Call(R_sparse_band, x, NULL, -1L)) x@diag <- "U" x } @@ -673,23 +393,6 @@ .set.factor <- function(x, name, value, warn.no.slot = FALSE) .Call(R_set_factor, x, name, value, warn.no.slot) -## Empties 'factors' slot of 'x' { NOT a copy of 'x' ! } -## and returns TRUE if 'x' was modified and FALSE if not -.empty.factors <- function(x, warn.no.slot = FALSE) - .Call(R_empty_factors, x, warn.no.slot) - -## all-0 matrix from 'x' which must inherit from Matrix -.setZero <- function(x, kind = .M.kind(x)) { - cl <- if(.hasSlot(x, "diag")) - ".tCMatrix" - else if(.hasSlot(x, "uplo")) - ".sCMatrix" - else ".gCMatrix" - substr(cl, 1L, 1L) <- kind - d <- x@Dim - new(cl, Dim = d, Dimnames = x@Dimnames, p = rep.int(0L, d[2L] + 1)) -} - ##' Compute the three "parts" of two sets: .setparts <- function(x, y) { n1 <- length(m1 <- match(x, y, 0L)) @@ -714,19 +417,11 @@ ">=" = e2 <= e1) } -### These two are very similar, the first one has the advantage -### to be applicable to 'Chx' directly: - -## FIXME: kind = "diagBack" is not yet implemented -## would be much more efficient, but there's no CHOLMOD UI (?) - .diag.dsC <- function(x, Chx = Cholesky(x, LDL = TRUE), res.kind = "diag") { - force(Chx) if(!missing(Chx)) stopifnot(.CHM.is.LDL(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") + .Call(tCsparse_diag, Chx, res.kind) + ## ^^^^^^^^^^^^^ in ../src/Csparse.c } dimScale <- function(x, d1 = sqrt(1/diag(x, names = FALSE)), d2 = d1) { diff -Nru rmatrix-1.6-1.1/R/BunchKaufman.R rmatrix-1.6-5/R/BunchKaufman.R --- rmatrix-1.6-1.1/R/BunchKaufman.R 2023-06-19 08:55:16.000000000 +0000 +++ rmatrix-1.6-5/R/BunchKaufman.R 2023-09-22 19:22:19.000000000 +0000 @@ -11,7 +11,7 @@ setMethod("BunchKaufman", signature(x = "matrix"), function(x, uplo = "U", ...) - BunchKaufman(.m2dense(x, "dsy", uplo), ...)) + BunchKaufman(.m2dense(x, ",sy", uplo), ...)) ## METHODS FOR CLASS: p?BunchKaufman @@ -41,15 +41,15 @@ switch(which, "DU" =, "DL" = { if(!endsWith(which, x@uplo)) - stop(gettextf("which=\"%s\" invalid for x@uplo=\"%s\"", - which, x@uplo), + stop(gettextf("%s=\"%s\" invalid for %s@uplo=\"%s\"", + "which", which, "x", x@uplo), domain = NA) r[[b + 1L]] }, "U" =, "U." =, "L" =, "L." = { if(!startsWith(which, x@uplo)) - stop(gettextf("which=\"%s\" invalid for x@uplo=\"%s\"", - which, x@uplo), + stop(gettextf("%s=\"%s\" invalid for %s@uplo=\"%s\"", + "which", which, "x", x@uplo), domain = NA) if(b > 0L) { m <- r[[b]] @@ -64,8 +64,8 @@ m } }, - stop(gettextf("'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"", - x@uplo), + stop(gettextf("'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"", + "which", x@uplo), domain = NA)) } body(.def.unpacked) <- diff -Nru rmatrix-1.6-1.1/R/Csparse.R rmatrix-1.6-5/R/Csparse.R --- rmatrix-1.6-1.1/R/Csparse.R 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/R/Csparse.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,259 +0,0 @@ -## METHODS FOR CLASS: CsparseMatrix (virtual) -## sparse matrices in compressed sparse column (CSC) format -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -.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' !! - -## 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 == 3L) { ## vector (or 2-col) indexing M[i] <- v : includes M[TRUE] <- v or M[] <- v ! - x <- .M2T(x) - x[i] <- value # may change class, e.g., from dtT* to dgT* - cl.C <- sub(".Matrix$", "CMatrix", class(x)) - if(.hasSlot(x, "x") && any0(x@x)) - ## drop all values that "happen to be 0" - drop0(x, is.Csparse = FALSE) - else as_CspClass(x, cl.C) - } else ## nargs() == 4 : - replCmat4(x, - i1 = if(iMi) - seq.int(from = 0L, length.out = di[1L]) - else .ind.prep2(i, 1L, di, dn), - i2 = if(jMi) - seq.int(from = 0L, length.out = di[2L]) - else .ind.prep2(j, 2L, 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 != 0L) - stop("nothing to replace with") - return(x) - } - ## else: lenV := length(value) is > 0 - if(lenRepl %% lenV != 0L) - 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[1L], dim[2L]) else array - x.sym <- - (dind[1L] == dind[2L] && all(i1 == i2) && - (lenRepl == 1L || lenV == 1L || - isSymmetric(mkArray(value, dim=dind)))) - ## x.sym : result is *still* symmetric - x <- .M2gen(x) ## but do *not* redefine clx! - } - else if(extends(clDx, "triangularMatrix")) { - xU <- x@uplo == "U" - r.tri <- ((any(dind == 1) || dind[1L] == dind[2L]) && - 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 (do not redefine clx!) and continue - x <- .M2gen(x) # was as(x, paste0(.M.kind(x), "gCMatrix")) - } - } - ## 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: - if(i1[1L] != 0L) - i1[1L] <- -i1[1L] - else 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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 cached ones - x@factors <- list() - if(has0) x <- .drop0(x) - - 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 cached 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) -rm(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("writeMM", "CsparseMatrix", - function(obj, file, ...) - .Call(Csparse_MatrixMarket, obj, path.expand(as.character(file)))) - -dmperm <- function(x, nAns = 6L, seed = 0L) { - stopifnot(length(nAns <- as.integer(nAns)) == 1L, nAns %in% c(2L, 4L, 6L), - length(seed <- as.integer(seed)) == 1L, seed %in% -1:1) - if(isS4(x)) { - cld <- getClassDef(class(x)) - if(!extends(cld, "CsparseMatrix")) - cld <- getClassDef(class(x <- as(x, "CsparseMatrix"))) - if(extends(cld, "symmetricMatrix")) - cld <- getClassDef(class(x <- .M2gen(x))) - if(!(extends(cld, "dMatrix") || extends(cld, "nMatrix"))) - x <- .M2kind(x, "d") - } else { # typically a traditional matrix - x <- .m2sparse(x, "dgC", NULL, NULL) - } - .Call(Csparse_dmperm, x, seed, nAns) # tolerating only [dn][gt]CMatrix 'x' -} diff -Nru rmatrix-1.6-1.1/R/HBMM.R rmatrix-1.6-5/R/HBMM.R --- rmatrix-1.6-1.1/R/HBMM.R 2022-08-20 21:36:49.000000000 +0000 +++ rmatrix-1.6-5/R/HBMM.R 2023-08-18 05:02:52.000000000 +0000 @@ -10,7 +10,7 @@ readmany <- function(conn, nlines, nvals, fmt, conv) { if (!grep("[[:digit:]]+[DEFGI][[:digit:]]+", fmt)) - stop("Not a valid format") + 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)) @@ -18,8 +18,8 @@ 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) + 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)) @@ -28,7 +28,7 @@ readHB <- function(file) { if (is.character(file)) - file <- if (file == "") stdin() else file(file) + file <- if (file == "") stdin() else file(file) if (!inherits(file, "connection")) stop("'file' must be a character string or connection") if (!isOpen(file)) { @@ -44,13 +44,13 @@ 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) + 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) + 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) + 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)) @@ -75,29 +75,29 @@ readMM <- function(file) { if (is.character(file)) - file <- if(file == "") stdin() else file(file) + file <- if(file == "") stdin() else file(file) if (!inherits(file, "connection")) - stop("'file' must be a character string or connection") + stop("'file' must be a character string or connection") if (!isOpen(file)) { - open(file) - on.exit(close(file)) + open(file) + on.exit(close(file)) } scan1 <- function(what, ...) - scan(file, nmax = 1, what = what, quiet = TRUE, ...) + scan(file, nmax = 1, what = what, quiet = TRUE, ...) if (scan1(character()) != "%%MatrixMarket")# hdr - stop("file is not a MatrixMarket file") + stop("file is not a MatrixMarket file") if (!(typ <- tolower(scan1(character()))) %in% "matrix") - stop(gettextf("type '%s' not recognized", typ), domain = NA) + 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) + 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) + 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) + stop(gettextf("symmetry form '%s' not recognized", sym), domain = NA) nr <- scan1(integer(), comment.char = "%") nc <- scan1(integer()) nz <- scan1(integer()) @@ -113,74 +113,82 @@ nc), call. = FALSE, domain = NA) } 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)) + 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) + stop(gettextf("'%s()' is not yet implemented for representation '%s'", + "readMM", repr), domain = NA) } + +setMethod("writeMM", "CsparseMatrix", + function(obj, file, ...) + .Call(Csparse_MatrixMarket, obj, path.expand(as.character(file)))) + +setMethod("writeMM", "sparseMatrix", + function(obj, file, ...) + writeMM(.M2C(obj), file, ...)) diff -Nru rmatrix-1.6-1.1/R/Hilbert.R rmatrix-1.6-5/R/Hilbert.R --- rmatrix-1.6-1.1/R/Hilbert.R 2023-06-23 16:21:15.000000000 +0000 +++ rmatrix-1.6-5/R/Hilbert.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -## Generate the Hilbert matrix of dimension 'n' : -Hilbert <- function(n) { - n <- as.integer(n) - i <- seq_len(n) - new("dpoMatrix", Dim = c(n, n), x = c(1/outer(i - 1L, i, `+`))) -} diff -Nru rmatrix-1.6-1.1/R/LU.R rmatrix-1.6-5/R/LU.R --- rmatrix-1.6-1.1/R/LU.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/LU.R 2023-09-22 19:22:19.000000000 +0000 @@ -3,10 +3,10 @@ ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ setMethod("lu", signature(x = "matrix"), - function(x, ...) lu(.m2dense(x, "dge"), ...)) + function(x, ...) lu(.m2dense(x, ",ge"), ...)) setMethod("lu", signature(x = "denseMatrix"), - function(x, ...) lu(.M2kind(x, "d"), ...)) + function(x, ...) lu(.M2kind(x, ","), ...)) setMethod("lu", signature(x = "dgeMatrix"), function(x, warnSing = TRUE, ...) @@ -34,6 +34,7 @@ if(x@uplo == "U" || x@diag == "U") { r <- new("denseLU") r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames r@perm <- seq_len(d[1L]) r@x <- .M2gen(x)@x r @@ -43,7 +44,7 @@ setMethod("lu", signature(x = "sparseMatrix"), function(x, ...) - lu(.M2kind(.M2C(x), "d"), ...)) + lu(.M2kind(.M2C(x), ","), ...)) setMethod("lu", signature(x = "dgCMatrix"), function(x, errSing = TRUE, order = NA_integer_, tol = 1, ...) @@ -63,10 +64,12 @@ n <- (d <- x@Dim)[1L] r <- new("sparseLU") y <- new("dtCMatrix") - y@Dim <- r@Dim <- d + y@Dim <- d y@uplo <- if(upper) "L" else "U" y@diag <- "U" y@p <- integer(n + 1L) + r@Dim <- d + r@Dimnames <- x@Dimnames r@L <- if(upper) y else x r@U <- if(upper) x else y r@p <- r@q <- seq.int(from = 0L, length.out = n) @@ -95,10 +98,12 @@ n <- (d <- x@Dim)[1L] r <- new("sparseLU") y <- new("dtCMatrix") - y@Dim <- r@Dim <- d + y@Dim <- d y@uplo <- if(upper) "L" else "U" y@diag <- "U" y@p <- integer(n + 1L) + r@Dim <- d + r@Dimnames <- x@Dimnames r@L <- if(upper) y else .M2C(x) r@U <- if(upper) .M2C(x) else y r@p <- r@q <- seq.int(from = 0L, length.out = n) @@ -127,10 +132,12 @@ n <- (d <- x@Dim)[1L] r <- new("sparseLU") y <- new("dtCMatrix") - y@Dim <- r@Dim <- d + y@Dim <- d y@uplo <- if(upper) "L" else "U" y@diag <- "U" y@p <- integer(n + 1L) + r@Dim <- d + r@Dimnames <- x@Dimnames r@L <- if(upper) y else .M2C(x) r@U <- if(upper) .M2C(x) else y r@p <- r@q <- seq.int(from = 0L, length.out = n) @@ -140,10 +147,11 @@ setMethod("lu", "diagonalMatrix", function(x, ...) { + x <- .M2kind(x, ",") n <- (d <- x@Dim)[1L] L <- new("dtCMatrix") r <- new("sparseLU") - L@Dim <- r@Dim <- d + L@Dim <- d L@uplo <- "L" L@diag <- "U" L@p <- integer(n + 1L) @@ -151,9 +159,11 @@ if(x@diag == "N") { L@diag <- "N" L@p <- seq.int(from = 0L, length.out = n + 1L) - L@x <- as.double(x@x) + L@x <- x@x } r@U <- L + r@Dim <- d + r@Dimnames <- x@Dimnames r@p <- r@q <- seq.int(from = 0L, length.out = n) r }) @@ -243,7 +253,9 @@ r@x <- .mkU(x@x, m, n) r }, - stop("'which' is not \"P1\", \"P1.\", \"L\", or \"U\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"", + "which", "P", "L", "U"), + domain = NA)) }) ## returning list(P1', L, U), where A = P1' L U @@ -320,7 +332,9 @@ }, "L" = x@L, "U" = x@U, - stop("'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or \"%4$s\"", + "which", "P", "L", "U"), + domain = NA)) }) ## returning list(P1', L, U, P2'), where A = P1' L U P2' diff -Nru rmatrix-1.6-1.1/R/Math.R rmatrix-1.6-5/R/Math.R --- rmatrix-1.6-1.1/R/Math.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/Math.R 2023-10-11 13:25:02.000000000 +0000 @@ -1,269 +1,285 @@ -####--- All "Math" and "Math2" group methods for all Matrix classes (incl sparseVector) ------ -#### ==== ===== +## METHODS FOR GENERIC: Math (group) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## "Design-bug": log(x, base) has *two* arguments // ditto for "trunc()" !! -## ---> need "log" methods "everywhere to catch 2-arg case ! - - -### ~~~~ Math, log ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## FIXME: -## Once we start having non-virtual [iz]Matrix, -## many of these will need adjustment ... - -## cum(min|max|sum|prod) return vector also for matrix arguments -Math.vecGenerics <- grep("^cum", getGroupMembers("Math"), value = TRUE) - -###--------- 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 -}) - -###--------- ddenseMatrix - -## Used for dt[rp]Matrix, ds[yp]Matrix (and subclasses, e.g., dpo*, cor*) -##' _only_, as dgeMatrix has its own method above - -setMethod("Math", signature(x = "ddenseMatrix"), function(x) -{ - if(.Generic %in% Math.vecGenerics) - ## Result is a vector - return(callGeneric(.M2gen(x, ".")@x)) - cld <- getClassDef(class(x)) - if(extends(cld, "symmetricMatrix")) { - ## Argument and result are symmetricMatrix - if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix")) - ## But result is _not_ positive definite! - x <- as(x, if(po) "dsyMatrix" else "dspMatrix") - x@x <- callGeneric(x@x) - x@factors <- list() - x - } else if(is0(callGeneric(0))) { - ## Argument and result are triangularMatrix - if(extends(cld, "MatrixFactorization")) - ## But result is _not_ a factor or correlation - x <- as(x, if(.isPacked(x)) "dtpMatrix" else "dtrMatrix") - x@x <- callGeneric(x@x) - if(x@diag != "N" && isN1(f1 <- callGeneric(1))) - diag(x) <- f1 - x - } else { - ## Argument is triangularMatrix, result is generalMatrix - callGeneric(.M2gen(x, ".")) - } -}) - -## "log" with *two* arguments -setMethod("log", signature(x = "ddenseMatrix"), function(x, base = exp(1)) -{ - cld <- getClassDef(class(x)) - if(extends(cld, "symmetricMatrix")) { - ## Argument and result are symmetricMatrix - if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix")) - ## But result is _not_ positive definite - x <- as(x, if(po) "dsyMatrix" else "dspMatrix") - x@x <- log(x@x, base) - x@factors <- list() - x - } else { - ## Argument is triangularMatrix, result is generalMatrix - log(.M2gen(x, "."), base) - } -}) - -###--------- denseMatrix +## > getGroupMembers("Math") +## [1] "abs" "sign" "sqrt" "ceiling" "floor" "trunc" +## [7] "cummax" "cummin" "cumprod" "cumsum" "exp" "expm1" +## [13] "log" "log10" "log2" "log1p" "cos" "cosh" +## [19] "sin" "sinh" "tan" "tanh" "acos" "acosh" +## [25] "asin" "asinh" "atan" "atanh" "cospi" "sinpi" +## [31] "tanpi" "gamma" "lgamma" "digamma" "trigamma" setMethod("Math", signature(x = "denseMatrix"), - function(x) callGeneric(.M2kind(x, "d"))) + function(x) { + g <- get(.Generic, mode = "function") + if(startsWith(.Generic, "cum")) + return(g(.M2v(x))) + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + if (kind == "z") { + zero <- 0+0i; one <- 1+0i; a <- as.complex + } else { + zero <- 0 ; one <- 1 ; a <- as.double + substr(cl, 1L, 1L) <- "d" + } + if(shape == "t") { + stay0 <- is0(a(g(zero))) + if(!stay0) { + x <- .M2gen(x) + substr(cl, 2L, 3L) <- "ge" + } + } + r <- new(cl) + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames + if(shape == "s" || (shape == "t" && stay0)) + r@uplo <- x@uplo + r@x <- a(g({ y <- x@x; if(kind == "n") y | is.na(y) else y })) + if(shape == "t" && stay0 && x@diag != "N") { + if(is1(g1 <- a(g(one)))) + r@diag <- "U" + else diag(r) <- g1 + } + r + }) setMethod("log", signature(x = "denseMatrix"), - function(x, base = exp(1)) log(.M2kind(x, "d"), base)) + function(x, ...) { + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + if(kind != "z") + substr(cl, 1L, 1L) <- "d" + if(shape == "t") { + x <- .M2gen(x) + substr(cl, 2L, 3L) <- "ge" + } + r <- new(cl) + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames + if(shape == "s") + r@uplo <- x@uplo + r@x <- log({ y <- x@x; if(kind == "n") y | is.na(y) else y }, ...) + r + }) -###--------- CsparseMatrix +setMethod("Math", signature(x = "sparseMatrix"), + function(x) { + g <- get(.Generic, mode = "function") + if(startsWith(.Generic, "cum")) + return(g(.M2v(x))) + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + repr <- substr(cl, 3L, 3L) + if (kind == "z") { + zero <- 0+0i; one <- 1+0i; a <- as.complex + } else { + zero <- 0 ; one <- 1 ; a <- as.double + substr(cl, 1L, 1L) <- "d" + } + stay0 <- is0(g0 <- a(g(zero))) + if(!stay0) + substr(cl, 2L, 3L) <- if(shape == "s") "sy" else "ge" + r <- new(cl) + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames + if(shape == "s" || (shape == "t" && stay0)) + r@uplo <- x@uplo + if(!stay0) { + y <- .Call(CR2spV, if(repr == "T") .M2C(x) else x) + tmp <- rep.int(g0, y@length) + tmp[y@i] <- a(g(if(kind == "n") one else y@x)) + r@x <- tmp + } else { + if(shape == "t" && x@diag != "N") { + if(is1(a(g(one)))) + r@diag <- "U" + else diag(x) <- TRUE + } + nnz <- length( + switch(repr, + "C" = { r@p <- x@p; r@i <- x@i }, + "R" = { r@p <- x@p; r@j <- x@j }, + "T" = { r@i <- x@i; r@j <- x@j })) + r@x <- if(kind == "n") rep.int(a(g(one)), nnz) else a(g(x@x)) + } + r + }) -setMethod("Math", signature(x = "CsparseMatrix"), function(x) -{ - if(.Generic %in% Math.vecGenerics) - ## Result is a vector - return(callGeneric(.M2m(x))) - if(isN0(callGeneric(0))) - ## Result is a denseMatrix - return(callGeneric(.sparse2dense(x))) - ## Result preserves sparseness and structure (symmetric, triangular) - cld <- getClassDef(cl <- class(x)) - if(isN1(callGeneric(1))) - x <- .Call(R_sparse_diag_U2N, x) - if(extends(cld, "nsparseMatrix")) { - ## No 'x' slot - r <- rep.int(callGeneric(1), length(x@i)) - } else { - r <- callGeneric(x@x) - if(typeof(r) == typeof(x@x)) { - x@x <- r - return(x) - } - } - ## e.g., abs( ) -> dgC - y <- new(`substr<-`(MatrixClass(cl, cld), 1L, 1L, "d")) - y@x <- as.double(r) - nms <- slotNames(cld) - for(nm in nms[nms != "x"]) - slot(y, nm) <- slot(x, nm) - y -}) ## {Math} - -setMethod("log", signature(x = "CsparseMatrix"), - function(x, base = exp(1)) log(.sparse2dense(x), base)) - -###--------- diagonalMatrix - -setMethod("Math", signature(x = "diagonalMatrix"), function(x) -{ - if(.Generic %in% Math.vecGenerics) - ## Result is a vector - return(callGeneric(.M2m(x))) - unit <- x@diag != "N" - r <- callGeneric(if(unit) 1 else x@x) - if(isN0(f0 <- callGeneric(0))) { - ## Result is dense, symmetric - ## MJ: hmm ... what if the 'Dimnames' are asymmetric? - y <- new("dspMatrix") - n <- (y@Dim <- x@Dim)[1L] - y@Dimnames <- symmDN(x@Dimnames) - y@x <- rep.int(f0, 0.5 * n * (n + 1)) - if(n > 0L) - diag(y) <- r - y - } else if(typeof(r) == typeof(x@x)) { - ## Result is diagonal ... modify 'x' - if(!unit) { - x@x <- r - } else if(isN1(r)) { - x@x <- rep.int(r, x@Dim[1L]) - x@diag <- "N" - } - x - } else { - ## Result is diagonal ... modify new() - y <- new("ddiMatrix") - y@Dim <- x@Dim - y@Dimnames <- x@Dimnames - if(!unit) - y@x <- as.double(r) - else if(isN1(r)) - y@x <- rep.int(as.double(r), x@Dim[1L]) - else - y@diag <- "U" - y - } -}) ## {Math} - -setMethod("log", "diagonalMatrix", function(x, base = exp(1)) -{ - ## Result is dense, symmetric - ## MJ: hmm ... what if the 'Dimnames' are asymmetric? - y <- new("dspMatrix") - n <- (y@Dim <- x@Dim)[1L] - y@Dimnames <- symmDN(x@Dimnames) - y@x <- rep.int(-Inf, 0.5 * n * (n + 1)) - if(n > 0L) - diag(y) <- if(x@diag == "N") log(x@x, base) else 0 - y -}) +setMethod("log", signature(x = "sparseMatrix"), + function(x, ...) { + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + repr <- substr(cl, 3L, 3L) + if(kind == "z") { + zero <- 0+0i; one <- 1+0i + } else { + zero <- 0 ; one <- 1 + substr(cl, 1L, 1L) <- "d" + } + substr(cl, 2L, 3L) <- if(shape == "s") "sy" else "ge" + r <- new(cl) + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames + if(shape == "s") + r@uplo <- x@uplo + y <- .Call(CR2spV, if(repr == "T") .M2C(x) else x) + tmp <- rep.int(log(zero, ...), y@length) + tmp[y@i] <- log(if(kind == "n") one else y@x, ...) + r@x <- tmp + r + }) -###--------- sparseMatrix +setMethod("Math", signature(x = "diagonalMatrix"), + function(x) { + g <- get(.Generic, mode = "function") + if(startsWith(.Generic, "cum")) + return(g(.M2v(x))) + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + if (kind == "z") { + zero <- 0+0i; one <- 1+0i; a <- as.complex + } else { + zero <- 0 ; one <- 1 ; a <- as.double + substr(cl, 1L, 1L) <- "d" + } + stay0 <- is0(g0 <- a(g(zero))) + if(!stay0) + substr(cl, 2L, 3L) <- "ge" + r <- new(cl) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + if(!stay0) { + if((n <- d[2L]) > 0L) { + tmp <- matrix(g0, n, n) + diag(tmp) <- a(g(if(x@diag != "N") one else { y <- x@x; if(kind == "n" && anyNA(y)) y | is.na(y) else y })) + dim(tmp) <- NULL + r@x <- tmp + } + } else { + if(x@diag != "N") { + if(is1(g1 <- a(g(one)))) + r@diag <- "U" + else r@x <- rep.int(g1, d[1L]) + } else r@x <- a(g({ y <- x@x; if(kind == "n" && anyNA(y)) y | is.na(y) else y })) + } + r + }) -setMethod("Math", signature(x = "sparseMatrix"), - function(x) callGeneric(as(x, "CsparseMatrix"))) +setMethod("log", signature(x = "diagonalMatrix"), + function(x, ...) { + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + if(kind == "z") { + zero <- 0+0i; one <- 1+0i + } else { + zero <- 0 ; one <- 1 + substr(cl, 1L, 1L) <- "d" + } + substr(cl, 2L, 3L) <- "ge" + r <- new(cl) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + if((n <- d[2L]) > 0L) { + tmp <- matrix(log(zero, ...), n, n) + diag(tmp) <- log(if(x@diag != "N") one else { y <- x@x; if(kind == "n" && anyNA(y)) y | is.na(y) else y }, ...) + dim(tmp) <- NULL + r@x <- tmp + } + r + }) -setMethod("log", signature(x = "sparseMatrix"), - function(x, base = exp(1)) log(as(x, "CsparseMatrix"), base)) +setMethod("Math", signature(x = "indMatrix"), + function(x) + get(.Generic, mode = "function")(.M2kind(x, "n"))) + +setMethod("log", signature(x = "indMatrix"), + function(x, ...) + log(.M2kind(x, "n"), ...)) + +setMethod("Math", signature(x = "sparseVector"), + function(x) { + g <- get(.Generic, mode = "function") + if(startsWith(.Generic, "cum")) + return(g(.V2v(x))) + kind <- .M.kind(x) + if(kind == "z") { + zero <- 0+0i; one <- 1+0i; l <- "z" + } else if(kind == "d" || .Generic != "abs") { + zero <- 0 ; one <- 1 ; l <- "d" + } else { + zero <- 0L ; one <- 1L ; l <- "i" + } + if(isN0(g0 <- g(zero))) { + r <- rep.int(g0, x@length) + if((nnz <- length(x@i)) > 0L) + r[x@i] <- if(kind == "n") rep.int(g(one), nnz) else g(x@x) + } else { + r <- new(paste0(l, "sparseVector")) + r@length <- x@length + r@i <- x@i + if((nnz <- length(x@i)) > 0L) + r@x <- if(kind == "n") rep.int(g(one), nnz) else g(x@x) + } + r + }) + +setMethod("log", signature(x = "sparseVector"), + function(x, ...) { + kind <- .M.kind(x) + if(kind == "z") { + zero <- 0+0i; one <- 1+0i + } else { + zero <- 0 ; one <- 1 + } + r <- rep.int(log(zero, ...), x@length) + if(length(x@i) > 0L) + r[x@i] <- log(if(kind == "n") one else x@x, ...) + r + }) -###--------- sparseVector -setMethod("Math", signature(x = "sparseVector"), function(x) -{ - if(.Generic %in% Math.vecGenerics || isN0(callGeneric(0))) - ## Result is a (traditional) vector - return(callGeneric(sp2vec(x))) - ## Result is a sparseVector - cld <- getClassDef(class(x)) - if(extends(cld, "dsparseVector")) { - x@x <- callGeneric(x@x) - x - } else { - y <- new("dsparseVector") - y@x <- - if(extends(cld, "nsparseVector")) - rep.int(callGeneric(1), length(x@i)) - else callGeneric(x@x) - y@i <- x@i - y@length <- x@length - y - } -}) - -setMethod("log", "sparseVector", function(x, base = exp(1)) -{ - lx <- rep.int(-Inf, x@length) - if(length(x@i) > 0L) - lx[x@i] <- if(is(x, "nsparseVector")) 0 else log(x@x, base) - lx -}) - - -### ~~~~ Math2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## NB: For round(), signif(), we have that Generic(u, k) |-> u -## for all u in {0,1}, for all k, implying that "structure" -## is invariant ... hence minimal "cases" are needed here +## METHODS FOR GENERIC: Math2 (group) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("Math2", signature(x = "dMatrix"), +## > getGroupMembers("Math2") +## [1] "round" "signif" + +setMethod("Math2", signature(x = "Matrix"), function(x, digits) { - x@x <- callGeneric(x@x, digits = digits) + x <- .indefinite(.M2kind(x, ",")) + x@x <- get(.Generic, mode = "function")(x@x, digits = digits) + if(.hasSlot(x, "factors") && length(x@factors) > 0L) + x@factors <- list() x }) -## As above, but first coercing to dMatrix: -setMethod("Math2", signature(x = "Matrix"), - function(x, digits) { - x <- as(x, "dMatrix") - x@x <- callGeneric(x@x, digits = digits) - x - }) - -setMethod("Math2", signature(x = "dsparseVector"), +setMethod("Math2", signature(x = "sparseVector"), function(x, digits) { - x@x <- callGeneric(x@x, digits = digits) + x <- .V2kind(x, ",") + x@x <- get(.Generic, mode = "function")(x@x, digits = digits) x }) -## As above, but first coercing to dsparseVector: -setMethod("Math2", signature(x = "sparseVector"), - function(x, digits) { - x <- as(x, "dsparseVector") - x@x <- callGeneric(x@x, digits = digits) - x - }) +## METHODS FOR GENERIC: zapsmall +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## ~~~~ Not group generic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +setMethod("zapsmall", signature(x = "Matrix"), + function(x, digits = getOption("digits")) { + x <- .indefinite(.M2kind(x, ",")) + x@x <- zapsmall(x@x, digits = digits) + if(.hasSlot(x, "factors") && length(x@factors) > 0L) + x@factors <- list() + x + }) -setMethod("zapsmall", signature(x = "dMatrix"), +setMethod("zapsmall", signature(x = "sparseVector"), function(x, digits = getOption("digits")) { - x@x <- zapsmall(x@x, digits) + x <- .V2kind(x, ",") + x@x <- zapsmall(x@x, digits = digits) x }) diff -Nru rmatrix-1.6-1.1/R/Matrix.R rmatrix-1.6-5/R/Matrix.R --- rmatrix-1.6-1.1/R/Matrix.R 2023-08-04 03:06:59.000000000 +0000 +++ rmatrix-1.6-5/R/Matrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,383 +0,0 @@ -## METHODS FOR CLASS: Matrix (virtual) -## mother class containing all matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -## ~~~~ CONSTRUCTORS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Matrix <- function(data = NA, nrow = 1, ncol = 1, byrow = FALSE, - dimnames = NULL, sparse = NULL, - doDiag = TRUE, forceCheck = FALSE) -{ - i.M <- i.sM <- i.dM <- i.sV <- i.m <- FALSE - mnrow <- missing(nrow) - mncol <- missing(ncol) - if(isS4(data)) { - cld <- getClassDef(class(data)) - i.M <- extends(cld, "Matrix") - if(i.M) { - i.sM <- extends(cld, "sparseMatrix") - i.dM <- i.sM && extends(cld, "diagonalMatrix") - } else if(extends(cld, "sparseVector")) { - ## need to transmit missingness to 'spV2M' - call. <- quote(spV2M(x = data, nrow =, ncol =, byrow = byrow)) - if(!mnrow) - call.[[3L]] <- quote(nrow) - if(!mncol) - call.[[4L]] <- quote(ncol) - data <- eval(call.) - i.M <- i.sM <- i.sV <- forceCheck <- TRUE - } - } else { - i.m <- is.matrix(data) - } - if(!i.M) { - ## validate non-Matrix 'data', throwing type errors _early_ - if(is.object(data)) { - if(i.m) - class(data) <- NULL # retaining 'dim' - else - data <- as.vector(data) - } - mode. <- mode(data) - kind <- switch(mode., numeric = "d", logical = "l", - stop("invalid 'data'")) - } - if(i.M || i.m) { - ## 'data' is a Matrix or a numeric or logical matrix - ## without a 'class' attribute - if(!i.sV && !(mnrow && mncol && missing(byrow))) - warning("'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'") - if(!is.null(dimnames)) - dimnames(data) <- dimnames - if(is.null(sparse)) - sparse <- sparseDefault(data) - if(i.M) { - ## return early in these cases: - if(i.dM) - ## !doDiag has been documented to result in a coercion to - ## symmetricMatrix; we must use diag2*() below because the - ## "usual" as(, "(Csparse|unpacked)Matrix") - ## inherits from triangularMatrix, _not_ symmetricMatrix - return(if(doDiag) - data - else if(sparse) - .diag2sparse(data, "s", "C", "U") - else .diag2dense(data, "s", FALSE, "U")) - if(!forceCheck) - return(if(i.sM == sparse) - data - else if(sparse) - as(data, "CsparseMatrix") - else as(data, "unpackedMatrix")) - } - } else { - ## 'data' is a numeric or logical vector or non-matrix array - ## without a 'class' attribute - if(length(data) == 1L && !is.na(data) && data == 0 && - (is.null(sparse) || sparse)) { - ## Matrix(0, ...): sparseMatrix unless sparse=FALSE - ## MJ: we should _try_ to behave as R's do_matrix() - ## in the edge cases ... integer overflow is "OK" - ## since anyNA(Dim) is caught by validity methods - if(mnrow == mncol) { - nrow <- as.integer(nrow) - ncol <- as.integer(ncol) - } else if(mnrow) { - ncol <- as.integer(ncol) - if(ncol == 0L) - stop("data is too long") - nrow <- as.integer(ceiling(1 / ncol)) - } else { - nrow <- as.integer(nrow) - if(nrow == 0L) - stop("data is too long") - ncol <- as.integer(ceiling(1 / nrow)) - } - square <- nrow == ncol - if(is.null(dimnames)) - dimnames <- list(NULL, NULL) - if(square && doDiag) - return(new(paste0(kind, "diMatrix"), - Dim = c(nrow, ncol), - Dimnames = dimnames, - x = vector(mode., nrow))) - data <- new(paste0(kind, if(square) "s" else "g", "CMatrix"), - Dim = c(nrow, ncol), - Dimnames = dimnames, - p = integer(ncol + 1)) - i.M <- i.sM <- sparse <- TRUE - } else { - ## usual case: vector|array->matrix - data <- .External(Mmatrix, - data, nrow, ncol, byrow, dimnames, mnrow, mncol) - if(is.null(sparse)) - sparse <- sparseDefault(data) - i.m <- TRUE - } - } - - ## 'data' is a Matrix (but _not_ a diagonalMatrix) or a - ## numeric or logical matrix without a 'class' attribute - if(doDiag && isDiagonal(data)) - ## as(<[mM]atrix>, "diagonalMatrix") uses check = TRUE (a waste) - return(forceDiagonal(data)) - if(i.m || i.sM != sparse) { - data <- as(data, if(sparse) "CsparseMatrix" else "unpackedMatrix") - if(i.m) - ## as(, "CsparseMatrix"), as(, "unpackedMatrix") - ## already check for symmetric, triangular structure - return(data) - } - if(!is(data, "generalMatrix")) - data - else if(isSymmetric(data)) - forceSymmetric(data) - else if(!(it <- isTriangular(data))) - data - else if(attr(it, "kind") == "U") - triu(data) - else tril(data) -} - - -## ~~~~ METHODS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("dim", signature(x = "Matrix"), - function(x) x@Dim) - -setMethod("length", "Matrix", - function(x) prod(x@Dim)) - -setMethod("dimnames", signature(x = "Matrix"), - function(x) x@Dimnames) - -setMethod("dimnames<-", signature(x = "Matrix", value = "list"), - function(x, value) { - x@Dimnames <- fixupDN.if.valid(value, x@Dim) - x - }) - -setMethod("dimnames<-", signature(x = "Matrix", value = "NULL"), - function(x, value) { - x@Dimnames <- list(NULL, NULL) - x - }) - -setMethod("dimnames<-", signature(x = "compMatrix", value = "list"), - function(x, value) { - if(length(x@factors)) - x@factors <- list() - x@Dimnames <- fixupDN.if.valid(value, x@Dim) - x - }) - -setMethod("dimnames<-", signature(x = "compMatrix", value = "NULL"), - function(x, value) { - if(length(x@factors)) - x@factors <- list() - x@Dimnames <- list(NULL, NULL) - x - }) - -setMethod("unname", signature(obj = "Matrix"), - function(obj, force = FALSE) { - obj@Dimnames <- list(NULL, NULL) - obj - }) - -setMethod("drop", signature(x = "Matrix"), - function(x) if(any(x@Dim == 1L)) drop(as(x, "matrix")) else x) - -## These work nicely as long as methods are defined for '[' : -setMethod("head", signature(x = "Matrix"), - head.matrix) -setMethod("tail", signature(x = "Matrix"), - tail.matrix) -setMethod("diff", signature(x = "Matrix"), - ## Mostly cut and paste of 'base::diff.default' : - function(x, lag = 1L, differences = 1L, ...) { - if(length(lag) != 1L || length(differences) > 1L || - lag < 1L || differences < 1L) - stop("'lag' and 'differences' must be integers >= 1") - if(lag * differences >= x@Dim[1L]) - return(x[0L]) - i1 <- -seq_len(lag) - for(i in seq_len(differences)) { - m <- x@Dim[1L] - x <- x[i1, , drop = FALSE] - - x[-m:-(m - lag + 1L), , drop = FALSE] - } - x - }) - -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 - -## 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 -## ^^^^^^/src/library/base/R/all.equal.R -environment(all.equal_num) <- environment() # our namespace - -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) -rm(all.equal_Mat) -## -> ./sparseMatrix.R, ./sparseVector.R have specific methods - -### "[<-" : ----------------- - -## 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) - `[<-`(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) -rm(.repl.i.lDMat) - -.repl.i.lSMat <- function (x, i, j, ..., value) - `[<-`(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) -rm(.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") - }) diff -Nru rmatrix-1.6-1.1/R/MatrixFactorization.R rmatrix-1.6-5/R/MatrixFactorization.R --- rmatrix-1.6-1.1/R/MatrixFactorization.R 2023-06-23 16:21:15.000000000 +0000 +++ rmatrix-1.6-5/R/MatrixFactorization.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,80 +0,0 @@ -## METHODS FOR CLASS: MatrixFactorization (virtual) -## mother class containing all matrix factorizations -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -if(FALSE) { -## MJ: not yet ... existing as(, "Matrix") must become defunct first? -setAs("MatrixFactorization", "Matrix", - function(from) { - n <- length(x <- expand2(from)) - to <- x[[1L]] - if(n >= 2L) for(i in 2:n) to <- to %*% x[[i]] - to - }) - -setAs("MatrixFactorization", "matrix", - function(from) as(as(from, "Matrix"), "matrix")) -} - -setMethod("dim", signature(x = "MatrixFactorization"), - function(x) x@Dim) - -setMethod("length", "MatrixFactorization", - function(x) prod(x@Dim)) - -setMethod("dimnames", signature(x = "MatrixFactorization"), - function(x) x@Dimnames) - -setMethod("dimnames<-", signature(x = "MatrixFactorization", value = "list"), - function(x, value) { - x@Dimnames <- fixupDN.if.valid(value, x@Dim) - x - }) - -setMethod("dimnames<-", signature(x = "MatrixFactorization", value = "NULL"), - function(x, value) { - x@Dimnames <- list(NULL, NULL) - x - }) - -setMethod("unname", signature(obj = "MatrixFactorization"), - function(obj, force = FALSE) { - obj@Dimnames <- list(NULL, NULL) - obj - }) - -setMethod("show", "MatrixFactorization", - function(object) { - cat("matrix factorization of ") - str(object) - }) - -setMethod("show", "CholeskyFactorization", - function(object) { - cat("Cholesky factorization of ") - str(object) - }) - -setMethod("show", "BunchKaufmanFactorization", - function(object) { - cat("Bunch-Kaufman factorization of ") - str(object) - }) - -setMethod("show", "SchurFactorization", - function(object) { - cat("Schur factorization of ") - str(object) - }) - -setMethod("show", "LU", - function(object) { - cat("LU factorization of ") - str(object) - }) - -setMethod("show", "QR", - function(object) { - cat("QR factorization of ") - str(object) - }) diff -Nru rmatrix-1.6-1.1/R/Ops.R rmatrix-1.6-5/R/Ops.R --- rmatrix-1.6-1.1/R/Ops.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/Ops.R 2023-10-11 13:39:53.000000000 +0000 @@ -1,6 +1,63 @@ -####--- All "Ops" group methods for all Matrix classes (incl sparseVector) --- -#### === but diagonalMatrix -> ./diagMatrix.R and abIndex.R -#### ~~~~~~~~~~~~ ~~~~~~~~~ +## METHODS FOR GENERIC: Ops = {Arith, Compare, Logic} (group) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +## > getGroupMembers("Ops") +## [1] "Arith" "Compare" "Logic" +## > getGroupMembers("Arith") +## [1] "+" "-" "*" "^" "%%" "%/%" "/" +## > getGroupMembers("Compare") +## [1] "==" ">" "<" "!=" "<=" ">=" +## > getGroupMembers("Logic") # excluding unary "!" -> ./not.R +## [1] "&" "|" + +if(FALSE) { +## vvvv MJ: for _after_ 1.6-2, ditto ./(Arith|Compare|Logic).R +.Ops.invalid <- function(x) { + if(is.object(x)) + gettextf("invalid class \"%s\" in '%s' method", class(x)[1L], "Ops") + else gettextf("invalid type \"%s\" in '%s' method", typeof(x), "Ops") +} + +for(.cl in c("Matrix", "sparseVector")) { +setMethod("Ops", signature(e1 = .cl, e2 = "ANY"), + function(e1, e2) + if(any(typeof(e2) == c("logical", "integer", "double"))) { + if(is.matrix(e2)) + callGeneric(e1, unclass(e2)) + else callGeneric(e2, as.vector(e2)) + } else stop(.Ops.invalid(e2), domain = NA)) + +setMethod("Ops", signature(e1 = "ANY", e2 = .cl), + function(e1, e2) + if(any(typeof(e1) == c("logical", "integer", "double"))) { + if(is.matrix(e1)) + callGeneric(unclass(e1), e2) + else callGeneric(as.vector(e1), e2) + } else stop(.Ops.invalid(e1), domain = NA)) + +setMethod("Ops", signature(e1 = .cl, e2 = "NULL"), + function(e1, e2) callGeneric(e1, logical(0L))) + +setMethod("Ops", signature(e1 = "NULL", e2 = .cl), + function(e1, e2) callGeneric(logical(0L), e2)) + +## MJ: OK, but I'd prefer to handle all "matrix" as ".geMatrix" +setMethod("Ops", signature(e1 = .cl, e2 = "matrix"), + function(e1, e2) + if(any(typeof(e2) == c("logical", "integer", "double"))) + callGeneric(e1, Matrix(e2)) + else stop(.Ops.invalid(e2), domain = NA)) + +## MJ: OK, but I'd prefer to handle all "matrix" as ".geMatrix" +setMethod("Ops", signature(e1 = "matrix", e2 = .cl), + function(e1, e2) + if(any(typeof(e1) == c("logical", "integer", "double"))) + callGeneric(Matrix(e1), e2) + else stop(.Ops.invalid(e1), domain = NA)) +} +rm(.cl) +## ^^^^ MJ: for _after_ 1.6-2, ditto ./(Arith|Compare|Logic).R +} .Ops.checkDim <- function(d.a, d.b) { @@ -39,14 +96,6 @@ } else nullDN } -### 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") if(FALSE) { # unused @@ -54,9 +103,6 @@ .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) @@ -74,24 +120,24 @@ 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@x <- -e1@x + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() e1 }) -setMethod("-", signature(e1 = "ldiMatrix", e2 = "missing"), + +setMethod("-", signature(e1 = "diagonalMatrix", 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) + kind <- .M.kind(e1) + r <- new(if(kind == "z") "zdiMatrix" else "ddiMatrix") + r@Dim <- d <- e1@Dim + r@Dimnames <- e1@Dimnames + r@x <- + if(e1@diag != "N") + rep.int(if(kind == "z") -1+0i else -1, d[1L]) + else -(if(kind == "n") e1@x | is.na(e1@x) else e1@x) + r }) @@ -111,33 +157,16 @@ 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")) - .Ops.checkDim(dim(e1), dim(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")) - .Ops.checkDim(dim(e1), dim(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)) - }) + function(e1, e2) + if(is.object(e2) && is.matrix(e2)) + callGeneric(e1, unclass(e2)) # e.g., for "table" + 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")) - .Ops.checkDim(dim(e1), dim(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) + function(e1, e2) + if(is.object(e1) && is.matrix(e1)) + callGeneric(unclass(e1), e2) # e.g., for "table" + else .bail.out.2(.Generic, class(e1), class(e2))) ## "General principle" ## - - - - - - - - - @@ -165,10 +194,11 @@ ## 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) { +.Ops.via.x <- function(e1, e2) { .Ops.checkDim(dim(e1), dim(e2)) e1@x <- callGeneric(e1@x, e2@x) - .empty.factors(e1) + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() e1 } @@ -225,10 +255,6 @@ 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")) { @@ -293,7 +319,7 @@ r@p <- rep.int(0L, 1+nrow(r)) } } else { # some TRUE, FALSE, NA : go via unique 'Tsparse' - M <- asTuniq(e1) + M <- asUniqueT(e1) nCl <- class2(class(M), 'l') # logical Tsparse sN <- slotNames(nCl) ## copy "the other slots" (important for "tr"/"sym"): @@ -309,7 +335,7 @@ lClass <- if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix" - Matrix.msg(sprintf("sparse to dense (%s) coercion in '%s' -> %s", + Matrix.message(sprintf("sparse to dense (%s) coercion in '%s' -> %s", lClass, .Generic, "Cmp.Mat.atomic"), .M.level = 2) rx <- rep_len(r0, n1) @@ -399,9 +425,9 @@ ## 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! + if(is.integer(r)) ## as "igeMatrix" does not yet exist! r <- as.double(r) + kr <- .M.kind(r) if(geM) new(paste0(kr, "geMatrix"), x = r, Dim = d, Dimnames = e1@Dimnames) else @@ -461,7 +487,8 @@ double(0L) else if(l1 == 1 && any(.Generic == c("*","/","+")) && (e1 > 0)) { e2@x <- callGeneric(e1, e2@x) - .empty.factors(e2) + if(length(e2@factors)) + e2@factors <- list() e2 # remains "dpo" } else callGeneric(e1, as(e2, "dsyMatrix")) @@ -472,7 +499,8 @@ double(0L) else if(l1 == 1 && any(.Generic == c("*","/","+")) && (e1 > 0)) { e2@x <- callGeneric(e1, e2@x) - .empty.factors(e2) + if(length(e2@factors)) + e2@factors <- list() e2 # remains "dpp" } else callGeneric(e1, as(e2, "dspMatrix")) @@ -483,7 +511,8 @@ double(0L) else if(l2 == 1 && any(.Generic == c("*","/","+")) && (e2 > 0)) { e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) + if(length(e1@factors)) + e1@factors <- list() e1 # remains "dpo" } else callGeneric(as(e1, "dsyMatrix"), e2) @@ -494,7 +523,8 @@ double(0L) else if(l2 == 1 && any(.Generic == c("*","/","+")) && (e2 > 0)) { e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) + if(length(e1@factors)) + e1@factors <- list() e1 # remains "dpp" } else callGeneric(as(e1, "dspMatrix"), e2) @@ -559,7 +589,8 @@ } 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) + if(length(e1@factors)) + e1@factors <- list() e1 } else stop("length of 2nd arg does not match dimension of first") @@ -579,7 +610,8 @@ } 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) + if(length(e2@factors)) + e2@factors <- list() e2 } else stop("length of 1st arg does not match dimension of 2nd") @@ -619,7 +651,6 @@ 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(.M2gen(e1), e2) @@ -627,7 +658,8 @@ } else { ## symmetric if(le == 1) { ## result remains symmetric e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) + if(length(e1@factors)) + e1@factors <- list() e1 } else { ## (le == d[1] || prod(d) == le) ## *might* remain symmetric, but 'x' may contain garbage @@ -663,7 +695,6 @@ 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, .M2gen(e2)) @@ -671,7 +702,8 @@ } else { ## symmetric if(le == 1) { # result remains symmetric e2@x <- callGeneric(e1, e2@x) - .empty.factors(e2) + if(length(e2@factors)) + e2@factors <- list() e2 } else { ## (le == d[1] || prod(d) == le) ## *might* remain symmetric, but 'x' may contain garbage @@ -839,10 +871,6 @@ 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")) { @@ -908,7 +936,7 @@ r@p <- rep.int(0L, 1+nrow(r)) } } else { # some TRUE, FALSE, NA : go via unique 'Tsparse' - M <- asTuniq(e1) + M <- asUniqueT(e1) nCl <- class2(class(M), 'l') # logical Tsparse sN <- slotNames(nCl) ## copy "the other slots" (important for "tr"/"sym"): @@ -924,7 +952,7 @@ ## non sparse result lClass <- if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix" - Matrix.msg(sprintf("sparse to dense (%s) coercion in '%s' -> %s", + Matrix.message(sprintf("sparse to dense (%s) coercion in '%s' -> %s", lClass, .Generic, "Logic.Mat.atomic"), .M.level = 2) rx <- rep_len(r0, n1) @@ -1028,7 +1056,8 @@ ## 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) + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() return(e1) } ## else : @@ -1046,7 +1075,8 @@ ## 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) + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() return(e1) } ## else : @@ -1088,7 +1118,8 @@ d <- .Ops.checkDim(dim(e1), dim(e2)) .diag2sparse(new("ldiMatrix", Dim = d, x = get(.Generic)(diag(e1), diag(e2))), - shape = "t", repr = "C", uplo = e1@uplo) + kind = ".", shape = "t", repr = "C", + uplo = e1@uplo) } } }) @@ -1161,7 +1192,7 @@ ## ----- setMethod("Arith", signature(e1 = "dsCMatrix", e2 = "dsCMatrix"), function(e1, e2) { - Matrix.msg("suboptimal 'Arith' implementation of 'dsC* o dsC*'") + Matrix.message("suboptimal 'Arith' implementation of 'dsC* o dsC*'") forceSymmetric(callGeneric(.M2gen(e1), .M2gen(e2))) }) @@ -1280,7 +1311,8 @@ e1@diag == "U" && !all(1 == callGeneric(1, e2))) e1 <- .diagU2N(e1, cld) e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() return(e1) } } @@ -1299,7 +1331,8 @@ e2@diag == "U" && !all(1 == callGeneric(e1, 1))) e2 <- .diagU2N(e2, cld) e2@x <- callGeneric(e1, e2@x) - .empty.factors(e2) + if(.hasSlot(e2, "factors") && length(e2@factors)) + e2@factors <- list() return(e2) } } @@ -1332,7 +1365,8 @@ e2 <- e2[.Ops.recycle.ind(e1, len = l2)] } e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) # TODO: possibly rather *update* LU + if(length(e1@factors)) + e1@factors <- list() e1 } else if(mean(is0f) > 7/8) { ## remain sparse ['7/8' is *somewhat* arbitrary] @@ -1340,7 +1374,8 @@ callGeneric(e1, as(e2, "sparseVector")) else { ## l2 == 1: e2 is "scalar" e1@x <- callGeneric(e1@x, e2) - .empty.factors(e1) + if(length(e1@factors)) + e1@factors <- list() e1 } } else { ## non-sparse, since '0 o e2' is not (all) 0 @@ -1373,14 +1408,16 @@ e1 <- e1[.Ops.recycle.ind(e2, len = l1)] } e2@x <- callGeneric(e1, e2@x) - .empty.factors(e2) + if(length(e2@factors)) + e2@factors <- list() 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) + if(length(e2@factors)) + e2@factors <- list() e2 } } else { ## non-sparse, since '0 o e2' is not (all) 0 @@ -1464,7 +1501,7 @@ cD1 <- getClassDef(class(e1)) cD2 <- getClassDef(class(e2)) - Matrix.msg(sprintf("Compare -- \"%s\" %s \"%s\" :\n", + Matrix.message(sprintf("Compare -- \"%s\" %s \"%s\" :\n", cD1@className, .Generic, cD2@className), .M.level = 2) @@ -1600,7 +1637,8 @@ function(e1, e2) { e1 <- diagU2N(e1) e1@x <- -e1@x - .empty.factors(e1) + if(.hasSlot(e1, "factors") && length(e1@factors)) + e1@factors <- list() e1 }) ## with the following exceptions: @@ -1684,7 +1722,7 @@ e1@x <- r e1 } else { - newSpVec(paste0(.V.kind(r), "sparseVector"), + newSpVec(paste0(.M.kind(r), "sparseVector"), x = r, e1) } } @@ -1718,7 +1756,7 @@ e2@x <- r e2 } else { - newSpVec(paste0(.V.kind(r), "sparseVector"), + newSpVec(paste0(.M.kind(r), "sparseVector"), x = r, e2) } } @@ -1885,3 +1923,396 @@ setMethod("Ops", signature(e1 = "sparseVector", e2 = "Matrix"), Ops.spV.M) rm(Ops.M.spV, Ops.spV.M) + + +###---------------- diagonalMatrix ---------------------- + +.diag2tT.smart <- function(from, x, kind = ".") { + shape <- .M.shape(x) + uplo <- if(shape == "t") x@uplo else "U" + .diag2sparse(from, kind, "t", "T", uplo) +} +.diag2T.smart <- function(from, x, kind = ".") { + shape <- .M.shape(x) + uplo <- if(shape == "s" || shape == "t") x@uplo else "U" + .diag2sparse(from, kind, if(shape == "s") "s" else "t", "T", uplo) +} + + .diag.x <- function(m) if(m@diag != "N") rep.int(as1(m@x), m@Dim[1L]) else m@x +..diag.x <- function(m) rep.int(as1(m@x), m@Dim[1L]) + +## 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.double(r)) + r <- as.double(r) + if(is.double(e2@x)) { + e2@x <- r + e2@diag <- "N" + return(e2) + } + if(!is.double(e1@x)) + ## e.g. e1, e2 are logical; + e1 <- .M2kind(e1, "d") + } + else if(is.logical(r)) + e1 <- .M2kind(e1, "l") + else stop(gettextf("intermediate 'r' is of type %s", + typeof(r)), domain=NA) + e1@x <- r + e1@diag <- "N" + 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.message("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(getClassDef("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) + rm(c1, c2) +} +rm(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) +rm(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, + "+" = `diag<-`(e1, as.double(diag(e1, names=FALSE) + .diag.x(e2))), + "-" = `diag<-`(e1, as.double(diag(e1, names=FALSE) - .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 ^ .diag2dense(e2, ".", "g", FALSE) + }, + ## otherwise: + callGeneric(e1, .diag2T.smart(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(.diag2T.smart(e1, e2, kind = "d"), e2)) +setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ddiMatrix"), + function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind = "d"))) +## ldi* +setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "sparseMatrix"), + function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind = "l"), e2)) +setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ldiMatrix"), + function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind = "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 + 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 if(n) { + L1 <- (le <- length(e2)) == 1L + 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.smart(e1, e2, kind = "d"), e2) + }) +rm(arg2) + +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 + 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 { + L1 <- (le <- length(e1)) == 1L + 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.smart(e2, e1, kind = "d")) + }) +rm(arg1) + +## 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 + 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 if(n) { + L1 <- (le <- length(e2)) == 1L + 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.smart(e1, e2, kind = "l"), e2) + }) +rm(arg2) + +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 + 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 if(n) { + L1 <- (le <- length(e1)) == 1L + 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.smart(e2, e1, kind = "l")) + }) +rm(arg1) + +## 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 + 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 if(n) { + L1 <- (le <- length(e2)) == 1L + 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.smart(e1, e2, kind = "d"), e2) + }) +rm(arg2) + +## 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 + 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 if(n) { + L1 <- (le <- length(e2)) == 1L + 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.smart(e1, e2, kind = "l"), e2) + }) +rm(arg2) + +## Not {"sparseMatrix", "numeric} : {"denseMatrix", "matrix", ... } +for(other in c("ANY", "Matrix", "dMatrix")) { + ## ddi*: + setMethod("Ops", signature(e1 = "ddiMatrix", e2 = other), + function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind="d"), e2)) + setMethod("Ops", signature(e1 = other, e2 = "ddiMatrix"), + function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind="d"))) + ## ldi*: + setMethod("Ops", signature(e1 = "ldiMatrix", e2 = other), + function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind="l"), e2)) + setMethod("Ops", signature(e1 = other, e2 = "ldiMatrix"), + function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind="l"))) +} +rm(other) + +## Direct subclasses of "denseMatrix": currently ddenseMatrix, ldense... : +if(FALSE) # now also contains "geMatrix" +dense.subCl <- local({ dM.scl <- getClassDef("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(.diag2T.smart(e1, e2, kind = "d"), e2) + else # "lMatrix", the only other kind for now + function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind = "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) + } +} +rm(dense.subCl, DI, dMeth, c2, Fun) diff -Nru rmatrix-1.6-1.1/R/Rsparse.R rmatrix-1.6-5/R/Rsparse.R --- rmatrix-1.6-1.1/R/Rsparse.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/Rsparse.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,46 +0,0 @@ -## METHODS FOR CLASS: RsparseMatrix (virtual) -## sparse matrices in compressed sparse row (CSR) format -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", - value = "replValue"), - function (x, i, j, ..., value) - replTmat(.M2T(x), i=i, , value=value)) - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", - value = "replValue"), - function (x, i, j, ..., value)# extra " , ": want nargs() == 4 - replTmat(.M2T(x), , j=j, value=value)) - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", - value = "replValue"), - function (x, i, j, ..., value) - replTmat(.M2T(x), i=i, j=j, value=value)) - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", - value = "sparseVector"), - function (x, i, j, ..., value) { - if(nargs() == 3L) - replTmat(.M2T(x), i=i, value=value) # x[i] <- v - else replTmat(.M2T(x), i=i, , value=value) # x[i, ] <- v - }) - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", - value = "sparseVector"), - function (x, i, j, ..., value)# extra " , ": want nargs() == 4 - replTmat(.M2T(x), , j=j, value=value)) - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", - value = "sparseVector"), - function (x, i, j, ..., value) - replTmat(.M2T(x), i=i, j=j, value=value)) - - -setReplaceMethod("[", signature(x = "RsparseMatrix", i = "matrix", j = "missing", - value = "replValue"), - function (x, i, j, ..., value) { - if(nargs() == 3L) - .TM.repl.i.mat(.M2T(x), i=i, value=value) - else replTmat(.M2T(x), i=as.vector(i), , value=value) - }) diff -Nru rmatrix-1.6-1.1/R/Summary.R rmatrix-1.6-5/R/Summary.R --- rmatrix-1.6-1.1/R/Summary.R 2023-07-30 17:42:36.000000000 +0000 +++ rmatrix-1.6-5/R/Summary.R 2023-10-04 08:10:46.000000000 +0000 @@ -1,330 +1,161 @@ -####--- All "Summary" group methods for all Matrix classes (incl sparseVector) ------ -#### ======= but diagonalMatrix -> ./diagMatrix.R and abIndex.R -#### ~~~~~~~~~~~~ ~~~~~~~~~ +## METHODS FOR GENERIC: Summary (group) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## M-x grep -E -e 'Method\("(Summary|max|min|range|all|any|prod|sum)"' *.R -## ---- +## > getGroupMembers("Summary") +## [1] "max" "min" "range" "prod" "sum" "any" "all" -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) +## NB: Summary depends on the existence, _not_ count, of zeros and ones. +## The only exception is 'sum' which ignores zeros and counts ones. -###---------- 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(.M2gen(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(.M2gen(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 <- .M2C(x) # = 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) .M2gen(x) 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(.M2gen(x)@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(.M2gen(x)@x, ..., na.rm = na.rm) - } -} - -setMethod("Summary", "ldenseMatrix", Summ.ln.dense) -setMethod("Summary", "ndenseMatrix", Summ.ln.dense) -rm(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(.M2gen(x)@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) +setMethod("Summary", signature(x = "denseMatrix"), + function(x, ..., na.rm = FALSE) { + ## Avoid wrong overflow : + if(.Generic == "sum") + return(sum (.Call(R_dense_sum , x, na.rm), + ..., na.rm = na.rm)) + if(.Generic == "prod") + return(prod(.Call(R_dense_prod, x, na.rm), + ..., na.rm = na.rm)) + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + repr <- substr(cl, 3L, 3L) + zero <- switch(kind, "n" = , "l" = FALSE, "i" = 0L, "d" = 0, "z" = 0+0i) + if(shape != "g") { + if(repr != "p") + x <- .M2packed(x) + if(shape == "t" && x@diag != "N") + diag(x) <- TRUE # copying, sadly } - ii <- seq_along(args) - ii[c(1,i)] <- c(i,1) - do.call(min, c(args[ii], list(na.rm=na.rm))) + n <- x@Dim[2L] + y <- x@x + y1 <- if(kind != "n" || !anyNA(y)) + y + else y | is.na(y) + y2 <- if(shape == "t" && n > 1L) + zero + get(.Generic, mode = "function")(y1, y2, ..., 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(Matrix.verbose() >= 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) -rm(Summary.l, 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 <- .M2C(x))) - ## 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", signature(x = "sparseMatrix"), + function(x, ..., na.rm = FALSE) { + ## Avoid wrong overflow : + if(.Generic == "sum") + return(sum (.Call(R_sparse_sum , x, na.rm), + ..., na.rm = na.rm)) + if(.Generic == "prod") + return(prod(.Call(R_sparse_prod, x, na.rm), + ..., na.rm = na.rm)) + cl <- .M.nonvirtual(x) + kind <- substr(cl, 1L, 1L) + shape <- substr(cl, 2L, 2L) + repr <- substr(cl, 3L, 3L) + switch(kind, + "n" = , + "l" = { zero <- FALSE; one <- TRUE }, + "i" = { zero <- 0L ; one <- 1L }, + "d" = { zero <- 0 ; one <- 1 }, + "z" = { zero <- 0+0i ; one <- 1+0i }) + ## Handle overallocation (hopefully rare ...) : + if(repr == "T") { + x <- aggregateT(x) + nnz <- length(x@i) + } else { + nnz <- { p <- x@p; p[length(p)] } + if(length(if(repr == "C") x@i else x@j) > nnz) { + h <- seq_len(nnz) + if(repr == "C") + x@i <- x@i[h] + else + x@j <- x@j[h] + if(kind != "n") + x@x <- x@x[h] + } + } + n <- (d <- x@Dim)[2L] + nnz.max <- if(shape == "s") 0.5 * (prod(d) + n) else prod(d) + y1 <- if(kind != "n") + x@x + else if(nnz > 0L) + TRUE + else logical(0L) + y2 <- if(nnz < nnz.max) + zero + y3 <- if(n > 0L && shape == "t" && x@diag != "N") + one + get(.Generic, mode = "function")(y1, y2, y3, ..., na.rm = na.rm) + }) -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))) - }) +setMethod("Summary", signature(x = "diagonalMatrix"), + function(x, ..., na.rm = FALSE) { + kind <- .M.kind(x) + switch(kind, + "n" = , + "l" = { zero <- FALSE; one <- TRUE }, + "i" = { zero <- 0L ; one <- 1L }, + "d" = { zero <- 0 ; one <- 1 }, + "z" = { zero <- 0+0i ; one <- 1+0i }) + n <- x@Dim[2L] + y1 <- if(x@diag == "N") { + y <- x@x + if(kind != "n") { + if(.Generic == "prod" && n > 1L) + ## Avoid wrong overflow : + c(y[1L], zero, y[-1L]) + else y + } + else if(!anyNA(y)) + y + else y | is.na(y) + } + y2 <- if(n > 1L) + zero + y3 <- if(x@diag != "N") { + if(.Generic == "sum") + one * n + else if(n > 0L) + one + else one[0L] + } + get(.Generic, mode = "function")(y1, y2, y3, ..., na.rm = na.rm) + }) -## 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 - } - }) +setMethod("Summary", signature(x = "indMatrix"), + function(x, ..., na.rm = FALSE) { + nnz <- length(x@perm) + y1 <- if(.Generic == "sum") + nnz + else if(nnz > 0L) + TRUE + else logical(0L) + y2 <- if(nnz < prod(x@Dim)) + FALSE + get(.Generic, mode = "function")(y1, y2, ..., na.rm = na.rm) + }) -## 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 +setMethod("Summary", signature(x = "sparseVector"), + function(x, ..., na.rm = FALSE) { + kind <- .M.kind(x) + zero <- switch(kind, "n" = , "l" = FALSE, "i" = 0L, "d" = 0, "z" = 0+0i) + nnz <- length(i <- x@i) + nnz.max <- length(x) + y1 <- if(kind != "n") { + y <- x@x + if(.Generic == "prod" && nnz > 0L && nnz < nnz.max) { + ## Avoid wrong overflow : + if(i[1L] > 1L) + c(zero, y) + else if(nnz >= (q <- which.min(i == seq_along(i)))) + c(y[1L:(q - 1L)], zero, y[q:nnz]) + else y + } else y + } + else if(.Generic == "sum") + nnz + else if(nnz > 0L) + TRUE + else logical(0L) + y2 <- if(nnz < nnz.max) + zero + get(.Generic, mode = "function")(y1, y2, ..., na.rm = na.rm) + }) diff -Nru rmatrix-1.6-1.1/R/Tsparse.R rmatrix-1.6-5/R/Tsparse.R --- rmatrix-1.6-1.1/R/Tsparse.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/Tsparse.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,684 +0,0 @@ -## METHODS FOR CLASS: CTsparseMatrix (virtual) -## sparse matrices in triplet format -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - -##' 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) -} - -###========= 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 <- .M2gen(x) - 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 cached 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 cached 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 - Matrix.msg("M[i,j] <- v : coercing symmetric M[] into non-symmetric") - x <- .M2gen(x) - 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 cached 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 cached 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(!isTRUE(getOption("Matrix.quiet"))) - message(gettextf("x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix"), - domain = NA) - return(replCmat4(.M2C(x), 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 cached 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 - Matrix.msg("M[ij] <- v : coercing symmetric M[] into non-symmetric") - x <- .M2gen(x) - 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("M[ij] <- v : duplicate ij-entries; using last") - 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 <- is.logical(value) # will result remain "nMatrix" ? - if(!isN) - x <- .M2kind(x, "d") - } - 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 <- is0(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 cached 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) diff -Nru rmatrix-1.6-1.1/R/all.equal.R rmatrix-1.6-5/R/all.equal.R --- rmatrix-1.6-1.1/R/all.equal.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/all.equal.R 2023-10-11 13:25:02.000000000 +0000 @@ -0,0 +1,194 @@ +## METHODS FOR GENERIC: all.equal +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.V.a.e <- function(target, current, ...) { + if((l1 <- length(target)) != (l2 <- length(current))) + return(paste0("length(target) is ", l1, ", length(current) is ", l2)) + if(is.integer(l1) || l1 <= .Machine$integer.max) { + i1 <- as.integer( target@i) + i2 <- as.integer(current@i) + } else { + i1 <- trunc( target@i) + i2 <- trunc(current@i) + } + x1 <- if(.hasSlot( target, "x")) target@x else rep.int(TRUE, length(i1)) + x2 <- if(.hasSlot(current, "x")) current@x else rep.int(TRUE, length(i2)) + if(!identical(i1, i2)) { + i3 <- sort.int(unique.default(c(i1, i2))) + x1 <- replace(vector(typeof(x1), length(i3)), match(i1, i3, 0L), x1) + x2 <- replace(vector(typeof(x2), length(i3)), match(i2, i3, 0L), x2) + } + all.equal(x1, x2, ...) +} + +.M.attributes <- +function(x, exclude.informal, exclude.factors) { + a <- attributes(x) + if(isS4(x) && exclude.informal) + a <- a[.slotNames(a)] + if(length(a) == 0L) + return(NULL) + exclude <- + if(!isS4(x)) + c("class", "dim", "dimnames") + else if(.isMatrix(x)) + c("class", "Dim", "Dimnames", + switch(.M.repr(x), + "C" = c("p", "i", if(.M.kind(x) != "n") "x"), + "R" = c("p", "j", if(.M.kind(x) != "n") "x"), + "T" = c("i", "j", if(.M.kind(x) != "n") "x"), + "d" = , "u" = , "p" = "x", + "i" = "perm"), + switch(.M.shape(x), + "g" = if(exclude.factors) "factors", + "s" = c("uplo", if(exclude.factors) "factors"), + "t" = c("uplo", "diag"), + "d" = "diag")) + else "class" + nms <- names(a) + i <- match(nms, exclude, 0L) == 0L + if(any(i)) a[sort.int(nms[i])] else NULL +} + +.M.attr.all.equal <- +function(target, current, + check.type, check.class, check.attributes, check.factors, ...) { + msg <- msg. <- NULL + if(check.type && !identical(t1 <- typeof(target), t2 <- typeof(current))) + msg <- c(msg, paste0("typeof(target) is ", deparse(t1), ", typeof(current) is ", deparse(t2))) + if(check.class && !identical(c1 <- class(target), c2 <- class(current))) + msg <- c(msg, paste0( "class(target) is ", deparse(c1), ", class(current) is ", deparse(c2))) + if(is.na(check.attributes) || check.attributes) { + if(!isTRUE(ae <- all.equal.raw(dim(target), dim(current), ...))) + msg <- c(msg, paste0("dim: < ", ae, " >")) + if(!isTRUE(ae <- all.equal.list(dimnames( target) %||% list(NULL, NULL), + dimnames(current) %||% list(NULL, NULL), + ...))) + msg <- c(msg, paste0("dimnames: < ", ae, " >")) + a1 <- .M.attributes( target, is.na(check.attributes), !check.factors) + a2 <- .M.attributes(current, is.na(check.attributes), !check.factors) + if(!((is.null(a1) && is.null(a2)) || + isTRUE(ae <- all.equal.list(a1, a2, ...)))) + msg <- msg. <- c(msg, paste0("Attributes: < ", ae, " >")) + } + list(msg, is.null(msg) != is.null(msg.)) +} + +.M.all.equal <- +function(target, current, + check.type = check.class, + check.class = TRUE, + check.attributes = TRUE, + check.factors = FALSE, ...) { + msg <- .M.attr.all.equal(target, current, + check.type = check.type, + check.class = check.class, + check.attributes = check.attributes, + check.factors = check.factors, ...) + if(!msg[[2L]]) { + ae <- + if(.isVector( target) || .isSparse( target) || + .isVector(current) || .isSparse(current)) { + v1 <- as( target, "sparseVector") + v2 <- as(current, "sparseVector") + ae <- .V.a.e(v1, v2, ...) + } else { + v1 <- as( target, "vector") + v2 <- as(current, "vector") + ae <- all.equal(v1, v2, ...) + } + if(!isTRUE(ae)) + return(c(msg[[1L]], ae)) + } + if(is.null(msg[[1L]])) TRUE else msg[[1L]] +} + +setMethod("all.equal", signature(target = "Matrix", current = "vector"), + .M.all.equal) + +setMethod("all.equal", signature(target = "vector", current = "Matrix"), + .M.all.equal) + +setMethod("all.equal", signature(target = "Matrix", current = "Matrix"), + .M.all.equal) + +## And for completeness: + +setMethod("all.equal", signature(target = "Matrix", current = "sparseVector"), + .M.all.equal) + +.V.attributes <- +function(x, exclude.informal) { + a <- attributes(x) + if(isS4(x) && exclude.informal) + a <- a[.slotNames(a)] + if(length(a) == 0L) + return(NULL) + exclude <- + if(.isVector(x)) + c("class", "length", "i", if(.M.kind(x) != "n") "x") + else "class" + nms <- names(a) + i <- match(nms, exclude, 0L) == 0L + if(any(i)) a[sort.int(nms[i])] else NULL +} + +.V.attr.all.equal <- +function(target, current, + check.type, check.class, check.attributes, ...) { + msg <- msg. <- NULL + if(check.type && !identical(t1 <- typeof(target), t2 <- typeof(current))) + msg <- c(msg, paste0("typeof(target) is ", deparse(t1), ", typeof(current) is ", deparse(t2))) + if(check.class && !identical(c1 <- class(target), c2 <- class(current))) + msg <- c(msg, paste0( "class(target) is ", deparse(c1), ", class(current) is ", deparse(c2))) + if(is.na(check.attributes) || check.attributes) { + if((l1 <- length(target)) != (l2 <- length(current))) + msg <- c(msg, paste0("length(target) is ", l1, ", length(current) is ", l2)) + a1 <- .V.attributes( target, is.na(check.attributes)) + a2 <- .V.attributes(current, is.na(check.attributes)) + if(!((is.null(a1) && is.null(a2)) || + isTRUE(ae <- all.equal.list(a1, a2, ...)))) + msg <- msg. <- c(msg, paste0("Attributes: < ", ae, " >")) + } + list(msg, is.null(msg) != is.null(msg.)) +} + +.V.all.equal <- +function(target, current, + check.type = check.class, + check.class = TRUE, + check.attributes = TRUE, ...) { + msg <- .V.attr.all.equal(target, current, + check.type = check.type, + check.class = check.class, + check.attributes = check.attributes, ...) + if(!msg[[2L]]) { + if(.isVector( target) || .isSparse( target) || + .isVector(current) || .isSparse(current)) { + v1 <- as( target, "sparseVector") + v2 <- as(current, "sparseVector") + ae <- .V.a.e(v1, v2, ...) + } else { + v1 <- as( target, "vector") + v2 <- as(current, "vector") + ae <- all.equal(v1, v2, ...) + } + if(!isTRUE(ae)) + return(c(msg[[1L]], ae)) + } + if(is.null(msg[[1L]])) TRUE else msg[[1L]] +} + +setMethod("all.equal", signature(target = "sparseVector", current = "vector"), + .V.all.equal) + +setMethod("all.equal", signature(target = "vector", current = "sparseVector"), + .V.all.equal) + +setMethod("all.equal", signature(target = "sparseVector", current = "sparseVector"), + .V.all.equal) + +## And for completeness: + +setMethod("all.equal", signature(target = "sparseVector", current = "Matrix"), + .V.all.equal) diff -Nru rmatrix-1.6-1.1/R/bandSparse.R rmatrix-1.6-5/R/bandSparse.R --- rmatrix-1.6-1.1/R/bandSparse.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/bandSparse.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,101 +0,0 @@ -bandSparse <- 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" = .M2C(T), "T" = T, "R" = .M2R(T), - 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) - } -} diff -Nru rmatrix-1.6-1.1/R/bind2.R rmatrix-1.6-5/R/bind2.R --- rmatrix-1.6-1.1/R/bind2.R 2023-08-10 16:20:07.000000000 +0000 +++ rmatrix-1.6-5/R/bind2.R 2023-12-06 18:46:20.000000000 +0000 @@ -1,453 +1,91 @@ -## METHODS FOR GENERIC: cbind2, rbind2 +## METHODS FOR GENERIC: c ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## GOAL: write methods that preallocate, i.e., do _not_ use [cr]bind2, -## and maybe implement c.Matrix and *.sparseVector similarly ... ? -if(TRUE) { -.cbind <- function(..., deparse.level = 1) - .External(R_bind, deparse.level, 1L, substitute(list(...)), ...) -.rbind <- function(..., deparse.level = 1) - .External(R_bind, deparse.level, 0L, substitute(list(...)), ...) -} - -bindDim <- function(d.x, d.y, margin) { - r <- d.x - if(d.x[margin] != d.y[margin]) { - if(margin == 1L) - stop("number of rows of matrices must match") - else stop("number of columns of matrices must match") +c.Matrix <- function(...) { + if(nargs() == 0L) + return(NULL) + args <- lapply(list(...), as.vector) + unlist(args, FALSE, TRUE) +} + +c.sparseVector <- function(...) { + N <- nargs() + if(N == 0L) + return(NULL) + args <- lapply(list(...), as, "sparseVector") + args.length <- vapply(args, slot, 0, "length") + args.i <- lapply(args, slot, "i") + args.nnz <- lengths(args.i, FALSE) + + s <- c("n", "l", "i", "d", "z") + i <- match(vapply(args, .M.kind, ""), s) + k <- range(i) + n <- sum(args.length) + a <- if(n - 1 <= .Machine$integer.max) as.integer else as.double + + r <- new(paste0(s[k[2L]], "sparseVector")) + r@length <- a(n) + r@i <- a(unlist(args.i, FALSE, FALSE)) + + rep.int(cumsum(c(0L, a(args.length)[-N])), args.nnz) + if(k[2L] > 1L) { + if(k[1L] > 1L) + args.x <- lapply(args, slot, "x") + else { + pattern <- i == 1L + args.x <- vector("list", N) + args.x[!pattern] <- lapply(args [!pattern], slot, "x") + args.x[ pattern] <- lapply(args.nnz[ pattern], rep.int, x = TRUE) + } + r@x <- unlist(args.x, FALSE, FALSE) } - n.x <- d.x[-margin] - n.y <- d.y[-margin] - if(n.y > .Machine$integer.max - n.x) - stop("dimensions cannot exceed 2^31-1") - r[-margin] <- n.x + n.y r } -bindDimnames <- function(dn.x, dn.y, d.x, d.y, margin) { - r <- list(NULL, NULL) - if(!(is.null(tmp <- dn.x[[margin]]) && is.null(tmp <- dn.y[[margin]]))) - r[[margin]] <- tmp - nms.x <- dn.x[[-margin]] - nms.y <- dn.y[[-margin]] - if(!(is.null(nms.x) && is.null(nms.y))) - r[[-margin]] <- - c(if(is.null(nms.x)) character(d.x[-margin]) else nms.x, - if(is.null(nms.y)) character(d.y[-margin]) else nms.y) - r -} - - -## ==== Trivial special cases ========================================== - -setMethod("cbind2", signature(x = "Matrix", y = "missing"), - function(x, y, ...) x) -setMethod("cbind2", signature(x = "Matrix", y = "NULL"), - function(x, y, ...) x) -setMethod("cbind2", signature(x = "NULL", y = "Matrix"), - function(x, y, ...) y) -if(FALSE) { -## Correct, but breaks evclust ... leaving for 1.6-2 -setMethod("cbind2", signature(x = "Matrix", y = "vector"), - function(x, y, ...) cbind2(x, matrix(y, x@Dim[1L], 1L))) -setMethod("cbind2", signature(x = "vector", y = "Matrix"), - function(x, y, ...) cbind2(matrix(x, y@Dim[1L], 1L), y)) -} else { -setMethod("cbind2", signature(x = "Matrix", y = "vector"), - function(x, y, ...) cbind2(x, matrix(y, nrow = x@Dim[1L]))) -setMethod("cbind2", signature(x = "vector", y = "Matrix"), - function(x, y, ...) cbind2(matrix(x, nrow = y@Dim[1L]), y)) -} - -setMethod("rbind2", signature(x = "Matrix", y = "missing"), - function(x, y, ...) x) -setMethod("rbind2", signature(x = "Matrix", y = "NULL"), - function(x, y, ...) x) -setMethod("rbind2", signature(x = "NULL", y = "Matrix"), - function(x, y, ...) y) +## These are insufficient as dispatch only consides the first argument, +## which need not be a Matrix or sparseVector: if(FALSE) { -## Correct, but breaks evclust ... leaving for 1.6-2 -setMethod("rbind2", signature(x = "Matrix", y = "vector"), - function(x, y, ...) rbind2(x, matrix(y, 1L, x@Dim[2L]))) -setMethod("rbind2", signature(x = "vector", y = "Matrix"), - function(x, y, ...) rbind2(matrix(x, 1L, y@Dim[2L]), y)) -} else { -setMethod("rbind2", signature(x = "Matrix", y = "vector"), - function(x, y, ...) rbind2(x, matrix(y, ncol = x@Dim[2L]))) -setMethod("rbind2", signature(x = "vector", y = "Matrix"), - function(x, y, ...) rbind2(matrix(x, ncol = y@Dim[2L]), y)) +setMethod("c", "Matrix", function(x, ...) c.Matrix (x, ...)) +setMethod("c", "sparseVector", function(x, ...) c.sparseVector(x, ...)) } -###-- General ----------------------------------------------------------- +## METHODS FOR GENERIC: cbind, rbind +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -###-- Dense, incl Diagonal ---------------------------------------------- +## MJ: not yet registered or exported +cbind.Matrix <- function(..., deparse.level = 1) + .External(R_bind, deparse.level, 1L, substitute(list(...)), ...) +rbind.Matrix <- function(..., deparse.level = 1) + .External(R_bind, deparse.level, 0L, substitute(list(...)), ...) -###-- Sparse ------------------------------------------------------------ -setMethod("cbind2", signature(x = "sparseMatrix", y = "matrix"), - function(x, y, ...) cbind2(x, .m2sparse(y, ".gC"))) -setMethod("cbind2", signature(x = "matrix", y = "sparseMatrix"), - function(x, y, ...) cbind2(.m2sparse(x, ".gC"), y)) -setMethod("rbind2", signature(x = "sparseMatrix", y = "matrix"), - function(x, y, ...) rbind2(x, .m2sparse(y, ".gC"))) -setMethod("rbind2", signature(x = "matrix", y = "sparseMatrix"), - function(x, y, ...) rbind2(.m2sparse(x, ".gC"), y)) - -## originally from ./Matrix.R : ------------------------------- - -## Makes sure one gets x decent error message for the unimplemented cases: -setMethod("cbind2", signature(x = "Matrix", y = "Matrix"), - function(x, y, ...) { - bindDim(x@Dim, y@Dim, 1L) - .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, ...) { - bindDim(x@Dim, y@Dim, 2L) - 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 <- .M2gen(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 <- .M2gen(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, .m2dense(y, ".ge"))) -setMethod("cbind2", signature(x = "matrix", y = "denseMatrix"), - function(x, y, ...) cbind2(.m2dense(x, ".ge"), y)) - -setMethod("cbind2", signature(x = "denseMatrix", y = "denseMatrix"), - function(x, y, ...) { - d.x <- x@Dim - d.y <- y@Dim - d.r <- bindDim(d.x, d.y, 1L) - ## beware of (packed) triangular, symmetric, ... - x <- .M2gen(x) - y <- .M2gen(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 <- d.r - x@Dimnames <- bindDimnames(dimnames(x), dimnames(y), d.x, d.y, 1L) - x - } else if(identical(tr, typeof(y@x))) { - y@x <- xx - y@Dim <- d.r - y@Dimnames <- bindDimnames(dimnames(x), dimnames(y), d.x, d.y, 1L) - 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, .m2dense(y, ".ge"))) -setMethod("rbind2", signature(x = "matrix", y = "denseMatrix"), - function(x, y, ...) rbind2(.m2dense(x, ".ge"), y)) - -setMethod("rbind2", signature(x = "denseMatrix", y = "denseMatrix"), - function(x, y, ...) { - d.x <- x@Dim - d.y <- y@Dim - d.r <- bindDim(d.x, d.y, 2L) - ## beware of (packed) triangular, symmetric, ... - x <- .M2gen(x) - y <- .M2gen(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 <- d.r - x@Dimnames <- bindDimnames(dimnames(x), dimnames(y), d.x, d.y, 2L) - x - } else if(identical(tr, typeof(y@x))) { - y@x <- xx - y@Dim <- d.r - y@Dimnames <- bindDimnames(dimnames(x), dimnames(y), d.x, d.y, 2L) - 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"} - -setMethod("cbind2", signature(x = "diagonalMatrix", y = "sparseMatrix"), - function(x, y, ...) - cbind2(.diag2sparse(x, "g", "C"), .M2C(y))) -setMethod("cbind2", signature(x = "sparseMatrix", y = "diagonalMatrix"), - function(x, y, ...) - cbind2(.M2C(x), .diag2sparse(y, "g", "C"))) -setMethod("rbind2", signature(x = "diagonalMatrix", y = "sparseMatrix"), - function(x, y, ...) - rbind2(.diag2sparse(x, "g", "C"), .M2C(y))) -setMethod("rbind2", signature(x = "sparseMatrix", y = "diagonalMatrix"), - function(x, y, ...) - rbind2(.M2C(x), .diag2sparse(y, "g", "C"))) - -## in order to evade method dispatch ambiguity, but still remain "general" -## we use this hack instead of signature x = "diagonalMatrix" -for(cls in names(getClassDef("diagonalMatrix")@subclasses)) { - -setMethod("cbind2", signature(x = cls, y = "matrix"), - function(x, y, ...) - cbind2(.diag2sparse(x, "g", "C"), .m2sparse(y, ".gC"))) -setMethod("cbind2", signature(x = "matrix", y = cls), - function(x, y, ...) - cbind2(.m2sparse(x, ".gC"), .diag2sparse(y, "g", "C"))) -setMethod("rbind2", signature(x = cls, y = "matrix"), - function(x, y, ...) - rbind2(.diag2sparse(x, "g", "C"), .m2sparse(y, ".gC"))) -setMethod("rbind2", signature(x = "matrix", y = cls), - function(x, y, ...) - rbind2(.m2sparse(x, ".gC"), .diag2sparse(y, "g", "C"))) - - ## These are already defined for "Matrix" - ## -- repeated here for method dispatch disambiguation {"design-FIXME" ?} -setMethod("cbind2", signature(x = cls, y = "vector"), - function(x, y, ...) cbind2(x, matrix(y, nrow = nrow(x)))) -setMethod("cbind2", signature(x = "vector", y = cls), - function(x, y, ...) cbind2(matrix(x, nrow = nrow(y)), y)) -setMethod("rbind2", signature(x = cls, y = "vector"), - function(x, y, ...) rbind2(x, matrix(y, ncol = ncol(x)))) -setMethod("rbind2", signature(x = "vector", y = cls), - function(x, y, ...) rbind2(matrix(x, ncol = ncol(y)), y)) +## METHODS FOR GENERIC: cbind2, rbind2 +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -} -rm(cls) +.cbind2 <- function(x, y, ...) cbind.Matrix(x, y, deparse.level = 0L) +.rbind2 <- function(x, y, ...) rbind.Matrix(x, y, deparse.level = 0L) -## originally from ./dsparseMatrix.R : -------------------------------- +setMethod("cbind2", signature(x = "Matrix", y = "missing"), + function(x, y, ...) x) +setMethod("rbind2", signature(x = "Matrix", y = "missing"), + function(x, y, ...) x) -## FIXME: dimnames() handling should happen in C code -## ------> ../src/Csparse.c +setMethod("cbind2", signature(x = "Matrix", y = "NULL"), .cbind2) +setMethod("cbind2", signature(x = "NULL", y = "Matrix"), .cbind2) +setMethod("rbind2", signature(x = "Matrix", y = "NULL"), .rbind2) +setMethod("rbind2", signature(x = "NULL", y = "Matrix"), .rbind2) + +setMethod("cbind2", signature(x = "Matrix", y = "vector"), .cbind2) +setMethod("cbind2", signature(x = "vector", y = "Matrix"), .cbind2) +setMethod("rbind2", signature(x = "Matrix", y = "vector"), .rbind2) +setMethod("rbind2", signature(x = "vector", y = "Matrix"), .rbind2) + +setMethod("cbind2", signature(x = "Matrix", y = "matrix"), .cbind2) +setMethod("cbind2", signature(x = "matrix", y = "Matrix"), .cbind2) +setMethod("rbind2", signature(x = "Matrix", y = "matrix"), .rbind2) +setMethod("rbind2", signature(x = "matrix", y = "Matrix"), .rbind2) -## Fast - almost non-checking methods -.cbind2Csp <- function(x, y) .Call(Csparse_horzcat, asCspN(x), asCspN(y)) -.rbind2Csp <- function(x, y) .Call(Csparse_vertcat, asCspN(x), asCspN(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, ...) { - bindDim(x@Dim, y@Dim, 1L) - 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, ...) { - bindDim(x@Dim, y@Dim, 2L) - rbind2sparse(x, y) - }) - -setMethod("cbind2", signature(x = "sparseMatrix", y = "denseMatrix"), - function(x, y, sparse = NA, ...) { - d.r <- bindDim(x@Dim, y@Dim, 1L) - if(is.na(sparse)) - sparse <- - 2 * (nnzero(x, na.counted = TRUE) + - nnzero(y, na.counted = TRUE)) < - as.double(d.r[1L]) * (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, sparse = NA, ...) { - d.r <- bindDim(x@Dim, y@Dim, 1L) - if(is.na(sparse)) - sparse <- - 2 * (nnzero(x, na.counted = TRUE) + - nnzero(y, na.counted = TRUE)) < - as.double(d.r[1L]) * (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, ...) { - d.r <- bindDim(x@Dim, y@Dim, 2L) - if(is.na(sparse)) - sparse <- - 2 * (nnzero(x, na.counted = TRUE) + - nnzero(y, na.counted = TRUE)) < - (nrow(x) + nrow(y)) * as.double(d.r[2L]) - if(sparse) - rbind2sparse(x, y) - else rbind2(as(x, "denseMatrix"), y) - }) -setMethod("rbind2", signature(x = "denseMatrix", y = "sparseMatrix"), - function(x, y, sparse = NA, ...) { - d.r <- bindDim(x@Dim, y@Dim, 2L) - if(is.na(sparse)) - sparse <- - 2 * (nnzero(x, na.counted = TRUE) + - nnzero(y, na.counted = TRUE)) < - (nrow(x) + nrow(y)) * as.double(d.r[2L]) - if(sparse) - rbind2sparse(x, y) - else rbind2(x, as(y, "denseMatrix")) - }) +setMethod("cbind2", signature(x = "Matrix", y = "Matrix"), .cbind2) +setMethod("rbind2", signature(x = "Matrix", y = "Matrix"), .rbind2) -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]) - } - 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) - } - y@Dim[2] <- nc + 1L - if(is.character(dn <- y@Dimnames[[2]])) - y@Dimnames[[2]] <- c(dn, "") - y - }) -}## -- no longer - -setMethod("rbind2", signature(x = "indMatrix", y = "indMatrix"), - function(x, y, ...) { - if(x@margin != 1L || y@margin != 1L) - return(rbind2(as(x, "RsparseMatrix"), as(y, "RsparseMatrix"))) - d.x <- x@Dim - d.y <- y@Dim - r <- new("indMatrix") - r@Dim <- bindDim(d.x, d.y, 2L) - r@Dimnames <- bindDimnames(x@Dimnames, y@Dimnames, d.x, d.y, 2L) - r@perm <- c(x@perm, y@perm) - r - }) - -setMethod("cbind2", signature(x = "indMatrix", y = "indMatrix"), - function(x, y, ...) { - if(x@margin == 1L || y@margin == 1L) - return(cbind2(as(x, "CsparseMatrix"), as(y, "CsparseMatrix"))) - d.x <- x@Dim - d.y <- y@Dim - r <- new("indMatrix") - r@Dim <- bindDim(d.x, d.y, 1L) - r@Dimnames <- bindDimnames(x@Dimnames, y@Dimnames, d.x, d.y, 1L) - r@perm <- c(x@perm, y@perm) - r@margin <- 2L - r - }) +rm(.cbind2, .rbind2) diff -Nru rmatrix-1.6-1.1/R/chol.R rmatrix-1.6-5/R/chol.R --- rmatrix-1.6-1.1/R/chol.R 2023-07-30 20:02:18.000000000 +0000 +++ rmatrix-1.6-5/R/chol.R 2023-09-22 19:22:19.000000000 +0000 @@ -8,6 +8,10 @@ ch }) +setMethod("chol", signature(x = "symmetricMatrix"), + function(x, ...) + chol(.M2kind(x, ","), ...)) + setMethod("chol", signature(x = "triangularMatrix"), function(x, uplo = "U", ...) { if(identical(uplo, x@uplo)) { @@ -17,13 +21,9 @@ } else chol(forceDiagonal(x, x@diag), ...) }) -setMethod("chol", signature(x = "symmetricMatrix"), - function(x, ...) - chol(as(x, "dMatrix"), ...)) - setMethod("chol", signature(x = "diagonalMatrix"), function(x, ...) - chol(.M2kind(x, "d"), ...)) + chol(.M2kind(x, ","), ...)) setMethod("chol", signature(x = "dsyMatrix"), function(x, pivot = FALSE, tol = -1, ...) { @@ -47,12 +47,15 @@ ch@Dimnames <- dimnames(x) ch }) +rm(.cl) setMethod("chol", signature(x = "ddiMatrix"), function(x, ...) { if(length(y <- x@x)) { if(is.na(min.y <- min(y)) || min.y < 0) - stop("chol(x) is undefined: 'x' is not positive semidefinite") + stop(gettextf("%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite", + "chol", "x"), + domain = NA) x@x <- sqrt(y) } x @@ -69,6 +72,10 @@ ch }) +setMethod("Cholesky", signature(A = "symmetricMatrix"), + function(A, ...) + Cholesky(.M2kind(A, ","), ...)) + setMethod("Cholesky", signature(A = "triangularMatrix"), function(A, uplo = "U", ...) { ch <- Cholesky(forceSymmetric(A, uplo), ...) @@ -76,13 +83,9 @@ ch }) -setMethod("Cholesky", signature(A = "symmetricMatrix"), - function(A, ...) - Cholesky(as(A, "dMatrix"), ...)) - setMethod("Cholesky", signature(A = "diagonalMatrix"), function(A, ...) - Cholesky(.M2kind(A, "d"), ...)) + Cholesky(.M2kind(A, ","), ...)) setMethod("Cholesky", signature(A = "dsyMatrix"), function(A, perm = TRUE, tol = -1, ...) @@ -108,7 +111,9 @@ setMethod("Cholesky", signature(A = "ddiMatrix"), function(A, ...) { if(length(y <- A@x) && (is.na(min.y <- min(y)) || min.y < 0)) - stop("Cholesky(A) is undefined: 'A' is not positive semidefinite") + stop(gettextf("%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite", + "Cholesky", "x"), + domain = NA) n <- (d <- A@Dim)[1L] r <- new("dCHMsimpl") r@Dim <- d @@ -149,36 +154,29 @@ setMethod("chol2inv", signature(x = "triangularMatrix"), function(x, ...) - chol2inv(as(x, "dMatrix"), ...)) + chol2inv(.M2kind(x, ","), ...)) setMethod("chol2inv", signature(x = "diagonalMatrix"), function(x, ...) - chol2inv(.M2kind(x, "d"), ...)) + chol2inv(.M2kind(x, ","), ...)) -setMethod("chol2inv", signature(x = "dtrMatrix"), - function(x, ...) { - if(x@diag != "N") - x <- ..diagU2N(x) - r <- .Call(Cholesky_solve, x, NULL, FALSE) - i <- if(x@uplo == "U") 2L else 1L - r@Dimnames <- x@Dimnames[c(i, i)] - r - }) - -setMethod("chol2inv", signature(x = "dtpMatrix"), +for(.cl in paste0("dt", c("r", "p"), "Matrix")) +setMethod("chol2inv", signature(x = .cl), function(x, ...) { if(x@diag != "N") x <- ..diagU2N(x) - r <- .Call(Cholesky_solve, x, NULL, TRUE) + r <- .Call(Cholesky_solve, x, NULL) i <- if(x@uplo == "U") 2L else 1L r@Dimnames <- x@Dimnames[c(i, i)] r }) +rm(.cl) for(.cl in paste0("dt", c("C", "R", "T"), "Matrix")) setMethod("chol2inv", signature(x = .cl), function(x, ...) (if(x@uplo == "U") tcrossprod else crossprod)(solve(x))) +rm(.cl) ## 'uplo' can affect the 'Dimnames' of the result here : setMethod("chol2inv", signature(x = "ddiMatrix"), @@ -248,7 +246,9 @@ r@x <- diag(x, names = FALSE) r }, - stop("'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1.\", or \"%4$s\"", + "which", "P", "L", "D"), + domain = NA)) } body(.def.unpacked) <- do.call(substitute, @@ -333,7 +333,9 @@ isLDL <- function(x) { if(is(x, "CHMfactor")) .CHM.is.LDL(x) - else stop("'x' does not inherit from virtual class CHMfactor") + else stop(gettextf("'%s' does not inherit from virtual class %s", + "x", "CHMfactor"), + domain = NA) } setAs("CHMsimpl", "dtCMatrix", @@ -417,7 +419,9 @@ r@x <- diag(x, names = FALSE) r }, - stop("'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1.\", or \"%4$s\"", + "which", "P", "L", "D"), + domain = NA)) }) setMethod("expand1", signature(x = "CHMsuper"), @@ -449,7 +453,9 @@ r@x <- diag(x, names = FALSE) r }, - stop("'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1.\", or \"%4$s\"", + "which", "P", "L", "D"), + domain = NA)) }) ## returning list(P1', L1, D, L1', P1) or list(P1', L, L', P1), @@ -547,38 +553,29 @@ setMethod("update", signature(object = "CHMfactor"), function(object, parent, mult = 0, ...) { - s <- .M.repr(parent) - if(!nzchar(s)) - stop("'parent' is not formally sparse") - if(s != "C") - parent <- as(parent, "CsparseMatrix") - s <- .M.shape(parent) - if(s != "s") { - Matrix.msg("'parent' is not formally symmetric; factorizing tcrossprod(parent)") - if(s == "t" && parent@diag != "N") + parent <- .M2kind(.M2C(parent), ",") + if((shape <- .M.shape(parent)) != "s") { + Matrix.message(gettextf("'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)", + "parent"), + domain = NA) + if(shape == "t" && parent@diag != "N") parent <- ..diagU2N(parent) } - s <- .M.kind(parent) - if(s != "d") - parent <- .M2kind(parent, "d") .updateCHMfactor(object, parent, mult) }) .updownCHMfactor <- function(update, C, L) .Call(CHMfactor_updown, L, C, update) -for(.cl in c("Matrix", "matrix")) { setMethod("updown", - signature(update = "character", C = .cl, L = "CHMfactor"), + signature(update = "character", C = "ANY", L = "ANY"), function(update, C, L) - updown(!identical(update, "-"), C, L)) + updown(identical(update, "+"), C, L)) setMethod("updown", - signature(update = "logical", C = .cl, L = "CHMfactor"), + signature(update = "logical", C = "Matrix", L = "CHMfactor"), function(update, C, L) - updown(update, as(as(C, "CsparseMatrix"), "dMatrix"), L)) -} -rm(.cl) + updown(update, .M2kind(.M2C(C), ","), L)) for(.cl in c("dgCMatrix", "dsCMatrix")) setMethod("updown", @@ -599,3 +596,8 @@ C <- C[perm + 1L, , drop = FALSE] .updownCHMfactor(update, C, L) }) + +setMethod("updown", + signature(update = "logical", C = "matrix", L = "CHMfactor"), + function(update, C, L) + updown(update, .m2sparse(C, ",gC"), L)) diff -Nru rmatrix-1.6-1.1/R/coerce.R rmatrix-1.6-5/R/coerce.R --- rmatrix-1.6-1.1/R/coerce.R 2023-08-11 06:55:57.000000000 +0000 +++ rmatrix-1.6-5/R/coerce.R 2023-12-06 18:46:20.000000000 +0000 @@ -63,8 +63,8 @@ .sparse2dense <- function(from, packed = FALSE) .Call(R_sparse_as_dense, from, packed) -.diag2dense <- function(from, shape = "t", packed = FALSE, uplo = "U") - .Call(R_diagonal_as_dense, from, shape, packed, uplo) +.diag2dense <- function(from, kind = ".", shape = "t", packed = FALSE, uplo = "U") + .Call(R_diagonal_as_dense, from, kind, shape, packed, uplo) .ind2dense <- function(from, kind = "n") .Call(R_index_as_dense, from, kind) @@ -72,26 +72,27 @@ .dense2sparse <- function(from, repr = "C") .Call(R_dense_as_sparse, from, repr) -.diag2sparse <- function(from, shape = "t", repr = "C", uplo = "U") - .Call(R_diagonal_as_sparse, from, shape, repr, uplo) +.diag2sparse <- function(from, kind = ".", shape = "t", repr = "C", uplo = "U") + .Call(R_diagonal_as_sparse, from, kind, shape, repr, uplo) .ind2sparse <- function(from, kind = "n", repr = ".") .Call(R_index_as_sparse, from, kind, repr) -.m2dense <- function(from, class, uplo = "U", diag = "N") - .Call(R_matrix_as_dense, from, class, uplo, diag) +.m2dense <- function(from, class = ".ge", uplo = "U", diag = "N", + trans = FALSE) + .Call(R_matrix_as_dense, from, class, uplo, diag, trans) .m2dense.checking <- function(from, kind = ".", ...) { switch(typeof(from), logical =, integer =, double = NULL, - stop(gettextf("matrix of invalid type \"%s\" to .m2dense.checking()", - typeof(from)), + stop(gettextf("invalid type \"%s\" in '%s'", + typeof(from), ".m2dense.checking"), domain = NA)) if(kind != ".") { ## These must happen before isSymmetric() call storage.mode(from) <- switch(kind, n =, l = "logical", d = "double", - stop(gettextf("invalid kind \"%s\" to .m2dense.checking()", - kind), + stop(gettextf("invalid %s=\"%s\" to '%s'", + "kind", kind, ".m2dense.checking"), domain = NA)) if(kind == "n" && anyNA(from)) from[is.na(from)] <- TRUE @@ -104,20 +105,21 @@ .m2dense(from, paste0(kind, "ge"), NULL, NULL) } -.m2sparse <- function(from, class, uplo = "U", diag = "N") - .Call(R_matrix_as_sparse, from, class, uplo, diag) +.m2sparse <- function(from, class = ".gC", uplo = "U", diag = "N", + trans = FALSE) + .Call(R_matrix_as_sparse, from, class, uplo, diag, trans) .m2sparse.checking <- function(from, kind = ".", repr = "C", ...) { switch(typeof(from), logical =, integer =, double = NULL, - stop(gettextf("matrix of invalid type \"%s\" to .m2sparse.checking()", - typeof(from)), + stop(gettextf("invalid type \"%s\" in '%s'", + typeof(from), ".m2sparse.checking"), domain = NA)) if(kind != ".") { ## These must happen before isSymmetric() call storage.mode(from) <- switch(kind, n =, l = "logical", d = "double", - stop(gettextf("invalid kind \"%s\" to .m2sparse.checking()", - kind), + stop(gettextf("invalid %s=\"%s\" to '%s'", + "kind", kind, ".m2sparse.checking"), domain = NA)) if(kind == "n" && anyNA(from)) from[is.na(from)] <- TRUE @@ -130,53 +132,235 @@ .m2sparse(from, paste0(kind, "g", repr), NULL, NULL) } +.V2kind <- function(from, kind = ".") { + if(kind == ".") + return(from) + kind. <- .M.kind(from) + if(kind == ",") + kind <- if(kind. == "z") "z" else "d" + if(kind == kind.) + return(from) + to <- new(paste0(kind, "sparseVector")) + to@length <- from@length + to@i <- from@i + if(kind != "n") + to@x <- + if(kind. == "n") + rep.int(switch(kind, "l" = TRUE, "i" = 1L, "d" = 1, "z" = 1+0i), length(from@i)) + else as.vector(from@x, typeof(to@x)) + to +} + +.V2v <- function(from) { + if(.M.kind(from) != "n") { + to <- vector(typeof(from@x), from@length) + to[from@i] <- from@x + } else { + to <- logical(from@length) + to[from@i] <- TRUE + } + to +} + +.V2m <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + to <- .V2v(from) + dim(to) <- c(m, 1L) + to +} + +.V2a <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + to <- .V2v(from) + dim(to) <- m + to +} + +.V2unpacked <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + kind <- .M.kind(from) + to <- new(paste0(if(kind == "i") "d" else kind, "geMatrix")) + to@Dim <- c(m, 1L) + to@x <- replace(vector(typeof(to@x), m), from@i, + if(kind == "n") TRUE else from@x) + to +} + +.V2C <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + kind <- .M.kind(from) + to <- new(paste0(if(kind == "i") "d" else kind, "gCMatrix")) + to@Dim <- c(m, 1L) + to@p <- c(0L, length(from@i)) + to@i <- as.integer(from@i) - 1L + if(kind != "n") + to@x <- if(kind == "i") as.double(from@x) else from@x + to +} + +.V2R <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + kind <- .M.kind(from) + to <- new(paste0(if(kind == "i") "d" else kind, "gRMatrix")) + to@Dim <- c(m, 1L) + to@p <- c(0L, cumsum(replace(logical(m), from@i, TRUE))) + to@j <- integer(length(from@i)) + if(kind != "n") + to@x <- if(kind == "i") as.double(from@x) else from@x + to +} + +.V2T <- function(from) { + if(is.double(m <- length(from))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + kind <- .M.kind(from) + to <- new(paste0(if(kind == "i") "d" else kind, "gTMatrix")) + to@Dim <- c(m, 1L) + to@i <- as.integer(from@i) - 1L + to@j <- integer(length(from@i)) + if(kind != "n") + to@x <- if(kind == "i") as.double(from@x) else from@x + to +} + +## FIXME: define R_Matrix_as_sparseVector in ../src/coerce.c and use here +.M2V <- function(from) { + repr <- .M.repr(from) + if(repr == "u" || repr == "p") + return(.Call( v2spV, .M2v(from))) + if(repr == "C" || repr == "R") + return(.Call(CR2spV, from )) + if(repr == "T") + return(.Call(CR2spV, .M2C(from))) + if(repr != "d" && repr != "i") { + if(is.object(from)) + stop(gettextf("invalid class \"%s\" in '%s'", + class(from)[1L], ".M2V"), + domain = NA) + else + stop(gettextf("invalid type \"%s\" in '%s'", + typeof(from), ".M2V"), + domain = NA) + } + d <- from@Dim + m <- d[1L] + n <- d[2L] + mn <- prod(d) + if(mn <= .Machine$integer.max) + mn <- as.integer(mn) + else if(mn > 0x1p+53) + stop(gettextf("%s length cannot exceed %s", "sparseVector", "2^53"), + domain = NA) + kind <- .M.kind(from) + to <- new(paste0(kind, "sparseVector")) + to@length <- mn + to@i <- + if(repr == "d") { + if(kind == "n" && from@diag == "N") + indDiag(n)[from@x | is.na(from@x)] + else + indDiag(n) + } else if(is.integer(mn)) { + if(from@margin == 1L) + seq.int(to = 0L, by = 1L, length.out = m) + + from@perm * m + else + seq.int(from = 0L, by = m, length.out = n) + + from@perm + } else { + if(from@margin == 1L) + seq.int( to = 0, by = 1, length.out = m) + + from@perm * as.double(m) + else + seq.int(from = 0, by = as.double(m), length.out = n) + + as.double(from@perm) + } + if(kind != "n") + to@x <- + if(from@diag == "N") + from@x + else rep.int(switch(kind, "l" = TRUE, "i" = 1L, "d" = 1, "z" = 1+0i), n) + to +} + +.m2V <- function(from, kind = ".") { + to <- .Call(v2spV, from) + if(kind == ".") + to + else { + to. <- new(paste0(kind, "sparseVector")) + to.@length <- to@length + to.@i <- to@i + if(kind != "n") + to.@x <- as.vector(to@x, typeof(to.@x)) + to. + } +} -## ==== From Matrix to vector ========================================== + +## ==== To vector ====================================================== ## Need 'base' functions calling as.*() to dispatch to our S4 methods: if (FALSE) { ## 2023-08-10: breaks iGraphMatch, mcmcsae, mcompanion ## which define proper subclasses of Matrix not extending ## any of _our_ proper subclasses of Matrix -as.vector.Matrix <- function(x, mode = "any") as.vector(.M2v(x), mode) -as.matrix.Matrix <- function(x, ...) .M2m(x) - as.array.Matrix <- function(x, ...) .M2m(x) +as.matrix.Matrix <- function(x, ...) .M2m(x) + as.array.Matrix <- function(x, ...) .M2m(x) } else { -## Hence, for now ... -as.vector.Matrix <- function(x, mode = "any") as.vector(as(x, "matrix"), mode) -as.matrix.Matrix <- function(x, ...) as(x, "matrix") - as.array.Matrix <- function(x, ...) as(x, "matrix") +as.matrix.Matrix <- function(x, ...) as(x, "matrix") + as.array.Matrix <- function(x, ...) as(x, "matrix") +setAs("Matrix", "matrix", .M2m) } +as.matrix.sparseVector <- function(x, ...) .V2m(x) + as.array.sparseVector <- function(x, ...) .V2a(x) setMethod("as.vector" , signature(x = "Matrix"), - as.vector.Matrix) + function(x, mode = "any") as.vector(.M2v(x), mode)) setMethod("as.matrix" , signature(x = "Matrix"), as.matrix.Matrix) setMethod("as.array" , signature(x = "Matrix"), - as.array.Matrix) + as.array.Matrix) setMethod("as.logical", signature(x = "Matrix"), function(x, ...) as.logical(.M2v(x))) setMethod("as.integer", signature(x = "Matrix"), function(x, ...) as.integer(.M2v(x))) -setMethod("as.double" , signature(x = "Matrix"), - function(x, ...) as.double (.M2v(x))) setMethod("as.numeric", signature(x = "Matrix"), function(x, ...) as.numeric(.M2v(x))) setMethod("as.complex", signature(x = "Matrix"), function(x, ...) as.complex(.M2v(x))) -setAs("Matrix", "vector", .M2v) -setAs("Matrix", "matrix", .M2m) -setAs("Matrix", "array", .M2m) -setAs("Matrix", "logical", function(from) as.logical(.M2v(from))) -setAs("Matrix", "integer", function(from) as.integer(.M2v(from))) -setAs("Matrix", "double", function(from) as.double (.M2v(from))) -setAs("Matrix", "numeric", function(from) as.numeric(.M2v(from))) -setAs("Matrix", "complex", function(from) as.complex(.M2v(from))) +setMethod("as.vector" , signature(x = "sparseVector"), + function(x, mode = "any") as.vector(.V2v(x), mode)) +setMethod("as.matrix" , signature(x = "sparseVector"), + as.matrix.sparseVector) +setMethod("as.array" , signature(x = "sparseVector"), + as.array.sparseVector) +setMethod("as.logical", signature(x = "sparseVector"), + function(x, ...) as.logical(.V2v(x))) +setMethod("as.integer", signature(x = "sparseVector"), + function(x, ...) as.integer(.V2v(x))) +setMethod("as.numeric", signature(x = "sparseVector"), + function(x, ...) as.numeric(.V2v(x))) +setMethod("as.complex", signature(x = "sparseVector"), + function(x, ...) as.complex(.V2v(x))) -## ==== From vector to Matrix ========================================== +## ==== To Matrix ====================================================== +setAs("sparseVector", "Matrix", + .V2C) setAs("matrix", "Matrix", function(from) { if(isDiagonal(from)) @@ -187,15 +371,38 @@ }) setAs("vector", "Matrix", function(from) { - if(is.object(from)) # e.g., data.frame + if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame as(as.matrix(from), "Matrix") else if(.sparseDefault(from)) .m2sparse(from, ".gC") else .m2dense(from, ".ge") }) -setAs("ANY", "Matrix", +setAs( "ANY", "Matrix", function(from) as(as(from, "matrix"), "Matrix")) +if(FALSE) { +## MJ: not yet ... existing as(, "Matrix") must become defunct first +setAs("MatrixFactorization", "Matrix", + function(from) { + n <- length(x <- expand2(from)) + to <- x[[1L]] + if(n >= 2L) for(i in 2L:n) to <- to %*% x[[i]] + to + }) +} + + +## ==== To sparseVector ================================================ + +setAs("Matrix", "sparseVector", + function(from) .M2V(from)) +setAs("matrix", "sparseVector", + function(from) .m2V(from)) +setAs("vector", "sparseVector", + function(from) .m2V(from)) +setAs( "ANY", "sparseVector", + function(from) as(as.vector(from), "sparseVector")) + ## ==== To "kind" ====================================================== @@ -290,14 +497,37 @@ setAs("vector", "dsparseMatrix", function(from) .m2sparse(from, "dgC")) +setAs("sparseVector", "nsparseVector", + function(from) .V2kind(from, "n")) +setAs("sparseVector", "lsparseVector", + function(from) .V2kind(from, "l")) +setAs("sparseVector", "isparseVector", + function(from) .V2kind(from, "i")) +setAs("sparseVector", "dsparseVector", + function(from) .V2kind(from, "d")) +setAs("sparseVector", "zsparseVector", + function(from) .V2kind(from, "z")) + +setAs("vector", "nsparseVector", + function(from) .m2V(from, "n")) +setAs("vector", "lsparseVector", + function(from) .m2V(from, "l")) +setAs("vector", "isparseVector", + function(from) .m2V(from, "i")) +setAs("vector", "dsparseVector", + function(from) .m2V(from, "d")) +setAs("vector", "zsparseVector", + function(from) .m2V(from, "z")) + ## ==== To "shape" ===================================================== -..m2gen <- function(from) .Call(R_matrix_as_dense, from, ".ge", NULL, NULL) +..m2gen <- function(from) .m2dense(from, ".ge") -setAs("Matrix", "generalMatrix", ..M2gen) -setAs("matrix", "generalMatrix", ..m2gen) -setAs("vector", "generalMatrix", ..m2gen) +setAs( "Matrix", "generalMatrix", ..M2gen) +setAs( "matrix", "generalMatrix", ..m2gen) +setAs( "vector", "generalMatrix", ..m2gen) +setAs("sparseVector", "generalMatrix", .V2C) setAs("Matrix", "symmetricMatrix", ..M2sym) setAs("matrix", "symmetricMatrix", ..M2sym) @@ -305,21 +535,18 @@ setAs("Matrix", "triangularMatrix", ..M2tri) setAs("matrix", "triangularMatrix", ..M2tri) -setAs("Matrix", "diagonalMatrix", .M2diag) -setAs("matrix", "diagonalMatrix", .M2diag) - rm(..m2gen) setAs("diagonalMatrix", "symmetricMatrix", function(from) { if(!isSymmetricDN(from@Dimnames)) stop("matrix is not symmetric; consider forceSymmetric(.) or symmpart(.)") - .diag2sparse(from, "s", "C", "U") + .diag2sparse(from, ".", "s", "C", "U") }) setAs("diagonalMatrix", "triangularMatrix", function(from) - .diag2sparse(from, "t", "C", "U")) + .diag2sparse(from, ".", "t", "C", "U")) ## ==== To "representation" ============================================ @@ -333,6 +560,7 @@ setAs("Matrix", "TsparseMatrix", .M2T) ## Do test for structure: +## FIXME: wrongly assumes that methods are defined for pack() ... setAs("generalMatrix", "packedMatrix", function(from) pack(from)) setAs("matrix", "denseMatrix", @@ -356,14 +584,14 @@ setAs("vector", "denseMatrix", function(from) - if(is.object(from)) # e.g., data.frame + if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame as(as.matrix(from), "denseMatrix") else .m2dense(from, ".ge")) setAs("vector", "unpackedMatrix", function(from) .m2dense(from, ".ge")) setAs("vector", "sparseMatrix", function(from) - if(is.object(from)) # e.g., data.frame + if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame as(as.matrix(from), "sparseMatrix") else .m2sparse(from, ".gC")) setAs("vector", "CsparseMatrix", @@ -378,6 +606,16 @@ setAs("ANY", "sparseMatrix", function(from) as(as(from, "matrix"), "sparseMatrix")) +setAs("sparseVector", "denseMatrix", .V2unpacked) +setAs("sparseVector", "unpackedMatrix", .V2unpacked) +setAs("sparseVector", "sparseMatrix", .V2C) +setAs("sparseVector", "CsparseMatrix", .V2C) +setAs("sparseVector", "RsparseMatrix", .V2R) +setAs("sparseVector", "TsparseMatrix", .V2T) + +setAs("Matrix", "diagonalMatrix", .M2diag) +setAs("matrix", "diagonalMatrix", .M2diag) + setAs("Matrix", "indMatrix", function(from) as(as(from, "nsparseMatrix"), "indMatrix")) setAs("matrix", "indMatrix", diff -Nru rmatrix-1.6-1.1/R/colSums.R rmatrix-1.6-5/R/colSums.R --- rmatrix-1.6-1.1/R/colSums.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/colSums.R 2023-09-08 19:34:38.000000000 +0000 @@ -1,46 +1,55 @@ ## METHODS FOR GENERIC: colSums, rowSums, colMeans, rowMeans ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## FIXME? *Sums() is currently always of type "double"; -## should *Sums(<([nl]|ind)Matrix>) behave the same? We are not -## consistent. Currently: -## -## double result: integer result: -## * [nl]denseMatrix * [nl]sparseMatrix -## * ldiMatrix * indMatrix -## -## hence we might consider changing to always give double ... - - ## ==== denseMatrix ==================================================== setMethod("colSums", signature(x = "denseMatrix"), function(x, na.rm = FALSE, dims = 1L, ...) - .Call(R_dense_colSums, x, na.rm, FALSE)) + .Call(R_dense_marginsum, x, 1L, na.rm, FALSE)) setMethod("colMeans", signature(x = "denseMatrix"), function(x, na.rm = FALSE, dims = 1L, ...) - .Call(R_dense_colSums, x, na.rm, TRUE)) + .Call(R_dense_marginsum, x, 1L, na.rm, TRUE)) setMethod("rowSums", signature(x = "denseMatrix"), function(x, na.rm = FALSE, dims = 1L, ...) - .Call(R_dense_rowSums, x, na.rm, FALSE)) + .Call(R_dense_marginsum, x, 0L, na.rm, FALSE)) setMethod("rowMeans", signature(x = "denseMatrix"), function(x, na.rm = FALSE, dims = 1L, ...) - .Call(R_dense_rowSums, x, na.rm, TRUE)) + .Call(R_dense_marginsum, x, 0L, na.rm, TRUE)) ## ==== sparseMatrix =================================================== +## ---- [CRT]sparseMatrix ---------------------------------------------- + +for (.cl in paste0(c("C", "R", "T"), "sparseMatrix")) { +setMethod("colSums", signature(x = .cl), + function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) + .Call(R_sparse_marginsum, x, 1L, na.rm, FALSE, sparseResult)) +setMethod("colMeans", signature(x = .cl), + function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) + .Call(R_sparse_marginsum, x, 1L, na.rm, TRUE, sparseResult)) +setMethod("rowSums", signature(x = .cl), + function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) + .Call(R_sparse_marginsum, x, 0L, na.rm, FALSE, sparseResult)) +setMethod("rowMeans", signature(x = .cl), + function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) + .Call(R_sparse_marginsum, x, 0L, na.rm, TRUE, sparseResult)) +} +rm(.cl) + + ## ---- diagonalMatrix ------------------------------------------------- .diag.cS <- .diag.rS <- function(x, na.rm = FALSE, dims = 1L, ...) { + kind <- .M.kind(x) if((n <- x@Dim[1L]) == 0L) - return(double(0L)) + return(vector(switch(kind, "z" = "complex", "d" = , "i" = "double", "integer"), 0L)) else if(x@diag != "N") - r <- rep.int(1, n) + r <- rep.int(switch(kind, "z" = 1+0i, "d" = , "i" = 1, 1L), n) else { - r <- as.double(x@x) - if(na.rm) - r[is.na(r)] <- 0 + r <- switch(kind, "z" = , "d" = x@x, "i" = as.double(x@x), as.integer(x@x)) + if((na.rm || kind == "n") && anyNA(r)) + r[is.na(r)] <- switch(kind, "z" = 0+0i, "d" = , "i" = 0, "n" = 1L, 0L) } if(!is.null(nms <- x@Dimnames[[.MARGIN]])) names(r) <- nms @@ -50,14 +59,18 @@ body(.diag.rS) <- do.call(substitute, list(body(.diag.rS), list(.MARGIN = 1L))) .diag.cM <- .diag.rM <- function(x, na.rm = FALSE, dims = 1L, ...) { + kind <- .M.kind(x) if((n <- x@Dim[1L]) == 0L) - return(double(0L)) + return(vector(switch(kind, "z" = "complex", "double"), 0L)) else if(x@diag != "N") - r <- rep.int(1 / n, n) + r <- rep.int(switch(kind, "z" = 1+0i, 1) / n, n) else { - r <- as.double(x@x) / n - if(na.rm) - r[is.na(r)] <- if(n == 1L) NaN else 0 + r <- x@x / n + if((na.rm || kind == "n") && anyNA(r)) + r[is.na(r)] <- switch(kind, + "z" = if(n == 1L) NaN * (0+0i) else 0+0i, + "n" = 1 / n, + if(n == 1L) NaN else 0) } if(!is.null(nms <- x@Dimnames[[.MARGIN]])) names(r) <- nms @@ -116,51 +129,3 @@ names(r) <- nms r }) - - -## ---- CsparseMatrix -------------------------------------------------- - -setMethod("colSums", signature(x = "CsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, x, na.rm, FALSE, sparseResult)) -setMethod("colMeans", signature(x = "CsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, x, na.rm, TRUE, sparseResult)) -setMethod("rowSums", signature(x = "CsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_rowSums, x, na.rm, FALSE, sparseResult)) -setMethod("rowMeans", signature(x = "CsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_rowSums, x, na.rm, TRUE, sparseResult)) - - -## ---- RsparseMatrix -------------------------------------------------- - -setMethod("colSums", signature(x = "RsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_rowSums, x, na.rm, FALSE, sparseResult)) -setMethod("colMeans", signature(x = "RsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_rowSums, x, na.rm, TRUE, sparseResult)) -setMethod("rowSums", signature(x = "RsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, x, na.rm, FALSE, sparseResult)) -setMethod("rowMeans", signature(x = "RsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, x, na.rm, TRUE, sparseResult)) - - -## ---- TsparseMatrix -------------------------------------------------- - -setMethod("colSums", signature(x = "TsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, .M2C(x), na.rm, FALSE, sparseResult)) -setMethod("colMeans", signature(x = "TsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, .M2C(x), na.rm, TRUE, sparseResult)) -setMethod("rowSums", signature(x = "TsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, .M2R(x), na.rm, FALSE, sparseResult)) -setMethod("rowMeans", signature(x = "TsparseMatrix"), - function(x, na.rm = FALSE, dims = 1L, sparseResult = FALSE, ...) - .Call(CRsparse_colSums, .M2R(x), na.rm, TRUE, sparseResult)) diff -Nru rmatrix-1.6-1.1/R/construct.R rmatrix-1.6-5/R/construct.R --- rmatrix-1.6-1.1/R/construct.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/construct.R 2023-10-11 13:25:02.000000000 +0000 @@ -0,0 +1,764 @@ +Matrix <- function(data = NA, nrow = 1, ncol = 1, byrow = FALSE, + dimnames = NULL, sparse = NULL, + doDiag = TRUE, forceCheck = FALSE) +{ + i.M <- i.sM <- i.dM <- i.sV <- i.m <- FALSE + mnrow <- missing(nrow) + mncol <- missing(ncol) + if(isS4(data)) { + cld <- getClassDef(class(data)) + i.M <- extends(cld, "Matrix") + if(i.M) { + i.sM <- extends(cld, "sparseMatrix") + i.dM <- i.sM && extends(cld, "diagonalMatrix") + } else if(extends(cld, "sparseVector")) { + ## need to transmit missingness to 'spV2M' + call. <- quote(spV2M(x = data, nrow =, ncol =, byrow = byrow)) + if(!mnrow) + call.[[3L]] <- quote(nrow) + if(!mncol) + call.[[4L]] <- quote(ncol) + data <- eval(call.) + i.M <- i.sM <- i.sV <- forceCheck <- TRUE + } + } else { + i.m <- is.matrix(data) + } + if(!i.M) { + ## validate non-Matrix 'data', throwing type errors _early_ + if(is.object(data)) { + if(i.m) + class(data) <- NULL # retaining 'dim' + else + data <- as.vector(data) + } + mode. <- mode(data) + kind <- switch(mode., numeric = "d", logical = "l", + stop("invalid 'data'")) + } + if(i.M || i.m) { + ## 'data' is a Matrix or a numeric or logical matrix + ## without a 'class' attribute + if(!i.sV && !(mnrow && mncol && missing(byrow))) + warning("'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'") + if(!is.null(dimnames)) + dimnames(data) <- dimnames + if(is.null(sparse)) + sparse <- sparseDefault(data) + if(i.M) { + ## return early in these cases: + if(i.dM) + ## !doDiag has been documented to result in a coercion to + ## symmetricMatrix; we must use diag2*() below because the + ## "usual" as(, "(Csparse|unpacked)Matrix") + ## inherits from triangularMatrix, _not_ symmetricMatrix + return(if(doDiag) + data + else if(sparse) + .diag2sparse(data, ".", "s", "C", "U") + else .diag2dense(data, ".", "s", FALSE, "U")) + if(!forceCheck) + return(if(i.sM == sparse) + data + else if(sparse) + as(data, "CsparseMatrix") + else as(data, "unpackedMatrix")) + } + } else { + ## 'data' is a numeric or logical vector or non-matrix array + ## without a 'class' attribute + if(length(data) == 1L && !is.na(data) && data == 0 && + (is.null(sparse) || sparse)) { + ## Matrix(0, ...): sparseMatrix unless sparse=FALSE + ## MJ: we should _try_ to behave as R's do_matrix() + ## in the edge cases ... integer overflow is "OK" + ## since anyNA(Dim) is caught by validity methods + if(mnrow == mncol) { + nrow <- as.integer(nrow) + ncol <- as.integer(ncol) + } else if(mnrow) { + ncol <- as.integer(ncol) + if(ncol == 0L) + stop("data is too long") + nrow <- as.integer(ceiling(1 / ncol)) + } else { + nrow <- as.integer(nrow) + if(nrow == 0L) + stop("data is too long") + ncol <- as.integer(ceiling(1 / nrow)) + } + square <- nrow == ncol + if(is.null(dimnames)) + dimnames <- list(NULL, NULL) + if(square && doDiag) + return(new(paste0(kind, "diMatrix"), + Dim = c(nrow, ncol), + Dimnames = dimnames, + x = vector(mode., nrow))) + data <- new(paste0(kind, if(square) "s" else "g", "CMatrix"), + Dim = c(nrow, ncol), + Dimnames = dimnames, + p = integer(ncol + 1)) + i.M <- i.sM <- sparse <- TRUE + } else { + ## usual case: vector|array->matrix + data <- .External(Mmatrix, + data, nrow, ncol, byrow, dimnames, mnrow, mncol) + if(is.null(sparse)) + sparse <- sparseDefault(data) + i.m <- TRUE + } + } + + ## 'data' is a Matrix (but _not_ a diagonalMatrix) or a + ## numeric or logical matrix without a 'class' attribute + if(doDiag && isDiagonal(data)) + ## as(<[mM]atrix>, "diagonalMatrix") uses check = TRUE (a waste) + return(forceDiagonal(data)) + if(i.m || i.sM != sparse) { + data <- as(data, if(sparse) "CsparseMatrix" else "unpackedMatrix") + if(i.m) + ## as(, "CsparseMatrix"), as(, "unpackedMatrix") + ## already check for symmetric, triangular structure + return(data) + } + if(!is(data, "generalMatrix")) + data + else if(isSymmetric(data)) + forceSymmetric(data) + else if(!(it <- isTriangular(data))) + data + else if(attr(it, "kind") == "U") + triu(data) + else tril(data) +} + +sparseMatrix <- function(i, j, p, x, dims, dimnames, + symmetric = FALSE, + triangular = FALSE, + index1 = TRUE, + repr = c("C", "R", "T"), + giveCsparse, + check = TRUE, + use.last.ij = FALSE) +{ + if((m.i <- missing(i)) + (m.j <- missing(j)) + (m.p <- missing(p)) != 1L) + stop("exactly one of 'i', 'j', and 'p' must be missing from call") + if(symmetric && triangular) + stop("use Diagonal() to construct diagonal (symmetric && triangular) sparse matrices") + index1 <- as.logical(index1) # allowing {0,1} + + repr <- # keep in sync with toeplitz() + ## NB: prior to 2020-05, we had 'giveCsparse' {T->"C" [default], F->"T"} + ## but no 'repr' ... the following is to remain backwards compatible + if(missing(giveCsparse)) + match.arg(repr) + else if(!missing(repr)) { + warning("'giveCsparse' is deprecated; using 'repr' instead") + match.arg(repr) + ## } else { + ## repr <- if(giveCsparse) "C" else "T" + ## warning(gettextf("'giveCsparse' is deprecated; setting repr=\"%s\" for you", repr), + ## domain = NA) + ## } + } else if(giveCsparse) { + ## NOT YET: + ## warning("'giveCsparse' is deprecated; setting repr=\"C\" for you") + "C" + } else { + warning("'giveCsparse' is deprecated; setting repr=\"T\" for you") + "T" + } + + if(!m.p) { + p <- as.integer(p) + if((n.p <- length(p)) == 0L || anyNA(p) || p[1L] != 0L || + any((dp <- p[-1L] - p[-n.p]) < 0L)) + stop("'p' must be a nondecreasing vector c(0, ...)") + if((n.dp <- length(dp)) > .Machine$integer.max) + stop("dimensions cannot exceed 2^31-1") + i. <- rep.int(seq.int(from = 0L, length.out = n.dp), dp) + if(m.i) i <- i. else j <- i. + } + + if(!m.i) + i <- if(index1) as.integer(i) - 1L else as.integer(i) # need 0-index + if(!m.j) + j <- if(index1) as.integer(j) - 1L else as.integer(j) # need 0-index + + rij <- cbind(if(n.i <- length(i)) range(i) else 0:-1, + if(n.j <- length(j)) range(j) else 0:-1, + deparse.level = 0L) + if(anyNA(rij)) + stop("'i' and 'j' must not contain NA") # and not overflow + if(any(rij[1L, ] < 0L)) + stop("'i' and 'j' must be ", if(index1) "positive" else "non-negative") + dims <- + if(!missing(dims)) { + if(length(dims) != 2L || + any(is.na(dims) | dims < 0L | dims >= .Machine$integer.max + 1)) + stop("invalid 'dims'") + if(any(dims - 1L < rij[2L, ])) + stop("'dims' must contain all (i,j) pairs") + as.integer(dims) + } else if(symmetric || triangular) + rep.int(max(rij), 2L) + 1L + else rij[2L, ] + 1L + + kind <- if(m.x <- missing(x)) "n" else if(is.integer(x)) "d" else .M.kind(x) + shape <- + if(symmetric) { + if(dims[1L] != dims[2L]) + stop("symmetric matrix must be square") + "s" + } else if(triangular) { + if(dims[1L] != dims[2L]) + stop("triangular matrix must be square") + "t" + } else "g" + + r <- new(paste0(kind, shape, "TMatrix")) + r@Dim <- dims + if(!missing(dimnames) && !is.null(dimnames)) + r@Dimnames <- + if(is.character(validDN(dimnames, dims))) + dimnames + else fixupDN(dimnames) # needs a valid argument + if((symmetric || triangular) && all(i >= j)) + r@uplo <- "L" # else "U", the prototype + if(!m.x) { + if(is.integer(x)) + x <- as.double(x) + if((n.x <- length(x)) > 0L && n.x != n.i) { + if(n.x < n.i) { + if(n.i %% n.x != 0L) + warning(if(m.i) "p[length(p)] " else "length(i) ", + "is not an integer multiple of length(x)") + x <- rep_len(x, n.i) # recycle + } else if(n.x == 1L) + x <- x[0L] # tolerate length(i) = 0, length(x) = 1 + else stop("length(x) must not exceed ", + if(m.i) "p[length(p)]" else "length(i)") + } + if(use.last.ij && n.i == n.j && + anyDuplicated.matrix(ij <- cbind(i, j, deparse.level = 0L), + fromLast = TRUE)) { + which.not.dup <- which(!duplicated(ij, fromLast = TRUE)) + i <- i[which.not.dup] + j <- j[which.not.dup] + x <- x[which.not.dup] + } + r@x <- x + } + r@i <- i + r@j <- j + + if(check) + validObject(r) + switch(repr, "C" = .M2C(r), "T" = r, "R" = .M2R(r), + ## should never happen: + stop("invalid 'repr'; must be \"C\", \"R\", or \"T\"")) +} + +spMatrix <- function(nrow, ncol, + i = integer(0L), j = integer(0L), x = double(0L)) + new(paste0(if(is.integer(x)) "d" else .M.kind(x), "gTMatrix"), + Dim = c(as.integer(nrow), as.integer(ncol)), + i = as.integer(i) - 1L, + j = as.integer(j) - 1L, + x = if(is.integer(x)) as.double(x) else x) + +Diagonal <- function(n, x = NULL, names = FALSE) +{ + nx <- length(x) + if(missing(n)) + n <- nx + else if(!is.numeric(n) || length(n) != 1L || is.na(n) || n < 0L) + stop("'n' must be a non-negative integer") + if(is.double(n) && n >= .Machine$integer.max + 1) + stop("dimensions cannot exceed 2^31-1") + n <- as.integer(n) # discarding attributes + if(is.null(x)) { + r <- new("ddiMatrix") + r@diag <- "U" + if(n > 0L) { + r@Dim <- c(n, n) + if(is.character(names) && length(names) == n) + r@Dimnames <- list(names, names) + } + return(r) + } + if(is.object(x)) + stop(gettextf("'x' has unsupported class \"%s\"", class(x)[1L]), + domain = NA) + names.x <- names(x) # keeping for later + r <- new(switch(typeof(x), + ## discarding attributes, incl. 'dim' and 'names' + logical = { x <- as.logical(x); "ldiMatrix" }, + integer =, + double = { x <- as.double(x); "ddiMatrix" }, + stop(gettextf("'x' has unsupported type \"%s\"", typeof(x)), + domain = NA))) + if(n == 0L) + return(r) + if(nx != 1L) + r@x <- + if(nx == n) + x + else if(nx > 0L) + rep_len(x, n) + else stop("attempt to recycle 'x' of length 0 to length 'n' (n > 0)") + else if(is.na(x) || x != 1) + r@x <- rep.int(x, n) + else r@diag <- "U" + r@Dim <- c(n, n) + if(is.character(names)) { + if(length(names) == n) + r@Dimnames <- list(names, names) + } else if(isTRUE(names) && !is.null(names.x)) { + names.x <- rep_len(names.x, n) # we know length(names.x) > 0L + r@Dimnames <- list(names.x, names.x) + } + r +} + +.sparseDiagonal <- function(n, x = NULL, uplo = "U", shape = "t", + unitri = TRUE, kind, cols) +{ + if(missing(n)) + n <- length(x) + else if(!is.numeric(n) || length(n) != 1L || is.na(n) || n < 0L) + stop("'n' must be a non-negative integer") + if(is.double(n) && n >= .Machine$integer.max + 1) + stop("dimensions cannot exceed 2^31-1") + n <- nj <- as.integer(n) # stripping attributes + + if(!(missing(shape) || + (is.character(shape) && length(shape) == 1L && !is.na(shape) && + any(shape == c("g", "t", "s"))))) + stop("'shape' must be one of \"g\", \"t\", \"s\"") + + if(!((m.kind <- missing(kind)) || + (is.character(kind) && length(kind) == 1L && !is.na(kind) && + any(kind == c("d", "l", "n"))))) + stop("'kind' must be one of \"d\", \"l\", \"n\"") + + if(m.kind || kind != "n") { + if(is.null(x)) + x <- if(m.kind) { kind <- "d"; 1 } else switch(kind, d = 1, l = TRUE) + else if(is.object(x)) + stop(gettextf("'x' has unsupported class \"%s\"", + class(x)[1L]), + domain = NA) + else { + kind. <- switch(typeof(x), + ## discarding attributes, incl. 'dim' in array case + logical = { x <- as.logical(x); "l" }, + integer =, + double = { x <- as.double(x); "d" }, + stop(gettextf("'x' has unsupported type \"%s\"", + typeof(x)), + domain = NA)) + if(m.kind) + kind <- kind. + else if(kind != kind.) { + warning(gettextf("mismatch between typeof(x)=\"%s\" and kind=\"%s\"; using kind=\"%s\"", + typeof(x), kind, kind.), + domain = NA) + kind <- kind. + } + } + } + + if(!(m.cols <- missing(cols))) { + if(!is.numeric(cols)) + stop("'cols' must be numeric") + else if((nj <- length(cols)) > 0L && + (n == 0L || anyNA(rj <- range(cols)) || + rj[1L] < 0L || rj[2L] >= n)) + stop("'cols' has elements not in seq(0, length.out = n)") + else { + cols <- as.integer(cols) + shape <- "g" + } + } + + r <- new(paste0(kind, shape, "CMatrix")) + r@Dim <- c(n, nj) + if(shape != "g") { + if(!missing(uplo)) { + if(is.character(uplo) && length(uplo) == 1L && !is.na(uplo) && + any(uplo == c("U", "L"))) + r@uplo <- uplo + else stop("'uplo' must be \"U\" or \"L\"") + } + if(shape == "t" && unitri && + (kind == "n" || (!anyNA(x) && all(if(kind == "l") x else x == 1)))) { + r@diag <- "U" + r@p <- integer(nj + 1) + return(r) + } + } + if(nj > 0L) { + r@p <- 0:nj + r@i <- if(m.cols) 0:(nj - 1L) else cols + if(kind != "n") { + x <- + if((nx <- length(x)) == n) + x + else if(nx > 0L) + rep_len(x, n) + else stop("attempt to recycle 'x' of length 0 to length 'n' (n > 0)") + r@x <- if(m.cols) x else x[1L + cols] + } + } + r +} + +.trDiagonal <- function(n, x = NULL, uplo = "U", unitri = TRUE, kind) + .sparseDiagonal(n, x, uplo, shape = "t", unitri = unitri, kind = kind) + +.symDiagonal <- function(n, x = NULL, uplo = "U", kind) + .sparseDiagonal(n, x, uplo, shape = "s", kind = kind) + +.bdiag <- function(lst) +{ + if(!is.list(lst)) + stop("'lst' must be a list") + if((n <- length(lst)) == 0L) + return(new("dgTMatrix")) + if(n == 1L) + return(.M2T(asCspN(lst[[1L]]))) + +### FIXME? this is _slow_ when 'lst' is list of 75000 3-by-3 dense matrices + lst <- unname(lapply(lst, function(x) .M2T(asCspN(x)))) + + cl <- vapply(lst, class, "") + kind <- substr(cl, 1L, 1L) # "n", "l", or "d" + shape <- substr(cl, 2L, 2L) # "g", "s", or "t" + + if(!(any(kind == (kind. <- "d")) || any(kind == (kind. <- "l")))) + kind. <- "n" + else if(any(z <- kind == "n")) + lst[z] <- lapply(lst[z], .sparse2kind, kind.) + + shape. <- + if(all(symmetric <- shape == "s")) + "s" + else if(all(shape == "t")) + "t" + else "g" + + if(shape. != "g") { + uplo <- vapply(lst, slot, "", "uplo") # "U" or "L" + if(shape. == "s") + uplo. <- + if(all(z <- uplo == "U")) + "U" + else if(!any(z)) + "L" + else { + uplo.. <- if(2 * sum(z) >= n) { z <- !z; "U" } else "L" + lst[z] <- lapply(lst[z], .tCRT) + uplo.. + } + else if(any(uplo != (uplo. <- uplo[1L]))) + shape. <- "g" + } + + i_off <- c(0L, cumsum(vapply(lst, function(x) x@Dim[1L], 0L))) + j_off <- c(0L, cumsum(vapply(lst, function(x) x@Dim[2L], 0L))) + + r <- new(paste0(kind., shape., "TMatrix")) + r@Dim <- r@Dim <- c(i_off[n + 1L], j_off[n + 1L]) + if(shape. == "g") + lst[symmetric] <- lapply(lst[symmetric], .sparse2g) + else r@uplo <- uplo. + r@i <- unlist(lapply(seq_len(n), function(k) i_off[k] + lst[[k]]@i), + FALSE, FALSE) + r@j <- unlist(lapply(seq_len(n), function(k) j_off[k] + lst[[k]]@j), + FALSE, FALSE) + if(kind. != "n") + r@x <- unlist(lapply(lst, slot, "x"), FALSE, FALSE) + r +} + +bdiag <- function(...) +{ + if((n <- ...length()) == 0L) + new("dgCMatrix") + else if(n > 1L) + .M2C(.bdiag(list(...))) + else if(!is.list(x <- ..1)) + as(x, "CsparseMatrix") + else if(length(x) == 1L) + as(x[[1L]], "CsparseMatrix") + else .M2C(.bdiag(x)) +} + +bandSparse <- 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" = .M2C(T), "T" = T, "R" = .M2R(T), + 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) + } +} + +rsparsematrix <- function(nrow, ncol, density, + nnz = round(density * maxE), + symmetric = FALSE, + rand.x = function(n) signif(rnorm(n), 2L), ...) +{ + 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, + x = rand.x(nnz), + index1 = FALSE, + symmetric = symmetric, + dims = c(nrow, ncol), ...) +} + +Hilbert <- function(n) +{ + n <- as.integer(n) + i <- seq_len(n) + new("dpoMatrix", Dim = c(n, n), x = c(1/outer(i - 1L, i, `+`))) +} + +spV2M <- function(x, nrow, ncol, byrow = FALSE, + check = TRUE, symmetric = FALSE) +{ + if(check && !is(x, "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') + ## ~~~~~~~~~~~~~~~~ + kind <- .M.kind(x) # "d", "n", "l", "i", "z", ... + has.x <- kind != "n" + clStem <- if(symmetric) "sTMatrix" else "gTMatrix" + ## "careful_new()" : + cNam <- paste0(kind, clStem) + chngCl <- is.null(newCl <- getClassDef(cNam)) + if(chngCl) { ## e.g. "igTMatrix" is not yet implemented + if(kind == "z") + stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), + domain = NA) + ## coerce to "double": + newCl <- getClassDef(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 +} + +.sparseV2Mat <- function(from) + spV2M(from, nrow = from@length, ncol = 1L, check = FALSE) + +sp2vec <- function(x, mode = .type.kind[.M.kind(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 +} + +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) +} + +newSpVec <- function(class, x, prev) + newSpV(class = class, x = x, i = prev@i, length = prev@length) + +sparseVector <- function(x, i, length) + newSpV(class = paste0(if(missing(x)) "n" else .M.kind(x), "sparseVector"), + x = x, i = i, length = length) diff -Nru rmatrix-1.6-1.1/R/corMatrix.R rmatrix-1.6-5/R/corMatrix.R --- rmatrix-1.6-1.1/R/corMatrix.R 2023-05-07 07:15:00.000000000 +0000 +++ rmatrix-1.6-5/R/corMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -## METHODS FOR CLASS: p?corMatrix -## dense correlation matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.dpo2cor <- function(from) { - if(!is.null(to <- from@factors$correlation)) - return(to) - sd <- sqrt(diag(from, names = FALSE)) - - to <- new("corMatrix") - to@Dim <- d <- from@Dim - to@Dimnames <- from@Dimnames - to@uplo <- from@uplo - to@sd <- sd - - n <- d[1L] - x <- from@x / sd / rep(sd, each = n) - x[indDiag(n)] <- 1 - to@x <- x - - .set.factor(from, "correlation", to) -} - -.dpp2pcor <- function(from) { - if(!is.null(to <- from@factors$correlation)) - return(to) - sd <- sqrt(diag(from, names = FALSE)) - - to <- new("pcorMatrix") - to@Dim <- d <- from@Dim - to@Dimnames <- from@Dimnames - to@uplo <- uplo <- from@uplo - to@sd <- sd - - n <- d[1L] - u <- uplo == "U" - if(u) { - r <- seq_len(n) - s <- 1L - } else { - r <- seq.int(to = 1L, by = -1L, length.out = n) - s <- seq_len(n) - } - x <- from@x / rep.int(sd, r) / sd[sequence.default(r, s)] - x[indDiag(n, upper = u, packed = TRUE)] <- 1 - to@x <- x - - .set.factor(from, "correlation", to) -} - -.M2cor <- function(from) .dpo2cor(as(from, "dpoMatrix")) - -.M2pcor <- function(from) .dpp2pcor(as(from, "dppMatrix")) - -setAs("dpoMatrix", "corMatrix", .dpo2cor) -setAs( "Matrix", "corMatrix", .M2cor) -setAs( "matrix", "corMatrix", .M2cor) - -setAs("dppMatrix", "pcorMatrix", .dpp2pcor) -setAs( "Matrix", "pcorMatrix", .M2pcor) -setAs( "matrix", "pcorMatrix", .M2pcor) - -if(TRUE) { -## Needed to bypass S4 quirk/bug ... without it we see the behaviour below (??) -setAs("dsyMatrix", "corMatrix", .M2cor) -setAs("dspMatrix", "pcorMatrix", .M2pcor) -} else { -library(Matrix) -body(selectMethod("coerce", c("dsyMatrix", "corMatrix"))) -## .dpo2cor(as(from, "dpoMatrix")) -as(new("dsyMatrix"), "corMatrix") -## 0 x 0 Matrix of class "corMatrix" -## <0 x 0 matrix> -body(selectMethod("coerce", c("dsyMatrix", "corMatrix"))) -## { -## obj <- new("corMatrix") -## as(obj, "dsyMatrix") <- from -## obj -## } -} - -rm(.M2cor, .M2pcor) diff -Nru rmatrix-1.6-1.1/R/denseMatrix.R rmatrix-1.6-5/R/denseMatrix.R --- rmatrix-1.6-1.1/R/denseMatrix.R 2023-07-30 20:12:54.000000000 +0000 +++ rmatrix-1.6-5/R/denseMatrix.R 2023-10-16 18:09:25.000000000 +0000 @@ -1,103 +1,215 @@ ## METHODS FOR CLASS: denseMatrix (virtual) ## dense matrices with unpacked _or_ packed storage -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("dim<-", signature(x = "denseMatrix"), - function(x, value) { - if(!is.numeric(value) || length(value) != 2L) - stop("dimensions must be numeric of length 2") - if(anyNA(value)) - stop("dimensions cannot contain NA") - if(any(value < 0)) - stop("dimensions cannot contain negative values") - if(!is.integer(value)) { - if(any(value > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") - value <- as.integer(value) +.dense.band <- function(x, k1, k2, ...) + .Call(R_dense_band, x, k1, k2) +.dense.triu <- function(x, k = 0L, ...) + .Call(R_dense_band, x, k, NULL) +.dense.tril <- function(x, k = 0L, ...) + .Call(R_dense_band, x, NULL, k) +.dense.diag.get <- function(x, nrow, ncol, names = TRUE) + .Call(R_dense_diag_get, x, names) +.dense.diag.set <- function(x, value) + .Call(R_dense_diag_set, x, value) +.dense.t <- function(x) + .Call(R_dense_transpose, x) +.dense.fS1 <- function(x, uplo) + .Call(R_dense_force_symmetric, x, NULL) +.dense.fS2 <- function(x, uplo) + .Call(R_dense_force_symmetric, x, uplo) +.dense.symmpart <- function(x) + .Call(R_dense_symmpart, x) +.dense.skewpart <- function(x) + .Call(R_dense_skewpart, x) +.dense.is.di <- function(object) + .Call(R_dense_is_diagonal, object) +.dense.is.tr <- function(object, upper = NA, ...) + .Call(R_dense_is_triangular, object, upper) +.dense.is.sy <- function(object, checkDN = TRUE, ...) { + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) check.attributes + checkDN <- ca(...) + } + .Call(R_dense_is_symmetric, object, checkDN) +} +.dense.is.sy.dz <- function(object, checkDN = TRUE, + tol = 100 * .Machine$double.eps, + tol1 = 8 * tol, ...) { + ## backwards compatibility: don't check DN if check.attributes=FALSE + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) check.attributes + checkDN <- ca(...) + } + ## be very fast when requiring exact symmetry + if(tol <= 0) + return(.Call(R_dense_is_symmetric, object, checkDN)) + ## pretest: is it square? + d <- object@Dim + if((n <- d[2L]) != d[1L]) + return(FALSE) + ## pretest: are DN symmetric in the sense of validObject()? + if(checkDN && !isSymmetricDN(object@Dimnames)) + return(FALSE) + if(n == 0L) + return(TRUE) + object <- .M2gen(object) + + ## now handling n-by-n [dz]geMatrix, n >= 1: + + Cj <- if(is.complex(object@x)) Conj else identity + ae <- function(check.attributes, ...) { + ## discarding possible user-supplied check.attributes + all.equal.numeric(..., check.attributes = FALSE) + } + + ## pretest: outermost rows ~= outermost columns? + ## (fast for large asymmetric) + if(length(tol1)) { + i. <- if(n <= 4L) 1L:n else c(1L, 2L, n - 1L, n) + for(i in i.) + if(!isTRUE(ae(target = object[i, ], current = Cj(object[, i]), + tolerance = tol1, ...))) + return(FALSE) + } + isTRUE(ae(target = object @x, + current = Cj(t(object))@x, + tolerance = tol, ...)) +} + +setMethod("diff", signature(x = "denseMatrix"), + ## Mostly cut and paste of base::diff.default : + function(x, lag = 1L, differences = 1L, ...) { + if(length(lag) != 1L || length(differences) != 1L || + lag < 1L || differences < 1L) + stop(gettextf("'%s' and '%s' must be positive integers", + "lag", "differences"), + domain = NA) + if(lag * differences >= x@Dim[1L]) + return(x[0L]) + i1 <- -seq_len(lag) + for(i in seq_len(differences)) { + m <- x@Dim[1L] + x <- x[i1, , drop = FALSE] - + x[-m:-(m - lag + 1L), , drop = FALSE] } - if(all(value == (d <- x@Dim))) - return(x) - if((pv <- prod(value)) != (pd <- prod(d))) - stop(gettextf("assigned dimensions [product %.0f] do not match Matrix length [%.0f]", - pv, pd, domain = NA)) - r <- .M2gen(x) - r@Dim <- value - r@factors <- list() - r + x }) setMethod("mean", signature(x = "denseMatrix"), - function(x, trim = 0, na.rm = FALSE, ...) { - if(is.numeric(trim) && length(trim) == 1L && !is.na(trim) && - trim == 0) { - ## Be fast in this special case : - if(isTRUE(na.rm)) - x <- x[!is.na(x)] - sum(x) / length(x) - } else mean.default(.M2v(x), trim = trim, na.rm = na.rm, ...) - }) + function(x, ...) mean.default(.M2v(x), ...)) + +setMethod("rep", signature(x = "denseMatrix"), + function(x, ...) rep(.M2v(x), ...)) + +setMethod("band" , signature(x = "denseMatrix"), .dense.band) + +setMethod("triu" , signature(x = "denseMatrix"), .dense.triu) + +setMethod("tril" , signature(x = "denseMatrix"), .dense.tril) + +setMethod("diag" , signature(x = "denseMatrix"), .dense.diag.get) + +setMethod("diag<-", signature(x = "denseMatrix"), .dense.diag.set) + +setMethod("t" , signature(x = "denseMatrix"), .dense.t) + +setMethod("forceSymmetric", signature(x = "denseMatrix", uplo = "missing"), .dense.fS1) + +setMethod("forceSymmetric", signature(x = "denseMatrix", uplo = "character"), .dense.fS2) -setMethod("rep", "denseMatrix", - function(x, ...) rep(.M2v(x), ...)) +setMethod("symmpart", signature(x = "denseMatrix"), .dense.symmpart) -setMethod("show", "denseMatrix", - function(object) prMatrix(object)) +setMethod("skewpart", signature(x = "denseMatrix"), .dense.skewpart) -.dense.band <- function(x, k1, k2, ...) .Call(R_dense_band, x, k1, k2) -.dense.triu <- function(x, k = 0L, ...) .Call(R_dense_band, x, k, NULL) -.dense.tril <- function(x, k = 0L, ...) .Call(R_dense_band, x, NULL, k) -for (.cl in c("denseMatrix", "matrix")) { - setMethod("band", signature(x = .cl), .dense.band) - setMethod("triu", signature(x = .cl), .dense.triu) - setMethod("tril", signature(x = .cl), .dense.tril) +setMethod("isSymmetric" , signature(object = "denseMatrix"), .dense.is.sy) + +setMethod("isTriangular", signature(object = "denseMatrix"), .dense.is.tr) + +setMethod("isDiagonal" , signature(object = "denseMatrix"), .dense.is.di) + +.dense.subclasses <- names(getClassDef("denseMatrix")@subclasses) +for (.cl in grep("^[dz](ge|tr|tp)Matrix$", .dense.subclasses, value = TRUE)) +setMethod("isSymmetric" , signature(object = .cl), .dense.is.sy.dz) +rm(.cl, .dense.subclasses) + + +## METHODS FOR CLASS: unpackedMatrix (virtual) +## dense matrices with unpacked storage +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("unpack", signature(x = "packedMatrix"), + function(x, ...) .Call(R_dense_as_unpacked, x)) + +setMethod("pack", signature(x = "packedMatrix"), + function(x, ...) x) + + +## METHODS FOR CLASS: packedMatrix (virtual) +## dense matrices with packed storage +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.uM.pack <- +function(x, ...) .Call(R_dense_as_packed, x, NULL, NULL) + +.uM.pack.ge <- +function(x, symmetric = NA, upperTri = NA, ...) { + if(((sna <- is.na(symmetric)) || symmetric) && isSymmetric(x, ...)) + .Call(R_dense_as_packed, x, "U", NULL) + else if((sna || !symmetric) && + (it <- isTriangular(x, upper = upperTri))) { + uplo <- + if(is.na(upperTri)) + attr(it, "kind") + else if(upperTri) + "U" + else "L" + .Call(R_dense_as_packed, x, uplo, "N") + } else { + if(sna) + stop("matrix is not symmetric or triangular") + else if(symmetric) + stop("matrix is not symmetric") + else stop("matrix is not triangular") + } } -rm(.dense.band, .dense.triu, .dense.tril, .cl) -## x[] <- value : -setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "missing", - value = "ANY"),## double/logical/... - function (x, value) { - x <- .M2gen(x) - 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) - .m2dense(r, paste0(.M.kind(x), "ge")) - }) - -setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "index", - value = "replValue"), - function (x, i, j, ..., value) { - r <- as(x, "matrix") - r[, j] <- value - .m2dense(r, paste0(.M.kind(x), "ge")) - }) - -setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "index", - value = "replValue"), - function (x, i, j, ..., value) { - r <- as(x, "matrix") - r[i, j] <- value - as_denseClass(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 - .m2dense(r, paste0(.M.kind(x), "ge")) - }) +setMethod("unpack", signature(x = "unpackedMatrix"), + function(x, ...) x) + +setMethod("pack", signature(x = "unpackedMatrix"), .uM.pack) + +.uM.subclasses <- names(getClassDef("unpackedMatrix")@subclasses) +for(.cl in grep("^.geMatrix$", .uM.subclasses, value = TRUE)) +setMethod("pack", signature(x = .cl), .uM.pack.ge) +rm(.cl, .uM.subclasses) + + +## METHODS FOR CLASS: matrix +## traditional matrices, which really are "dense" +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.m.pack <- .uM.pack.ge +body(.m.pack)[[2L]][[3L]] <- quote(.m2dense(x, ".sp", "U")) +body(.m.pack)[[2L]][[4L]][[3L]][[3L]] <- quote(.m2dense(x, ".tp", uplo)) + +setMethod("unpack", signature(x = "matrix"), + function(x, ...) .m2dense.checking(x, ".")) +setMethod("pack", signature(x = "matrix"), .m.pack) +setMethod("band", signature(x = "matrix"), .dense.band) +setMethod("triu", signature(x = "matrix"), .dense.triu) +setMethod("tril", signature(x = "matrix"), .dense.tril) +setMethod("forceSymmetric", signature(x = "matrix", uplo = "missing"), + function(x, uplo) .m2dense(x, ".sy", "U")) +setMethod("forceSymmetric", signature(x = "matrix", uplo = "character"), + function(x, uplo) .m2dense(x, ".sy", uplo)) +setMethod("symmpart", signature(x = "matrix"), + function(x) symmetrizeDN(0.5 * (x + t(x)))) +setMethod("skewpart", signature(x = "matrix"), + function(x) symmetrizeDN(0.5 * (x - t(x)))) +setMethod("isTriangular", signature(object = "matrix"), .dense.is.tr) +setMethod("isDiagonal" , signature(object = "matrix"), .dense.is.di) + +rm(.uM.pack, .uM.pack.ge, .m.pack, + list = c(grep("^[.]dense[.](band|tri[ul]|diag[.](get|set)|t|fS[12]|symmpart|skewpart|is[.](sy|tr|di)([.]dz)?)$", + ls(all.names = TRUE), value = TRUE))) diff -Nru rmatrix-1.6-1.1/R/determinant.R rmatrix-1.6-5/R/determinant.R --- rmatrix-1.6-1.1/R/determinant.R 2023-07-30 17:39:25.000000000 +0000 +++ rmatrix-1.6-5/R/determinant.R 2023-10-03 10:01:41.000000000 +0000 @@ -47,21 +47,17 @@ function(x, logarithm = TRUE, ...) .Call(sparseQR_determinant, x, logarithm)) -setMethod("determinant", signature(x = "BunchKaufman", logarithm = "logical"), - function(x, logarithm = TRUE, ...) - .Call(BunchKaufman_determinant, x, logarithm, FALSE)) - -setMethod("determinant", signature(x = "pBunchKaufman", logarithm = "logical"), - function(x, logarithm = TRUE, ...) - .Call(BunchKaufman_determinant, x, logarithm, TRUE)) - -setMethod("determinant", signature(x = "Cholesky", logarithm = "logical"), +for(.cl in c("BunchKaufman", "pBunchKaufman")) +setMethod("determinant", signature(x = .cl, logarithm = "logical"), function(x, logarithm = TRUE, ...) - .Call(Cholesky_determinant, x, logarithm, FALSE)) + .Call(BunchKaufman_determinant, x, logarithm)) +rm(.cl) -setMethod("determinant", signature(x = "pCholesky", logarithm = "logical"), +for(.cl in c("Cholesky", "pCholesky")) +setMethod("determinant", signature(x = .cl, logarithm = "logical"), function(x, logarithm = TRUE, ...) - .Call(Cholesky_determinant, x, logarithm, TRUE)) + .Call(Cholesky_determinant, x, logarithm)) +rm(.cl) setMethod("determinant", signature(x = "CHMfactor", logarithm = "logical"), function(x, logarithm = TRUE, sqrt = TRUE, ...) { @@ -76,7 +72,9 @@ oop <- options(warn = 2L) on.exit(options(oop)) } - warning("the default value of argument 'sqrt' of method 'determinant(, )' may change from TRUE to FALSE as soon as the next release of Matrix; set 'sqrt' when programming") + warning(gettextf("the default value of argument '%s' of method '%s(<%s>, <%s>)' may change from %s to %s as soon as the next release of Matrix; set '%s' when programming", + "sqrt", "determinant", "CHMfactor", "logical", "TRUE", "FALSE", "sqrt"), + domain = NA) } } .Call(CHMfactor_determinant, x, logarithm, sqrt) @@ -93,7 +91,7 @@ setMethod("determinant", signature(x = "Matrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) - determinant(as(x, "dMatrix"), logarithm, ...)) + determinant(.M2kind(x, ","), logarithm, ...)) ## .... GENERAL ........................................................ @@ -109,7 +107,7 @@ setMethod("determinant", signature(x = "dgCMatrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) { d <- x@Dim - if((n <- d[1L]) != d[2L]) + if(d[1L] != d[2L]) stop("determinant of non-square matrix is undefined") trf <- lu(x, errSing = FALSE) if(isS4(trf)) @@ -128,7 +126,7 @@ setMethod("determinant", signature(x = "indMatrix", logarithm = "logical"), function(x, logarithm = TRUE, ...) { d <- x@Dim - if((n <- d[1L]) != d[2L]) + if(d[1L] != d[2L]) stop("determinant of non-square matrix is undefined") if(anyDuplicated.default(perm <- x@perm)) .mkDet(-Inf, logarithm, 1L) @@ -140,23 +138,6 @@ .mkDet(0, logarithm, signPerm(x@perm))) -## .... TRIANGULAR ..................................................... - -setMethod("determinant", signature(x = "triangularMatrix", logarithm = "logical"), - function(x, logarithm = TRUE, ...) { - if(x@diag == "N") - .mkDet(x = diag(x, names = FALSE), logarithm = logarithm) - else .mkDet(0, logarithm, 1L) - }) - -setMethod("determinant", signature(x = "diagonalMatrix", logarithm = "logical"), - function(x, logarithm = TRUE, ...) { - if(x@diag == "N") - .mkDet(x = x@x, logarithm = logarithm) - else .mkDet(0, logarithm, 1L) - }) - - ## .... SYMMETRIC ...................................................... for(.cl in c("dsyMatrix", "dspMatrix")) @@ -195,18 +176,13 @@ function(x, logarithm = TRUE, ...) determinant(.M2C(x), logarithm, ...)) -## MJ: unused -if(FALSE) { -ldet1.dsC <- function(x, ...) - .Call(CHMfactor_ldetL2, Cholesky(x, ...)) - -## ~3% faster than ldet1: -ldet2.dsC <- function(x, ...) { - Ch <- Cholesky(x, super = FALSE, ...) - .Call(diag_tC, Ch, "sumLog") -} - -## <1% faster than ldet2: -ldet3.dsC <- function(x, perm = TRUE) - .Call(dsCMatrix_LDL_D, x, perm = perm, "sumLog") -} ## MJ + +## .... TRIANGULAR ..................................................... + +for(.cl in c("triangularMatrix", "diagonalMatrix")) +setMethod("determinant", signature(x = .cl, logarithm = "logical"), + function(x, logarithm = TRUE, ...) + if(x@diag == "N") + .mkDet(x = diag(x, names = FALSE), logarithm = logarithm) + else .mkDet(0, logarithm, 1L)) +rm(.cl) diff -Nru rmatrix-1.6-1.1/R/diagMatrix.R rmatrix-1.6-5/R/diagMatrix.R --- rmatrix-1.6-1.1/R/diagMatrix.R 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/R/diagMatrix.R 2023-09-22 19:22:19.000000000 +0000 @@ -2,258 +2,50 @@ ## diagonal matrices ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## For group methods -.diag2tT.smart <- function(from, x, kind = ".") { - shape <- .M.shape(x) - uplo <- if(shape == "t") x@uplo else "U" - .diag2sparse(.M2kind(from, kind), "t", "T", uplo) -} -.diag2T.smart <- function(from, x, kind = ".") { - shape <- .M.shape(x) - uplo <- if(shape == "s" || shape == "t") x@uplo else "U" - .diag2sparse(.M2kind(from, kind), if(shape == "s") "s" else "t", "T", uplo) -} - - -## ~~~~ CONSTRUCTORS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## diagonalMatrix constructor, allowing either or both of 'n' and 'x' to be -## missing ... like base::diag() but _not_ also extracting diagonal entries -Diagonal <- function(n, x = NULL, names = FALSE) { - nx <- length(x) - if(missing(n)) - n <- nx - else if(!is.numeric(n) || length(n) != 1L || is.na(n) || n < 0L) - stop("'n' must be a non-negative integer") - if(is.double(n) && n >= .Machine$integer.max + 1) - stop("dimensions cannot exceed 2^31-1") - n <- as.integer(n) # discarding attributes - if(is.null(x)) { - r <- new("ddiMatrix") - r@diag <- "U" - if(n > 0L) { - r@Dim <- c(n, n) - if(is.character(names) && length(names) == n) - r@Dimnames <- list(names, names) - } - return(r) - } - if(is.object(x)) - stop(gettextf("'x' has unsupported class \"%s\"", class(x)[1L]), - domain = NA) - names.x <- names(x) # keeping for later - r <- new(switch(typeof(x), - ## discarding attributes, incl. 'dim' and 'names' - logical = { x <- as.logical(x); "ldiMatrix" }, - integer =, - double = { x <- as.double(x); "ddiMatrix" }, - stop(gettextf("'x' has unsupported type \"%s\"", typeof(x)), - domain = NA))) - if(n == 0L) - return(r) - if(nx != 1L) - r@x <- - if(nx == n) - x - else if(nx > 0L) - rep_len(x, n) - else stop("attempt to recycle 'x' of length 0 to length 'n' (n > 0)") - else if(is.na(x) || x != 1) - r@x <- rep.int(x, n) - else r@diag <- "U" - r@Dim <- c(n, n) - if(is.character(names)) { - if(length(names) == n) - r@Dimnames <- list(names, names) - } else if(isTRUE(names) && !is.null(names.x)) { - names.x <- rep_len(names.x, n) # we know length(names.x) > 0L - r@Dimnames <- list(names.x, names.x) - } - r -} - -.sparseDiagonal <- function(n, x = NULL, uplo = "U", shape = "t", unitri = TRUE, - kind, cols) { - if(missing(n)) - n <- length(x) - else if(!is.numeric(n) || length(n) != 1L || is.na(n) || n < 0L) - stop("'n' must be a non-negative integer") - if(is.double(n) && n >= .Machine$integer.max + 1) - stop("dimensions cannot exceed 2^31-1") - n <- nj <- as.integer(n) # stripping attributes - - if(!(missing(shape) || - (is.character(shape) && length(shape) == 1L && !is.na(shape) && - any(shape == c("g", "t", "s"))))) - stop("'shape' must be one of \"g\", \"t\", \"s\"") - - if(!((m.kind <- missing(kind)) || - (is.character(kind) && length(kind) == 1L && !is.na(kind) && - any(kind == c("d", "l", "n"))))) - stop("'kind' must be one of \"d\", \"l\", \"n\"") - - if(m.kind || kind != "n") { - if(is.null(x)) - x <- if(m.kind) { kind <- "d"; 1 } else switch(kind, d = 1, l = TRUE) - else if(is.object(x)) - stop(gettextf("'x' has unsupported class \"%s\"", - class(x)[1L]), - domain = NA) - else { - kind. <- switch(typeof(x), - ## discarding attributes, incl. 'dim' in array case - logical = { x <- as.logical(x); "l" }, - integer =, - double = { x <- as.double(x); "d" }, - stop(gettextf("'x' has unsupported type \"%s\"", - typeof(x)), - domain = NA)) - if(m.kind) - kind <- kind. - else if(kind != kind.) { - warning(gettextf("mismatch between typeof(x)=\"%s\" and kind=\"%s\"; using kind=\"%s\"", - typeof(x), kind, kind.), - domain = NA) - kind <- kind. - } - } - } - - if(!(m.cols <- missing(cols))) { - if(!is.numeric(cols)) - stop("'cols' must be numeric") - else if((nj <- length(cols)) > 0L && - (n == 0L || anyNA(rj <- range(cols)) || - rj[1L] < 0L || rj[2L] >= n)) - stop("'cols' has elements not in seq(0, length.out = n)") - else { - cols <- as.integer(cols) - shape <- "g" - } - } - - r <- new(paste0(kind, shape, "CMatrix")) - r@Dim <- c(n, nj) - if(shape != "g") { - if(!missing(uplo)) { - if(is.character(uplo) && length(uplo) == 1L && !is.na(uplo) && - any(uplo == c("U", "L"))) - r@uplo <- uplo - else stop("'uplo' must be \"U\" or \"L\"") - } - if(shape == "t" && unitri && - (kind == "n" || (!anyNA(x) && all(if(kind == "l") x else x == 1)))) { - r@diag <- "U" - r@p <- integer(nj + 1) - return(r) - } - } - if(nj > 0L) { - r@p <- 0:nj - r@i <- if(m.cols) 0:(nj - 1L) else cols - if(kind != "n") { - x <- - if((nx <- length(x)) == n) - x - else if(nx > 0L) - rep_len(x, n) - else stop("attempt to recycle 'x' of length 0 to length 'n' (n > 0)") - r@x <- if(m.cols) x else x[1L + cols] - } - } - r -} - -.trDiagonal <- function(n, x = NULL, uplo = "U", unitri = TRUE, kind) - .sparseDiagonal(n, x, uplo, shape = "t", unitri = unitri, kind = kind) - -.symDiagonal <- function(n, x = NULL, uplo = "U", kind) - .sparseDiagonal(n, x, uplo, shape = "s", kind = kind) - -.bdiag <- function(lst) { - if(!is.list(lst)) - stop("'lst' must be a list") - if((n <- length(lst)) == 0L) - return(new("dgTMatrix")) - if(n == 1L) - return(.M2T(asCspN(lst[[1L]]))) - -### FIXME? this is _slow_ when 'lst' is list of 75000 3-by-3 dense matrices - lst <- unname(lapply(lst, function(x) .M2T(asCspN(x)))) - - ## NB: class(.M2T(.)) is always "[dln][gts]TMatrix" - cl <- vapply(lst, class, "") - kind <- substr(cl, 1L, 1L) # "d", "l", or "n" - shape <- substr(cl, 2L, 2L) # "g", "t", or "s" - - if(!(any(kind == (kind. <- "d")) || any(kind == (kind. <- "l")))) - kind. <- "n" - else if(any(z <- kind == "n")) - lst[z] <- lapply(lst[z], .sparse2kind, kind.) - - shape. <- - if(all(symmetric <- shape == "s")) - "s" - else if(all(shape == "t")) - "t" - else "g" - - if(shape. != "g") { - uplo <- vapply(lst, slot, "", "uplo") # "U" or "L" - if(shape. == "s") - uplo. <- - if(all(z <- uplo == "U")) - "U" - else if(!any(z)) - "L" - else { - uplo.. <- if(2 * sum(z) >= n) { z <- !z; "U" } else "L" - lst[z] <- lapply(lst[z], - function(x) .Call(R_sparse_transpose, x, FALSE)) - uplo.. - } - else if(any(uplo != (uplo. <- uplo[1L]))) - shape. <- "g" - } - - i_off <- c(0L, cumsum(vapply(lst, function(x) x@Dim[1L], 0L))) - j_off <- c(0L, cumsum(vapply(lst, function(x) x@Dim[2L], 0L))) - - r <- new(paste0(kind., shape., "TMatrix")) - r@Dim <- r@Dim <- c(i_off[n + 1L], j_off[n + 1L]) - if(shape. == "g") - lst[symmetric] <- lapply(lst[symmetric], .sparse2g) - else r@uplo <- uplo. - r@i <- unlist(lapply(seq_len(n), function(k) i_off[k] + lst[[k]]@i), - FALSE, FALSE) - r@j <- unlist(lapply(seq_len(n), function(k) j_off[k] + lst[[k]]@j), - FALSE, FALSE) - if(kind. != "n") - r@x <- unlist(lapply(lst, slot, "x"), FALSE, FALSE) - r -} - -bdiag <- function(...) { - if((n <- ...length()) == 0L) - new("dgCMatrix") - else if(n > 1L) - .M2C(.bdiag(list(...))) - else if(!is.list(x <- ..1)) - as(x, "CsparseMatrix") - else if(length(x) == 1L) - as(x[[1L]], "CsparseMatrix") - else .M2C(.bdiag(x)) -} - +setMethod("band", signature(x = "diagonalMatrix"), + function(x, k1, k2, ...) { + if(k1 <= 0L && k2 >= 0L) + return(x) + r <- new(.M.nonvirtual(x)) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- vector(typeof(x@x), d[1L]) + r + }) -## ~~~~ METHODS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +setMethod("triu", signature(x = "diagonalMatrix"), + function(x, k = 0L, ...) { + if(k <= 0L) + return(x) + r <- new(.M.nonvirtual(x)) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- vector(typeof(x@x), d[1L]) + r + }) - .diag.x <- function(m) if(m@diag != "N") rep.int(as1(m@x), m@Dim[1L]) else m@x -..diag.x <- function(m) rep.int(as1(m@x), m@Dim[1L]) +setMethod("tril", signature(x = "diagonalMatrix"), + function(x, k = 0L, ...) { + if(k >= 0L) + return(x) + r <- new(.M.nonvirtual(x)) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- vector(typeof(x@x), d[1L]) + r + }) setMethod("diag", signature(x = "diagonalMatrix"), function(x, nrow, ncol, names = TRUE) { - r <- .diag.x(x) + kind <- .M.kind(x) + r <- + if(x@diag != "N") { + one <- switch(kind, "n" = , "l" = TRUE, "i" = 1L, "d" = 1, "z" = 1+0i) + rep.int(one, x@Dim[1L]) + } else { + y <- x@x + if(kind == "n" && anyNA(y)) y | is.na(y) else y + } if(names && !any(vapply(dn <- x@Dimnames, is.null, NA)) && { @@ -266,7 +58,7 @@ setMethod("diag<-", signature(x = "diagonalMatrix"), function(x, value) { - n <- x@Dim[1L] + n <- x@Dim[2L] nv <- length(value) if(nv != 1L && nv != n) stop("replacement diagonal has wrong length") @@ -280,14 +72,16 @@ x <- .M2kind(x, "d") rep_len(as.double(x), n) }, - stop(gettextf("replacement diagonal has incompatible type \"%s\"", typeof(value)), + stop(gettextf("replacement diagonal has incompatible type \"%s\"", + typeof(value)), domain = NA)) else switch(typeof(value), logical =, integer =, double = rep_len(as.double(value), n), - stop(gettextf("replacement diagonal has incompatible type \"%s\"", typeof(value)), + stop(gettextf("replacement diagonal has incompatible type \"%s\"", + typeof(value)), domain = NA)) x@diag <- "N" x @@ -296,1368 +90,62 @@ setMethod("t", signature(x = "diagonalMatrix"), function(x) { x@Dimnames <- x@Dimnames[2:1]; x }) -setMethod("band", signature(x = "diagonalMatrix"), - function(x, k1, k2, ...) - if(k1 <= 0L && k2 >= 0L) x else .setZero(x)) - -setMethod("triu", signature(x = "diagonalMatrix"), - function(x, k = 0L, ...) - if(k <= 0L) x else .setZero(x)) - -setMethod("tril", signature(x = "diagonalMatrix"), - function(x, k = 0L, ...) - if(k >= 0L) x else .setZero(x)) +setMethod("forceSymmetric", signature(x = "diagonalMatrix", uplo = "missing"), + function(x, uplo) .diag2sparse(x, ".", "s", "C", "U")) setMethod("forceSymmetric", signature(x = "diagonalMatrix", uplo = "character"), - function(x, uplo) .diag2sparse(x, "s", "C", uplo)) - -setMethod("forceSymmetric", signature(x = "diagonalMatrix", uplo = "missing"), - function(x, uplo) .diag2sparse(x, "s", "C", "U")) + function(x, uplo) .diag2sparse(x, ".", "s", "C", uplo)) setMethod("symmpart", signature(x = "diagonalMatrix"), - function(x) forceSymmetric(.M2kind(x, "d"))) - -setMethod("skewpart", signature(x = "diagonalMatrix"), - function(x) symmetrizeDimnames(.setZero(x, "d"))) - -setMethod("isSymmetric", signature(object = "diagonalMatrix"), - function(object, checkDN = TRUE, ...) { - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - if(ca(...) && !isSymmetricDN(object@Dimnames)) - return(FALSE) + function(x) { + kind <- .M.kind(x) + r <- new(if(kind == "z") "zdiMatrix" else "ddiMatrix") + r@Dim <- x@Dim + r@Dimnames <- symDN(x@Dimnames) + if(x@diag != "N") + r@diag <- "U" + else { + y <- x@x + r@x <- switch(kind, + "n" = as.double(y | is.na(y)), + "l" = , + "i" = , + "d" = as.double(y), + "z" = complex(real = Re(y), imaginary = 0)) } - TRUE - }) - -setMethod("isTriangular", signature(object = "diagonalMatrix"), - function(object, upper = NA, ...) - if(is.na(upper)) `attr<-`(TRUE, "kind", "U") else TRUE) - -setMethod("isDiagonal", signature(object = "diagonalMatrix"), - function(object) TRUE) - -## 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 <- .diag2sparse(x, "g", "C") # was ->TsparseMatrix 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 == 4L) - x[i, ] <- value - else if(na == 3L) - 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)) - forceDiagonal(x) - else if(isSymmetric(x)) - forceSymmetric(x) - else if(!(it <- isTriangular(x))) - x - else if(attr(it, "kind") == "U") - triu(x) - else tril(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() == 3L) - 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.kind(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) == 2L) { - if(all((ii <- i[,1L]) == i[,2L])) { - ## 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[1L]) - } 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 - x <- .diag2sparse(x, "t", "C") # 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) - -## FIXME: Many of these products are not handling 'Dimnames' appropriately ... - -.prod.diag.missing <- function(x, boolArith) { - if(boolArith) { - if(!is.logical(x@x)) - x <- .M2kind(x, "l") - } else { - if(!is.double(x@x)) - x <- .M2kind(x, "d") - if(x@diag == "N") - x@x <- x@x * x@x - } - x -} - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) { - r <- .prod.diag.missing(x, boolArith = isTRUE(boolArith)) - r@Dimnames <- r@Dimnames[c(2L, 2L)] - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) { - r <- .prod.diag.missing(x, boolArith = isTRUE(boolArith)) - r@Dimnames <- r@Dimnames[c(1L, 1L)] - r - }) - -.prod.diag.diag <- function(x, y, boolArith) { - if(boolArith) { - if(x@diag == "N") { - if(!is.logical(x@x)) - x <- .M2kind(x, "l") - if(y@diag == "N") - x@x <- x@x & y@x - x - } else if(is.logical(y@x)) - y - else .M2kind(y, "l") - } else { - if(x@diag == "N") { - if(!is.double(x@x)) - x <- .M2kind(x, "d") - if(y@diag == "N") - x@x <- x@x * y@x - x - } else if(is.double(y@x)) - y - else .M2kind(y, "d") - } -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.diag(x, y, boolArith = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.diag(x, y, boolArith = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.diag.diag(x, y, boolArith = isTRUE(boolArith)) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.diag.diag(x, y, boolArith = isTRUE(boolArith)) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 3L) - r - }) - -.prod.diag.m <- function(x, y, boolArith, trans) { - if(boolArith) { - kind <- "n" - op <- `&` - } else { - kind <- "d" - op <- `*` - } - .m2dense(if(x@diag == "N") - op(x@x, if(trans) t(y) else y) - else if(trans) - t(y) - else y, - paste0(kind, "ge")) -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "matrix"), - function(x, y) { - mmultDim(x@Dim, dim(y), type = 1L) - r <- .prod.diag.m(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "matrix"), - function(x, y) { - mmultDim(x@Dim, dim(y), type = 1L) - r <- .prod.diag.m(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, dim(y), type = 2L) - r <- .prod.diag.m(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, dim(y), type = 3L) - r <- .prod.diag.m(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -.prod.m.diag <- function(x, y, boolArith, trans) { - if(boolArith) { - kind <- "n" - op <- `&` - } else { - kind <- "d" - op <- `*` - } - .m2dense(if(y@diag == "N") - op(if(trans) t(x) else x, - rep(y@x, each = dim(x)[1L + trans])) - else if(trans) - t(x) - else x, - paste0(kind, "ge")) -} - -setMethod("%*%", signature(x = "matrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(dim(x), y@Dim, type = 1L) - r <- .prod.m.diag(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) r }) -setMethod("%&%", signature(x = "matrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(dim(x), y@Dim, type = 1L) - r <- .prod.m.diag(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "matrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(dim(x), y@Dim, type = 2L) - r <- .prod.m.diag(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "matrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(dim(x), y@Dim, type = 3L) - r <- .prod.m.diag(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 3L) - r - }) - -## FIXME: %*% should not be symmetric, -## because the inherited 'rownames' and 'colnames' could differ ... - -.prod.diag.dense <- function(x, y, boolArith, trans) { - if(boolArith) { - y <- .M2kind(y, "n") - op <- `&` - one <- TRUE - } else { - if(!is.double(y@x)) - y <- .M2kind(y, "d") - op <- `*` - one <- 1 - } - if(x@diag == "N") { - y@x <- - if(!.hasSlot(y, "uplo")) { - ## y=[nd]geMatrix - if(trans) - y <- t(y) - y@factors <- list() - op(x@x, y@x) - } else if(.hasSlot(y, "diag")) { - ## y=[nd]t[rp]Matrix - if(trans) - y <- t(y) - if(y@diag != "N") - diag(y) <- one - if(length(y@x) == (n <- y@Dim[1L])^2) - op(x@x, y@x) - else if(y@uplo == "U") - op(x@x[sequence.default(1:n, rep.int(1L, n))], y@x) - else - op(x@x[sequence.default(n:1, 1:n)], y@x) - } else { - ## y=[nd]s[yp]Matrix - y <- .M2gen(y) - y@factors <- list() - op(x@x, y@x) - } - y - } else if(trans) - t(y) - else y -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "denseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.dense(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "denseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.dense(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "denseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.diag.dense(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "denseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.diag.dense(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -.prod.dense.diag <- function(x, y, boolArith, trans) { - if(boolArith) { - x <- .M2kind(x, "n") - op <- `&` - one <- TRUE - } else { - if(!is.double(x@x)) - x <- .M2kind(x, "d") - op <- `*` - one <- 1 - } - if(y@diag == "N") { - x@x <- - if(!.hasSlot(x, "uplo")) { - ## x=[nd]geMatrix - if(trans) - x <- t(x) - x@factors <- list() - op(x@x, rep(y@x, each = x@Dim[1L])) - } else if(.hasSlot(x, "diag")) { - ## x=[nd]t[rp]Matrix - if(trans) - x <- t(x) - if(x@diag != "N") - diag(x) <- one - if(length(x@x) == (n <- x@Dim[1L])^2) - op(x@x, rep(y@x, each = x@Dim[1L])) - else if(x@uplo == "U") - op(x@x, rep.int(y@x, 1:n)) - else - op(x@x, rep.int(y@x, n:1)) - } else { - ## x=[nd]s[yp]Matrix - x <- .M2gen(x) - x@factors <- list() - op(x@x, rep(y@x, each = x@Dim[1L])) - } - x - } else if(trans) - t(x) - else x -} - -setMethod("%*%", signature(x = "denseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.dense.diag(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "denseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.dense.diag(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "denseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.dense.diag(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "denseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.dense.diag(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 3L) - r - }) - -.prod.diag.Csparse <- function(x, y, boolArith, trans) { - if(x@diag == "N") { - y <- .M2kind(y, if(boolArith) "l" else "d") - if(!.hasSlot(y, "uplo")) { - ## y=[ld]gCMatrix - if(trans) - y <- t(y) - y@factors <- list() - } else if(.hasSlot(y, "diag")) { - ## y=[ld]tCMatrix - if(trans) - y <- t(y) - if(y@diag != "N") - y <- ..diagU2N(y) - } else { - ## y=[ld]sCMatrix - y <- .M2gen(y) - y@factors <- list() - } - op <- if(boolArith) `&` else `*` - y@x <- op(x@x[y@i + 1L], y@x) - if(boolArith) .M2kind(.drop0(y), "n") else y - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(y), "n") - else .M2kind(y, "d")) -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Csparse(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "CsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Csparse(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.diag.Csparse(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.diag.Csparse(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -.prod.Csparse.diag <- function(x, y, boolArith, trans) { - if(y@diag == "N") { - x <- .M2kind(x, if(boolArith) "l" else "d") - if(!.hasSlot(x, "uplo")) { - ## x=[ld]gCMatrix - if(trans) - x <- t(x) - x@factors <- list() - } else if(.hasSlot(x, "diag")) { - ## x=[ld]tCMatrix - if(trans) - x <- t(x) - if(x@diag != "N") - x <- ..diagU2N(x) - } else { - ## x=[ld]sCMatrix - x <- .M2gen(x) - x@factors <- list() - } - dp <- if((n <- length(p <- x@p)) > 1L) p[-1L] - p[-n] else integer(0L) - x@x <- (if(boolArith) `&` else `*`)(x@x, rep.int(y@x, dp)) - if(boolArith) .M2kind(.drop0(x), "n") else x - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(x), "n") - else .M2kind(x, "d")) -} - -setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Csparse.diag(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "CsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Csparse.diag(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.Csparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.Csparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 3L) - r - }) - -.prod.diag.Rsparse <- function(x, y, boolArith, trans) { - if(x@diag == "N") { - y <- .M2kind(y, if(boolArith) "l" else "d") - if(!.hasSlot(y, "uplo")) { - ## y=[ld]gRMatrix - if(trans) - y <- t(y) - y@factors <- list() - } else if(.hasSlot(y, "diag")) { - ## y=[ld]tRMatrix - if(trans) - y <- t(y) - if(y@diag != "N") - y <- ..diagU2N(y) - } else { - ## y=[ld]sRMatrix - y <- .M2gen(y) - y@factors <- list() - } - dp <- if((n <- length(p <- y@p)) > 1L) p[-1L] - p[-n] else integer(0L) - y@x <- (if(boolArith) `&` else `*`)(rep.int(x@x, dp), y@x) - if(boolArith) .M2kind(.drop0(y), "n") else y - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(y), "n") - else .M2kind(y, "d")) -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "RsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Rsparse(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "RsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Rsparse(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "RsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.diag.Rsparse(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "RsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.diag.Rsparse(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -.prod.Rsparse.diag <- function(x, y, boolArith, trans) { - if(y@diag == "N") { - x <- .M2kind(x, if(boolArith) "l" else "d") - if(!.hasSlot(x, "uplo")) { - ## x=[ld]gRMatrix - if(trans) - x <- t(x) - x@factors <- list() - } else if(.hasSlot(x, "diag")) { - ## x=[ld]tRMatrix - if(trans) - x <- t(x) - if(x@diag != "N") - x <- ..diagU2N(x) - } else { - ## x=[ld]sRMatrix - x <- .M2gen(x) - x@factors <- list() - } - op <- if(boolArith) `&` else `*` - x@x <- op(x@x, y@x[x@j + 1L]) - if(boolArith) .M2kind(.drop0(x), "n") else x - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(x), "n") - else .M2kind(x, "d")) -} - -setMethod("%*%", signature(x = "RsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Rsparse.diag(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "RsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Rsparse.diag(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "RsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.Rsparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "RsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.Rsparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 3L) - r - }) - -.prod.diag.Tsparse <- function(x, y, boolArith, trans) { - if(x@diag == "N") { - y <- .M2kind(y, if(boolArith) "l" else "d") - if(!.hasSlot(y, "uplo")) { - ## y=[ld]gTMatrix - if(trans) - y <- t(y) - y@factors <- list() - } else if(.hasSlot(y, "diag")) { - ## y=[ld]tTMatrix - if(trans) - y <- t(y) - if(y@diag != "N") - y <- ..diagU2N(y) - } else { - ## y=[ld]sTMatrix - y <- .M2gen(y) - y@factors <- list() - } - op <- if(boolArith) `&` else `*` - y@x <- op(x@x[y@i + 1L], y@x) - if(boolArith) .M2kind(.drop0(y), "n") else y - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(y), "n") - else .M2kind(y, "d")) -} - -setMethod("%*%", signature(x = "diagonalMatrix", y = "TsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Tsparse(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "diagonalMatrix", y = "TsparseMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.diag.Tsparse(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "diagonalMatrix", y = "TsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.diag.Tsparse(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "TsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.diag.Tsparse(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -.prod.Tsparse.diag <- function(x, y, boolArith, trans) { - if(y@diag == "N") { - x <- .M2kind(x, if(boolArith) "l" else "d") - if(!.hasSlot(x, "uplo")) { - ## x=[ld]gTMatrix - if(trans) - x <- t(x) - x@factors <- list() - } else if(.hasSlot(x, "diag")) { - ## x=[ld]tTMatrix - if(trans) - x <- t(x) - if(x@diag != "N") - x <- ..diagU2N(x) - } else { - ## x=[ld]sTMatrix - x <- .M2gen(x) - x@factors <- list() - } - op <- if(boolArith) `&` else `*` - x@x <- op(x@x, y@x[x@j + 1L]) - if(boolArith) .M2kind(.drop0(x), "n") else x - } else - (if(trans) t else identity)( - if(boolArith) - .M2kind(.drop0(x), "n") - else .M2kind(x, "d")) -} - -setMethod("%*%", signature(x = "TsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Tsparse.diag(x, y, boolArith = FALSE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "TsparseMatrix", y = "diagonalMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - r <- .prod.Tsparse.diag(x, y, boolArith = TRUE, trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod( "crossprod", signature(x = "TsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - r <- .prod.Tsparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = TRUE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "diagonalMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - r <- .prod.Tsparse.diag(x, y, boolArith = isTRUE(boolArith), - trans = FALSE) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 3L) +setMethod("skewpart", signature(x = "diagonalMatrix"), + function(x) { + kind <- .M.kind(x) + r <- new(if(kind == "z") "zdiMatrix" else "ddiMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- symDN(x@Dimnames) + r@x <- + if(kind == "z") { + if(x@diag != "N") + complex(d[1L]) + else complex(real = 0, imaginary = Im(x@x)) + } else double(d[1L]) r }) +setMethod("isDiagonal", signature(object = "diagonalMatrix"), + function(object) TRUE) +setMethod("isTriangular", signature(object = "diagonalMatrix"), + function(object, upper = NA, ...) + if(is.na(upper)) `attr<-`(TRUE, "kind", "U") else TRUE) -###---------------- (, , ) ---------------------- - -## 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.double(r)) - r <- as.double(r) - if(is.double(e2@x)) { - e2@x <- r - e2@diag <- "N" - return(e2) - } - if(!is.double(e1@x)) - ## e.g. e1, e2 are logical; - e1 <- .M2kind(e1, "d") - } - else if(is.logical(r)) - e1 <- .M2kind(e1, "l") - else stop(gettextf("intermediate 'r' is of type %s", - typeof(r)), domain=NA) - e1@x <- r - e1@diag <- "N" - 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(getClassDef("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) - rm(c1, c2) -} -rm(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) -rm(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, - "+" = `diag<-`(e1, as.double(diag(e1, names=FALSE) + .diag.x(e2))), - "-" = `diag<-`(e1, as.double(diag(e1, names=FALSE) - .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 ^ .diag2dense(e2, "g", FALSE) - }, - ## otherwise: - callGeneric(e1, .diag2T.smart(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(.diag2T.smart(e1, e2, kind = "d"), e2)) -setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ddiMatrix"), - function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind = "d"))) -## ldi* -setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "sparseMatrix"), - function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind = "l"), e2)) -setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "ldiMatrix"), - function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind = "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 - 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 if(n) { - L1 <- (le <- length(e2)) == 1L - 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.smart(e1, e2, kind = "d"), e2) - }) -rm(arg2) - -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 - 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 { - L1 <- (le <- length(e1)) == 1L - 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.smart(e2, e1, kind = "d")) - }) -rm(arg1) - -## 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 - 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 if(n) { - L1 <- (le <- length(e2)) == 1L - 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.smart(e1, e2, kind = "l"), e2) - }) -rm(arg2) - -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 - 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 if(n) { - L1 <- (le <- length(e1)) == 1L - 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.smart(e2, e1, kind = "l")) - }) -rm(arg1) - -## 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 - 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 if(n) { - L1 <- (le <- length(e2)) == 1L - 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.smart(e1, e2, kind = "d"), e2) - }) -rm(arg2) - -## 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 - 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 if(n) { - L1 <- (le <- length(e2)) == 1L - 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.smart(e1, e2, kind = "l"), e2) - }) -rm(arg2) - -## Not {"sparseMatrix", "numeric} : {"denseMatrix", "matrix", ... } -for(other in c("ANY", "Matrix", "dMatrix")) { - ## ddi*: - setMethod("Ops", signature(e1 = "ddiMatrix", e2 = other), - function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind="d"), e2)) - setMethod("Ops", signature(e1 = other, e2 = "ddiMatrix"), - function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind="d"))) - ## ldi*: - setMethod("Ops", signature(e1 = "ldiMatrix", e2 = other), - function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind="l"), e2)) - setMethod("Ops", signature(e1 = other, e2 = "ldiMatrix"), - function(e1,e2) callGeneric(e1, .diag2T.smart(e2, e1, kind="l"))) -} -rm(other) - -## Direct subclasses of "denseMatrix": currently ddenseMatrix, ldense... : -if(FALSE) # now also contains "geMatrix" -dense.subCl <- local({ dM.scl <- getClassDef("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(.diag2T.smart(e1, e2, kind = "d"), e2) - else # "lMatrix", the only other kind for now - function(e1,e2) callGeneric(.diag2T.smart(e1, e2, kind = "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) - } -} -rm(dense.subCl, DI, dMeth, c2, Fun) - -## 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 - }) -} -rm(cl, diCls) - -## 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) +setMethod("isSymmetric", signature(object = "diagonalMatrix"), + function(object, checkDN = TRUE, ...) { + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) + check.attributes + if(ca(...) && !isSymmetricDN(object@Dimnames)) + return(FALSE) } + .M.kind(object) != "z" || object@diag != "N" || + { x <- object@x; isTRUE(all.equal.numeric(x, Conj(x), ...)) } }) - -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) -} diff -Nru rmatrix-1.6-1.1/R/dim.R rmatrix-1.6-5/R/dim.R --- rmatrix-1.6-1.1/R/dim.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/dim.R 2023-12-06 18:46:20.000000000 +0000 @@ -0,0 +1,209 @@ +validDim <- function(dim) + .Call(R_Dim_validate, dim) + +validDimGetsValue <- function(value, mn) { + if(mode(value) != "numeric") + gettextf("assigned dimensions are not of type \"%s\" or \"%s\"", + "integer", "double") + else if(length(value) != 2L) + gettextf("assigned dimensions do not have length %d", 2L) + else if(anyNA(value)) + gettext("assigned dimensions are NA") + else if(any(value < 0L)) + gettext("assigned dimensions are negative") + else if(is.double(value) && any(trunc(value) > .Machine$integer.max)) + gettextf("assigned dimensions exceed %s", "2^31-1") + else if((p <- prod(value)) != mn) + gettextf("assigned dimensions [product %.0f] do not match object length [%.0f]", + p, as.double(mn)) + else TRUE +} + +validDN <- function(dn, dim) + .Call(R_DimNames_validate, dn, dim) + +fixupDN <- function(dn) + .Call(R_DimNames_fixup, dn) + +fixupDN.if.valid <- function(dn, dim) { + if(is.character(s <- validDim(dim)) || is.character(s <- validDN(dn, dim))) + stop(s, domain = NA) + fixupDN(dn) +} + +symDN <- function(dn) + .Call(R_symDN, dn) + +symmetrizeDN <- function(x) { + if(isS4(x)) # assuming is(x, "Matrix") + `dimnames<-`(x, symDN(x@Dimnames)) + else if(!is.null(dn <- dimnames(x))) # assuming list of length 2 + `dimnames<-`(x, symDN(dn)) + else x +} + +isSymmetricDN <- function(dn) + .Call(R_DimNames_is_symmetric, dn) + +is.null.DN <- function(dn) { + if(is.null(dn)) + return(TRUE) + if(!is.null(names(dn))) + names(dn) <- NULL + ch0 <- character(0L) + identical(dn, list(NULL, NULL)) || + identical(dn, list( ch0, NULL)) || + identical(dn, list(NULL, ch0)) || + identical(dn, list( ch0, ch0)) +} + + +## METHODS FOR GENERIC: dim +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("dim", signature(x = "Matrix"), + function(x) x@Dim) + +setMethod("dim", signature(x = "MatrixFactorization"), + function(x) x@Dim) + + +## METHODS FOR GENERIC: dim<- +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("dim<-", signature(x = "denseMatrix"), + function(x, value) { + if(is.character(s <- validDimGetsValue(value, prod(d <- x@Dim)))) + stop(s, domain = NA) + value <- as.integer(value) + if(all(value == d)) + return(x) + r <- .M2gen(x) + r@Dim <- value + if(length(r@factors)) + r@factors <- list() + r + }) + +setMethod("dim<-", signature(x = "sparseMatrix"), + function(x, value) { + if(is.character(s <- validDimGetsValue(value, prod(d <- x@Dim)))) + stop(s, domain = NA) + value <- as.integer(value) + if(all(value == d)) + return(x) + r <- spV2M(.M2V(x), nrow = value[1L], ncol = value[2L]) + switch(.M.repr(x), "C" = .M2C(r), "R" = .M2R(r), r) + }) + +setMethod("dim<-", signature(x = "sparseVector"), + function(x, value) { + if(is.character(s <- validDimGetsValue(value, length(x)))) + stop(s, domain = NA) + value <- as.integer(value) + spV2M(x, nrow = value[1L], ncol = value[2L]) + }) + + +## METHODS FOR GENERIC: length +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("length", "Matrix", + function(x) + if((r <- prod(x@Dim)) > .Machine$integer.max) + r + else as.integer(r)) + +setMethod("length", "MatrixFactorization", + function(x) + if((r <- prod(x@Dim)) > .Machine$integer.max) + r + else as.integer(r)) + +setMethod("length", "sparseVector", + function(x) + if(is.integer(r <- x@length)) + r + else if(r - 1 <= .Machine$integer.max) + as.integer(r) + else trunc(r)) + + +## METHODS FOR GENERIC: dimnames +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("dimnames", signature(x = "Matrix"), + function(x) x@Dimnames) + +setMethod("dimnames", signature(x = "symmetricMatrix"), + function(x) symDN(x@Dimnames)) + +setMethod("dimnames", signature(x = "MatrixFactorization"), + function(x) x@Dimnames) + + +## METHODS FOR GENERIC: dimnames<- +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("dimnames<-", signature(x = "Matrix", value = "NULL"), + function(x, value) { + x@Dimnames <- list(NULL, NULL) + x + }) + +setMethod("dimnames<-", signature(x = "compMatrix", value = "NULL"), + function(x, value) { + if(length(x@factors)) + x@factors <- list() + x@Dimnames <- list(NULL, NULL) + x + }) + +setMethod("dimnames<-", signature(x = "MatrixFactorization", value = "NULL"), + function(x, value) { + x@Dimnames <- list(NULL, NULL) + x + }) + +setMethod("dimnames<-", signature(x = "Matrix", value = "list"), + function(x, value) { + x@Dimnames <- fixupDN.if.valid(value, x@Dim) + x + }) + +setMethod("dimnames<-", signature(x = "compMatrix", value = "list"), + function(x, value) { + if(length(x@factors)) + x@factors <- list() + x@Dimnames <- fixupDN.if.valid(value, x@Dim) + x + }) + +setMethod("dimnames<-", signature(x = "MatrixFactorization", value = "list"), + function(x, value) { + x@Dimnames <- fixupDN.if.valid(value, x@Dim) + x + }) + + +## METHODS FOR GENERIC: unname +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("unname", signature(obj = "Matrix"), + function(obj, force = FALSE) { + obj@Dimnames <- list(NULL, NULL) + obj + }) + +setMethod("unname", signature(obj = "MatrixFactorization"), + function(obj, force = FALSE) { + obj@Dimnames <- list(NULL, NULL) + obj + }) + + +## METHODS FOR GENERIC: drop +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("drop", signature(x = "Matrix"), + function(x) if(any(x@Dim == 1L)) drop(.M2m(x)) else x) diff -Nru rmatrix-1.6-1.1/R/dpoMatrix.R rmatrix-1.6-5/R/dpoMatrix.R --- rmatrix-1.6-1.1/R/dpoMatrix.R 2023-06-24 19:54:25.000000000 +0000 +++ rmatrix-1.6-5/R/dpoMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ -## METHODS FOR CLASS: dpoMatrix -## dense (unpacked) symmetric positive semidefinite matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## ~~~~ COERCIONS TO ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.dsy2dpo <- function(from) { - if(is.null(tryCatch(Cholesky(from, perm = FALSE), - error = function(e) NULL))) - stop("not a positive definite matrix (and positive semidefiniteness is not checked)") - ## FIXME: check=FALSE - copyClass(from, "dpoMatrix", - sNames = c("Dim", "Dimnames", "uplo", "x", "factors")) -} - -setAs("dsyMatrix", "dpoMatrix", .dsy2dpo) - -setAs("dspMatrix", "dpoMatrix", - function(from) unpack(.dsp2dpp(from))) - -setAs("matrix", "dpoMatrix", - function(from) { - storage.mode(from) <- "double" - .dsy2dpo(.M2sym(from)) - }) - -setAs("Matrix", "dpoMatrix", - function(from) { - ## still needs as(, "dpoMatrix") to work - as(as(as(as(from,"dMatrix"),"symmetricMatrix"),"unpackedMatrix"), - "dpoMatrix") - }) - - -## ~~~~ COERCIONS FROM ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setAs("dpoMatrix", "dppMatrix", function(from) pack(from)) diff -Nru rmatrix-1.6-1.1/R/dppMatrix.R rmatrix-1.6-5/R/dppMatrix.R --- rmatrix-1.6-1.1/R/dppMatrix.R 2023-06-24 19:54:25.000000000 +0000 +++ rmatrix-1.6-5/R/dppMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ -## METHODS FOR CLASS: dppMatrix -## dense (packed) symmetric positive semidefinite matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## ~~~~ COERCIONS TO ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.dsp2dpp <- function(from) { - if(is.null(tryCatch(Cholesky(from, perm = FALSE), - error = function(e) NULL))) - stop("not a positive definite matrix (and positive semidefiniteness is not checked)") - ## FIXME: check=FALSE - copyClass(from, "dppMatrix", - sNames = c("Dim", "Dimnames", "uplo", "x", "factors")) -} - -setAs("dspMatrix", "dppMatrix", .dsp2dpp) - -setAs("dsyMatrix", "dppMatrix", - function(from) pack(.dsy2dpo(from))) - -setAs("matrix", "dppMatrix", - function(from) { - storage.mode(from) <- "double" - .dsp2dpp(pack(from, symmetric = TRUE)) - }) - -setAs("Matrix", "dppMatrix", - function(from) { - ## still needs as(, "dppMatrix") to work - as(as(as(as(from,"dMatrix"),"symmetricMatrix"),"packedMatrix"), - "dppMatrix") - }) - - -## ~~~~ COERCIONS FROM ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setAs("dppMatrix", "dpoMatrix", function(from) unpack(from)) diff -Nru rmatrix-1.6-1.1/R/eigen.R rmatrix-1.6-5/R/eigen.R --- rmatrix-1.6-1.1/R/eigen.R 2023-07-30 19:36:55.000000000 +0000 +++ rmatrix-1.6-5/R/eigen.R 2023-09-22 19:22:19.000000000 +0000 @@ -4,18 +4,18 @@ setMethod("Schur", signature(x = "dgeMatrix"), function(x, vectors = TRUE, ...) { if(length(x.x <- x@x) && !all(is.finite(range(x.x)))) - stop("'x' has non-finite values") + stop(gettextf("'%s' has non-finite values", "x"), domain = NA) cl <- .Call(dgeMatrix_Schur, x, vectors, TRUE) if(all(cl$WI == 0)) { vals <- cl$WR T <- triu(cl$T) } else { vals <- complex(real = cl$WR, imaginary = cl$WI) - T <- .m2dense(cl$T, ".ge") + T <- .m2dense(cl$T, ",ge") } if(vectors) new("Schur", Dim = x@Dim, Dimnames = x@Dimnames, - Q = .m2dense(cl$Z, ".ge"), T = T, EValues = vals) + Q = .m2dense(cl$Z, ",ge"), T = T, EValues = vals) else list(T = T, EValues = vals) }) @@ -25,19 +25,18 @@ vals <- as.double(e$values) T <- new("ddiMatrix", Dim = x@Dim, x = vals) if(vectors) - new("Schur", Dim = x@Dim, Dimnames = symmDN(x@Dimnames), - Q = .m2dense(e$vectors, ".ge"), T = T, EValues = vals) + new("Schur", Dim = x@Dim, Dimnames = symDN(x@Dimnames), + Q = .m2dense(e$vectors, ",ge"), T = T, EValues = vals) else list(T = T, EValues = vals) }) setMethod("Schur", signature(x = "matrix"), function(x, vectors = TRUE, ...) { - ## MJ: breaks package 'control' ?! - ## if(is.complex(x)) - ## stop("Schur(x) not yet supported for 'x' of type \"complex\"") + ## FIXME: wrong for complex, but package 'control' seems to + ## rely on the complex->double coercion (!?) storage.mode(x) <- "double" if(length(x) && !all(is.finite(range(x)))) - stop("'x' has non-finite values") + stop(gettextf("'%s' has non-finite values", "x"), domain = NA) cl <- .Call(dgeMatrix_Schur, x, vectors, FALSE) vals <- if(all(cl$WI == 0)) @@ -51,39 +50,21 @@ ## FIXME: don't coerce from sparse to dense setMethod("Schur", signature(x = "generalMatrix"), function(x, vectors = TRUE, ...) - Schur(as(as(x, "dMatrix"), "unpackedMatrix"), vectors, ...)) + Schur(.M2unpacked(.M2kind(x, ",")), vectors, ...)) ## FIXME: don't coerce from sparse to dense setMethod("Schur", signature(x = "symmetricMatrix"), function(x, vectors = TRUE, ...) - Schur(as(as(x, "dMatrix"), "unpackedMatrix"), vectors, ...)) - -setMethod("Schur", signature(x = "diagonalMatrix"), - function(x, vectors = TRUE, ...) { - d <- x@Dim - if(x@diag != "N") { - vals <- rep.int(1, d[1L]) - T <- new("ddiMatrix", Dim = d, diag = "U") - } else { - vals <- x@x - if(length(vals) && !all(is.finite(range(vals)))) - stop("'x' has non-finite values") - T <- new("ddiMatrix", Dim = d, x = vals) - } - if(vectors) { - Q <- new("ddiMatrix", Dim = d, diag = "U") - new("Schur", Dim = d, Dimnames = x@Dimnames, - Q = Q, T = T, EValues = vals) - } else list(T = T, EValues = vals) - }) + Schur(.M2unpacked(.M2kind(x, ",")), vectors, ...)) setMethod("Schur", signature(x = "triangularMatrix"), function(x, vectors = TRUE, ...) { + x <- .M2kind(x, ",") n <- (d <- x@Dim)[1L] if(n == 0L) x@uplo <- "U" else if(.M.kind(x) != "n" && !all(is.finite(range(x)))) - stop("'x' has non-finite values") + stop(gettextf("'%s' has non-finite values", "x"), domain = NA) vals <- diag(x, names = FALSE) if(x@uplo == "U") { if(vectors) { @@ -103,6 +84,26 @@ } }) +setMethod("Schur", signature(x = "diagonalMatrix"), + function(x, vectors = TRUE, ...) { + x <- .M2kind(x, ",") + d <- x@Dim + if(x@diag != "N") { + vals <- rep.int(1, d[1L]) + T <- new("ddiMatrix", Dim = d, diag = "U") + } else { + vals <- x@x + if(length(vals) && !all(is.finite(range(vals)))) + stop(gettextf("'%s' has non-finite values", "x"), domain = NA) + T <- new("ddiMatrix", Dim = d, x = vals) + } + if(vectors) { + Q <- new("ddiMatrix", Dim = d, diag = "U") + new("Schur", Dim = d, Dimnames = x@Dimnames, + Q = Q, T = T, EValues = vals) + } else list(T = T, EValues = vals) + }) + ## METHODS FOR CLASS: Schur ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -110,7 +111,9 @@ setMethod("expand1", signature(x = "Schur"), function(x, which, ...) switch(which, "Q" = x@Q, "T" = x@T, "Q." = t(x@Q), - stop("'which' is not \"Q\", \"T\", or \"Q.\""))) + stop(gettextf("'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"", + "which", "Q", "T"), + domain = NA))) setMethod("expand2", signature(x = "Schur"), function(x, ...) { diff -Nru rmatrix-1.6-1.1/R/expm.R rmatrix-1.6-5/R/expm.R --- rmatrix-1.6-1.1/R/expm.R 2023-07-30 20:16:33.000000000 +0000 +++ rmatrix-1.6-5/R/expm.R 2023-10-16 18:09:25.000000000 +0000 @@ -9,7 +9,7 @@ d <- x@Dim if(d[1L] != d[2L]) stop("matrix is not square") - expm(as(x, "dMatrix")) + expm(.M2kind(x, "d")) }) setMethod("expm", signature(x = "dsparseMatrix"), @@ -21,43 +21,43 @@ }) setMethod("expm", signature(x = "ddiMatrix"), - function(x) { - if(x@diag == "N") { - x@x <- exp(x@x) - } else { - x@diag <- "N" - x@x <- rep.int(exp(1), x@Dim[1L]) - } - x - }) + function(x) { + if(x@diag == "N") { + x@x <- exp(x@x) + } else { + x@diag <- "N" + x@x <- rep.int(exp(1), x@Dim[1L]) + } + x + }) setMethod("expm", signature(x = "dgeMatrix"), - function(x) .Call(dgeMatrix_exp, x)) + function(x) .Call(dgeMatrix_exp, x)) setMethod("expm", signature(x = "dtrMatrix"), - function(x) { + function(x) { r <- .Call(dgeMatrix_exp, .M2gen(x)) if(x@uplo == "U") triu(r) else tril(r) }) setMethod("expm", signature(x = "dtpMatrix"), - function(x) { + function(x) { r <- .Call(dgeMatrix_exp, .M2gen(x)) ## Pack without checking: - .Call(R_dense_as_packed, x, x@uplo, "N") + .Call(R_dense_as_packed, r, x@uplo, "N") }) setMethod("expm", signature(x = "dsyMatrix"), - function(x) { + function(x) { r <- .Call(dgeMatrix_exp, .M2gen(x)) forceSymmetric(r) }) setMethod("expm", signature(x = "dspMatrix"), - function(x) { + function(x) { r <- .Call(dgeMatrix_exp, .M2gen(x)) ## Pack without checking: - .Call(R_dense_as_packed, x, x@uplo, "") + .Call(R_dense_as_packed, r, x@uplo, NULL) }) ## Until R supports it: diff -Nru rmatrix-1.6-1.1/R/graph-conv.R rmatrix-1.6-5/R/graph-conv.R --- rmatrix-1.6-1.1/R/graph-conv.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/graph-conv.R 2023-08-30 06:03:42.000000000 +0000 @@ -90,7 +90,7 @@ } } -T2graph <- function(from, need.uniq = is_not_uniqT(from), edgemode = NULL) +T2graph <- function(from, need.uniq = !isUniqueT(from), edgemode = NULL) { d <- dim(from) if((n <- d[1L]) != d[2L]) @@ -100,7 +100,7 @@ if(is.null(rn <- dimnames(from)[[1]])) rn <- as.character(1:n) if(need.uniq) ## Need to 'uniquify' the triplets! - from <- uniqTsparse(from) + from <- .M2T(.M2C(from)) if(is.null(edgemode)) edgemode <- @@ -139,15 +139,15 @@ function(from) graph2T(from)) setAs("graph", "CsparseMatrix", - function(from) .M2C(as(from, "TsparseMatrix"))) + function(from) .M2C(graph2T(as(from, "graphNEL")))) setAs("graph", "RsparseMatrix", - function(from) .M2R(as(from, "TsparseMatrix"))) + function(from) .M2R(graph2T(as(from, "graphNEL")))) setAs("graph", "TsparseMatrix", - function(from) graph2T(as(from, "graphNEL"))) + function(from) graph2T(as(from, "graphNEL")) ) setAs("graph", "sparseMatrix", - function(from) as(from, "CsparseMatrix")) + function(from) .M2C(graph2T(as(from, "graphNEL")))) setAs("graph", "Matrix", - function(from) as(from, "CsparseMatrix")) + function(from) .M2C(graph2T(as(from, "graphNEL")))) ## ~~~~ COERCIONS FROM Matrix TO graph ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -156,8 +156,8 @@ ## for Matrix can assume that 'from' is _not_ a TsparseMatrix, ## and therefore expect that as(from, "TsparseMatrix") is "unique" setAs("TsparseMatrix", "graphNEL", - function(from) T2graph(from)) + function(from) T2graph( from )) setAs("Matrix", "graphNEL", - function(from) T2graph(as(from, "TsparseMatrix"), need.uniq = FALSE)) + function(from) T2graph(.M2T(from), need.uniq = FALSE)) setAs("Matrix", "graph", - function(from) as(from, "graphNEL")) + function(from) T2graph(.M2T(from), need.uniq = FALSE)) diff -Nru rmatrix-1.6-1.1/R/image.R rmatrix-1.6-5/R/image.R --- rmatrix-1.6-1.1/R/image.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/image.R 2023-09-22 19:22:19.000000000 +0000 @@ -110,7 +110,7 @@ else if(p1 > 3) 0.5 else 0.2 ## browser() - Matrix.msg("rectangle size ", + Matrix.message("rectangle size ", paste(round(pSize, 1L), collapse = " x "), " [pixels]; --> lwd :", formatC(lwd)) } else stopifnot(is.numeric(lwd), all(lwd >= 0)) # allow 0 @@ -143,8 +143,13 @@ setMethod("image", "dgTMatrix", .image.dgT) setMethod("image", "Matrix", - function(x, ...) - image(.M2kind(.M2gen(.M2T(x)), "d"), ...)) + function(x, ...) { + if(.M.kind(x) == "z") + stop(gettextf("%s(<%s>) is not yet implemented", + "image", "zMatrix"), + domain = NA) + image(.M2kind(.M2gen(.M2T(x)), "d"), ...) + }) setMethod("image", "CHMfactor", function(x, ...) diff -Nru rmatrix-1.6-1.1/R/indMatrix.R rmatrix-1.6-5/R/indMatrix.R --- rmatrix-1.6-1.1/R/indMatrix.R 2023-07-30 19:36:55.000000000 +0000 +++ rmatrix-1.6-5/R/indMatrix.R 2023-12-11 01:46:59.000000000 +0000 @@ -3,67 +3,66 @@ ## for all rows _or_ all columns ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.perm2ind <- function(perm, n, margin = 1L, check.p = FALSE) { - perm.i <- perm - if(!is.numeric(perm)) - stop("'perm' must be numeric") - else if(anyNA(r <- range(perm)) || r[1L] < 1L || - (is.double(perm) && any(perm != (perm.i <- as.integer(perm))))) - stop("elements of 'perm' must be positive integers") - else if((m.i <- length(perm)) > (M <- .Machine$integer.max) || r[2L] > M) - stop("dimensions cannot exceed 2^31-1") - - if(missing(n)) - n.i <- as.integer(r[2L]) - else { - n.i <- n - if(!is.numeric(n) || length(n) != 1L || is.na(n) || n < 0L || - (is.double(n) && n != (n.i <- as.integer(n)))) - stop("'n' must be a non-negative integer") - else if(n > M) - stop("dimensions cannot exceed 2^31-1") - else if(r[2L] > n) - stop("elements of 'perm' cannot exceed 'n'") - } +.perm2ind <- function(perm, n, margin = 1L, check.p = 0L) { + if(mode(perm) != "numeric") + stop(gettextf("'%s' is not of type \"%s\" or \"%s\"", + "perm", "integer", "double"), + domain = NA) + else if((m <- length(perm)) == 0L) + perm <- integer(0L) + else if(anyNA(r <- range(perm))) + stop(gettextf("'%s' contains NA", "perm"), + domain = NA) + else if(r[1L] < 1L) + stop(gettextf("'%s' has elements less than %d", "perm", 1L), + domain = NA) + else if(m > .Machine$integer.max || + (is.double(perm) && trunc(r[2L]) > .Machine$integer.max)) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + else { perm <- as.integer(perm); r <- as.integer(r) } + + if(m.n <- missing(n)) + n <- if(m == 0L) 0L else r[2L] + else if(mode(n) != "numeric" || length(n) != 1L || is.na(n) || n < 0L) + stop(gettextf("'%s' is not a non-negative number", "n"), + domain = NA) + else if(is.double(n) && trunc(n) > .Machine$integer.max) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + else if(r[2L] > as.integer(n)) + stop(gettextf("'%s' has elements exceeding '%s'", "perm", "n"), + domain = NA) + else n <- as.integer(n) - if(!is.numeric(margin) || length(margin) != 1L || is.na(margin) || + if(mode(margin) != "numeric" || length(margin) != 1L || is.na(margin) || (margin != 1L && margin != 2L)) - stop("'margin' must be 1 or 2") - margin.i <- as.integer(margin) + stop(gettextf("'%s' is not %d or %d", "margin", 1L, 2L), + domain = NA) - give.p <- check.p && m.i == n.i && - (m.i == 0L || (all(r == c(1L, m.i)) && !anyDuplicated.default(perm.i))) + give.p <- check.p >= 1L && m == n && + (m == 0L || (all(r == c(1L, m)) && !anyDuplicated.default(perm))) + if(check.p >= 2L && !give.p) + stop(gettextf("'%s' is not a permutation of seq_len(%s)", + "perm", if(m.n) "max(perm, 0)" else "n"), + domain = NA) J <- new(if(give.p) "pMatrix" else "indMatrix") nms <- names(perm) - if(margin.i == 1L) { - J@Dim <- c(m.i, n.i) + if(margin == 1L) { + J@Dim <- c(m, n) J@Dimnames = list(nms, if(give.p) nms) } else { - J@Dim <- c(n.i, m.i) + J@Dim <- c(n, m) J@Dimnames = list(if(give.p) nms, nms) J@margin <- 2L } - J@perm <- perm.i + J@perm <- perm J } setAs("numeric", "indMatrix", - function(from) { - J <- new("indMatrix") - if((m <- length(from)) == 0L) - return(J) - from.i <- from - if(anyNA(r <- range(from)) || r[1L] < 1L || - (is.double(from) && any(from != (from.i <- as.integer(from))))) - stop("elements of 'perm' slot must be positive integers") - if(m > (M <- .Machine$integer.max) || r[2L] > M) - stop("dimensions cannot exceed 2^31-1") - J@Dim <- c(m, as.integer(r[2L])) - J@Dimnames <- list(names(from), NULL) - J@perm <- from.i - J - }) + function(from) .perm2ind(from)) ## FIXME: deprecate this method and export more general function .perm2ind setAs("list", "indMatrix", @@ -75,14 +74,14 @@ J <- new("indMatrix") J@Dim <- from@Dim J@Dimnames <- from@Dimnames - from. <- as(from, "RsparseMatrix") + from. <- .M2R(from) p <- from.@p m <- length(p) - 1L if(all(p == 0:m)) { J@perm <- from.@j + 1L return(J) } - from. <- as(from, "CsparseMatrix") + from. <- .M2C(from) p <- from.@p n <- length(p) - 1L if(all(p == 0:n)) { @@ -90,66 +89,17 @@ J@margin <- 2L return(J) } - stop("matrix must have exactly one nonzero element in each row or column") + stop("matrix must have exactly one entry in each row or column") }) -setMethod("isSymmetric", signature(object = "indMatrix"), - function(object, checkDN = TRUE, ...) { - d <- object@Dim - if((n <- d[1L]) != d[2L]) - return(FALSE) - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - if(ca(...) && !isSymmetricDN(object@Dimnames)) - return(FALSE) - } - perm <- object@perm - all(perm[perm] == seq_len(n)) - }) - -setMethod("isTriangular", signature(object = "indMatrix"), - function(object, upper = NA, ...) { - d <- object@Dim - if((n <- d[1L]) != d[2L]) - return(FALSE) - if(object@margin == 1L) { - i <- seq_len(n) - j <- object@perm - } else { - i <- object@perm - j <- seq_len(n) - } - if(is.na(upper)) { - if(all(j >= i)) - return(`attr<-`(TRUE, "kind", "U")) - if(all(i <= j)) - return(`attr<-`(TRUE, "kind", "L")) - FALSE - } else if(upper) { - all(j >= i) - } else { - all(i <= j) - } - }) +setMethod("band", signature(x = "indMatrix"), + function(x, k1, k2, ...) band(.M2kind(x, "n"), k1, k2, ...)) -setMethod("isDiagonal", signature(object = "indMatrix"), - function(object) { - d <- object@Dim - if((n <- d[1L]) != d[2L]) - return(FALSE) - all(object@perm == seq_len(n)) - }) +setMethod("triu", signature(x = "indMatrix"), + function(x, k = 0L, ...) triu(.M2kind(x, "n"), k, ...)) -setMethod("t", signature(x = "indMatrix"), - function(x) { - r <- new("indMatrix") - r@Dim <- x@Dim[2:1] - r@Dimnames = x@Dimnames[2:1] - r@perm <- x@perm - if(x@margin == 1L) - r@margin <- 2L - r - }) +setMethod("tril", signature(x = "indMatrix"), + function(x, k = 0L, ...) tril(.M2kind(x, "n"), k, ...)) setMethod("diag", signature(x = "indMatrix"), function(x, nrow, ncol, names = TRUE) { @@ -165,281 +115,134 @@ }) setMethod("diag<-", signature(x = "indMatrix"), - function(x, value) `diag<-`(as(x, "nsparseMatrix"), value)) - -setMethod("band", signature(x = "indMatrix"), - function(x, k1, k2, ...) band(as(x, "nsparseMatrix"), k1, k2)) - -setMethod("triu", signature(x = "indMatrix"), - function(x, k = 0L, ...) triu(as(x, "nsparseMatrix"))) + function(x, value) `diag<-`(.M2kind(x, "n"), value)) -setMethod("tril", signature(x = "indMatrix"), - function(x, k = 0L, ...) tril(as(x, "nsparseMatrix"))) +setMethod("t", signature(x = "indMatrix"), + function(x) { + r <- new("indMatrix") + r@Dim <- x@Dim[2:1] + r@Dimnames = x@Dimnames[2:1] + r@perm <- x@perm + if(x@margin == 1L) + r@margin <- 2L + r + }) setMethod("forceSymmetric", signature(x = "indMatrix", uplo = "missing"), - function(x, uplo) forceSymmetric(as(x, "nsparseMatrix"))) + function(x, uplo) forceSymmetric(.M2kind(x, "n"))) setMethod("forceSymmetric", signature(x = "indMatrix", uplo = "character"), - function(x, uplo) forceSymmetric(as(x, "nsparseMatrix"), uplo)) + function(x, uplo) forceSymmetric(.M2kind(x, "n"), uplo)) setMethod("symmpart", signature(x = "indMatrix"), - function(x) symmpart(as(x, "dsparseMatrix"))) + function(x) symmpart(.M2kind(x, "d"))) setMethod("skewpart", signature(x = "indMatrix"), - function(x) skewpart(as(x, "dsparseMatrix"))) - -setMethod("%*%", signature(x = "indMatrix", y = "indMatrix"), - function(x, y) { - mx <- x@margin - my <- y@margin - px <- x@perm - py <- y@perm - r <- new(if(mx == my) - "indMatrix" - else if(mx == 1L) - "dgeMatrix" - else "dgTMatrix") - r@Dim <- mmultDim(x@Dim, y@Dim, type = 1L) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - if(mx == my) - r@perm <- if(mx == 1L) py[px] else { r@margin <- 2L; px[py] } - else if(mx == 1L) - r@x <- as.double(px == rep(py, each = length(px))) - else { - r@i <- px - 1L - r@j <- py - 1L - r@x <- rep.int(1, length(px)) - } - r - }) - -setMethod("%*%", signature(x = "indMatrix", y = "matrix"), - function(x, y) { - if(x@margin != 1L) - return(as(x, "dsparseMatrix") %*% y) - mmultDim(x@Dim, dim(y), type = 1L) - r <- .m2dense(y[x@perm, , drop = FALSE], "dge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%*%", signature(x = "matrix", y = "indMatrix"), - function(x, y) { - if(y@margin == 1L) - return(x %*% as(y, "dsparseMatrix")) - mmultDim(dim(x), y@Dim, type = 1L) - r <- .m2dense(x[, y@perm, drop = FALSE], "dge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%*%", signature(x = "indMatrix", y = "Matrix"), - function(x, y) { - if(x@margin != 1L) - return(as(x, "dsparseMatrix") %*% y) - mmultDim(x@Dim, y@Dim, type = 1L) - r <- as(y[x@perm, , drop = FALSE], "dMatrix") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%*%", signature(x = "Matrix", y = "indMatrix"), - function(x, y) { - if(y@margin == 1L) - return(x %*% as(y, "dsparseMatrix")) - mmultDim(x@Dim, y@Dim, type = 1L) - r <- as(x[, y@perm, drop = FALSE], "dMatrix") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) + function(x) skewpart(.M2kind(x, "d"))) -setMethod("%&%", signature(x = "indMatrix", y = "indMatrix"), - function(x, y) { - mx <- x@margin - my <- y@margin - px <- x@perm - py <- y@perm - r <- new(if(mx == my) - "indMatrix" - else if(mx == 1L) - "ngeMatrix" - else "ngTMatrix") - r@Dim <- mmultDim(x@Dim, y@Dim, type = 1L) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - if(mx == my) - r@perm <- if(mx == 1L) py[px] else { r@margin <- 2L; px[py] } - else if(mx == 1L) - r@x <- px == rep(py, each = length(px)) - else { - r@i <- px - 1L - r@j <- py - 1L - } - r - }) - -setMethod("%&%", signature(x = "indMatrix", y = "matrix"), - function(x, y) { - if(x@margin != 1L) - return(as(x, "nsparseMatrix") %&% y) - mmultDim(x@Dim, dim(y), type = 1L) - r <- .m2dense(y[x@perm, , drop = FALSE], "nge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "matrix", y = "indMatrix"), - function(x, y) { - if(y@margin == 1L) - return(x %&% as(y, "nsparseMatrix")) - mmultDim(dim(x), y@Dim, type = 1L) - r <- .m2dense(x[, y@perm, drop = FALSE], "nge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "indMatrix", y = "Matrix"), - function(x, y) { - if(x@margin != 1L) - return(as(x, "nsparseMatrix") %&% y) - mmultDim(x@Dim, y@Dim, type = 1L) - r <- as(y[x@perm, , drop = FALSE], "nMatrix") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "Matrix", y = "indMatrix"), - function(x, y) { - if(y@margin == 1L) - return(x %&% as(y, "nsparseMatrix")) - mmultDim(x@Dim, y@Dim, type = 1L) - r <- as(x[, y@perm, drop = FALSE], "nMatrix") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r +setMethod("isDiagonal", signature(object = "indMatrix"), + function(object) { + d <- object@Dim + if((n <- d[2L]) != d[1L]) + return(FALSE) + all(object@perm == seq_len(n)) }) -setMethod("crossprod", signature(x = "indMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) { - if(x@margin != 1L) - return(tcrossprod(t(x), boolArith = boolArith, ...)) - n <- x@Dim[2L] - tt <- tabulate(x@perm, n) - if(isTRUE(boolArith)) { - r <- new("ldiMatrix") - r@x <- as.logical(tt) +setMethod("isTriangular", signature(object = "indMatrix"), + function(object, upper = NA, ...) { + d <- object@Dim + if((n <- d[2L]) != d[1L]) + return(FALSE) + if(object@margin == 1L) { + i <- seq_len(n) + j <- object@perm } else { - r <- new("ddiMatrix") - r@x <- as.double(tt) + i <- object@perm + j <- seq_len(n) } - r@Dim <- c(n, n) - r@Dimnames <- x@Dimnames[c(2L, 2L)] - r - }) - -setMethod("crossprod", signature(x = "indMatrix", y = "matrix"), - function(x, y = NULL, boolArith = NA, ...) - (if(isTRUE(boolArith)) `%&%` else `%*%`)(t(x), y)) - -setMethod("crossprod", signature(x = "matrix", y = "indMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(dim(x), y@Dim, type = 2L) - boolArith <- isTRUE(boolArith) - if(y@margin == 1L) { - cl <- if(boolArith) "nsparseMatrix" else "dsparseMatrix" - r <- crossprod(x, as(y, cl), boolArith = boolArith, ...) + if(is.na(upper)) { + if(all(j >= i)) + return(`attr<-`(TRUE, "kind", "U")) + if(all(i <= j)) + return(`attr<-`(TRUE, "kind", "L")) + FALSE + } else if(upper) { + all(j >= i) } else { - r <- .m2dense(t(x)[, y@perm, drop = FALSE], - if(boolArith) "nge" else "dge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, - type = 2L) + all(i <= j) } - r }) -setMethod("crossprod", signature(x = "indMatrix", y = "Matrix"), - function(x, y = NULL, boolArith = NA, ...) - (if(isTRUE(boolArith)) `%&%` else `%*%`)(t(x), y)) - -setMethod("crossprod", signature(x = "Matrix", y = "indMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - boolArith <- isTRUE(boolArith) - if(y@margin == 1L) { - cl <- if(boolArith) "nsparseMatrix" else "dsparseMatrix" - r <- crossprod(x, as(y, cl), boolArith = boolArith, ...) - } else { - cl <- if(boolArith) "nMatrix" else "dMatrix" - r <- as(t(x)[, y@perm, drop = FALSE], cl) - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, - type = 2L) +setMethod("isSymmetric", signature(object = "indMatrix"), + function(object, checkDN = TRUE, ...) { + d <- object@Dim + if((n <- d[2L]) != d[1L]) + return(FALSE) + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) check.attributes + if(ca(...) && !isSymmetricDN(object@Dimnames)) + return(FALSE) } - r + perm <- object@perm + all(perm[perm] == seq_len(n)) }) -setMethod("tcrossprod", signature(x = "indMatrix", y = "missing"), - function(x, y = NULL, boolArith = TRUE, ...) { - if(x@margin != 1L) - return(crossprod(t(x), boolArith = boolArith, ...)) - if(isTRUE(boolArith)) { - r <- new("ngeMatrix") - r@x <- as.vector( - `storage.mode<-`(as(x, "matrix"), "logical")[, x@perm]) - } else { - r <- new("dgeMatrix") - r@x <- as.vector( - `storage.mode<-`(as(x, "matrix"), "double")[, x@perm]) - } - r@Dim <- x@Dim[c(1L, 1L)] - r@Dimnames <- x@Dimnames[c(1L, 1L)] - r - }) -setMethod("tcrossprod", signature(x = "indMatrix", y = "matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, dim(y), type = 3L) - boolArith <- isTRUE(boolArith) - if(y@margin == 1L) { - r <- .m2dense(t(y)[x@perm, , drop = FALSE], - if(boolArith) "nge" else "dge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), - type = 3L) - } else { - cl <- if(boolArith) "nsparseMatrix" else "dsparseMatrix" - r <- tcrossprod(as(x, cl), y, boolArith = boolArith, ...) - } - r - }) -setMethod("tcrossprod", signature(x = "matrix", y = "indMatrix"), - function(x, y = NULL, boolArith = NA, ...) - (if(isTRUE(boolArith)) `%&%` else `%*%`)(x, t(y))) - -setMethod("tcrossprod", signature(x = "indMatrix", y = "Matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - boolArith <- isTRUE(boolArith) - if(y@margin == 1L) { - cl <- if(boolArith) "nMatrix" else "dMatrix" - r <- as(t(y)[x@perm, , drop = FALSE], cl) - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), - type = 3L) - } else { - cl <- if(boolArith) "nsparseMatrix" else "dsparseMatrix" - r <- tcrossprod(as(x, cl), y, boolArith = boolArith, ...) - } - r - }) +## METHODS FOR CLASS: pMatrix +## permutation matrices, i.e., matrices with standard unit vectors +## for all rows _and_ all columns +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("tcrossprod", signature(x = "Matrix", y = "indMatrix"), - function(x, y = NULL, boolArith = NA, ...) - (if(isTRUE(boolArith)) `%&%` else `%*%`)(x, t(y))) +## MJ: could export without dot +.changeMargin <- function(x) { + x@margin <- if(x@margin == 1L) 2L else 1L + x@perm <- invertPerm(x@perm) + x +} +setAs("numeric", "pMatrix", + function(from) .perm2ind(from, check.p = 2L)) -.indMatrix.sub <- function(x, i, j, ..., value) { - x <- as(x, "TsparseMatrix") - callGeneric() -} -for (.i in c("missing", "index")) -for (.j in c("missing", "index")) -setReplaceMethod("[", signature(x = "indMatrix", i = .i, j = .j, value = "ANY"), - .indMatrix.sub) -rm(.indMatrix.sub, .i, .j) +setAs("nsparseMatrix", "pMatrix", + function(from) { + d <- from@Dim + if((n <- d[1L]) != d[2L]) + stop(gettextf("attempt to coerce non-square matrix to %s", + "pMatrix"), + domain = NA) + from <- .M2gen(from) + J <- new("pMatrix") + J@Dim <- d + J@Dimnames <- from@Dimnames + from. <- .M2R(from) + p <- from.@p + m <- length(p) - 1L + if(all(p == 0:m) && !anyDuplicated.default(j <- from.@j)) { + J@perm <- j + 1L + return(J) + } + from. <- .M2C(from) + p <- from.@p + n <- length(p) - 1L + if(all(p == 0:n) && !anyDuplicated.default(i <- from.@i)) { + J@perm <- i + 1L + J@margin <- 2L + return(J) + } + stop("matrix must have exactly one entry in each row and column") + }) + +setAs("indMatrix", "pMatrix", + function(from) new("pMatrix", from)) + +setMethod("t", signature(x = "pMatrix"), + function(x) { + r <- new("pMatrix") + r@Dim <- x@Dim + r@Dimnames = x@Dimnames[2:1] + r@perm <- x@perm + if(x@margin == 1L) + r@margin <- 2L + r + }) diff -Nru rmatrix-1.6-1.1/R/is.na.R rmatrix-1.6-5/R/is.na.R --- rmatrix-1.6-1.1/R/is.na.R 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/R/is.na.R 2023-10-11 13:25:02.000000000 +0000 @@ -1,491 +1,382 @@ ## METHODS FOR GENERIC: anyNA ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("anyNA", signature(x = "diagonalMatrix"), - function(x) anyNA(x@x)) - -setMethod("anyNA", signature(x = "indMatrix"), - function(x) FALSE) +setMethod("anyNA", signature(x = "denseMatrix"), + function(x) { + cl <- .M.nonvirtual(x) + if(substr(cl, 1L, 1L) == "n") + return(FALSE) + if((shape <- substr(cl, 2L, 2L)) == "g") + anyNA(x@x) + else { + if(shape == "t" && x@diag != "N") { + x@diag <- "N" + if(anyNA(diag(x, names = FALSE))) + diag(x) <- TRUE + } + anyNA(pack(x)@x) + } + }) -setMethod("anyNA", signature(x = "nMatrix"), - function(x) FALSE) +setMethod("anyNA", signature(x = "sparseMatrix"), + function(x) .M.kind(x) != "n" && anyNA(x@x)) -for(.kind in c("d", "l")) { -setMethod("anyNA", signature(x = paste0(.kind, "sparseMatrix")), - function(x) anyNA(x@x)) - -setMethod("anyNA", signature(x = paste0(.kind, "denseMatrix")), - function(x) { - if(!.hasSlot(x, "uplo")) - return(anyNA(x@x)) - packed <- .isPacked(x) - nonunit <- !.hasSlot(x, "diag") || x@diag == "N" - if(packed && nonunit) - return(anyNA(x@x)) - k <- indTri(n = x@Dim[1L], upper = x@uplo == "U", - diag = nonunit, packed = packed) - anyNA(x@x[k]) - }) -} -rm(.kind) +setMethod("anyNA", signature(x = "diagonalMatrix"), + function(x) .M.kind(x) != "n" && length(y <- x@x) > 0L && anyNA(y)) -setMethod("anyNA", signature(x = "nsparseVector"), +setMethod("anyNA", signature(x = "indMatrix"), function(x) FALSE) setMethod("anyNA", signature(x = "sparseVector"), - function(x) anyNA(x@x)) + function(x) .M.kind(x) != "n" && anyNA(x@x)) ## METHODS FOR GENERIC: is.na -## [[ one more in ./abIndex.R ]] ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## Returning an all-FALSE matrix preserving the structure of 'x', -## which can be any R object inheriting from Matrix -allFalseMatrix <- function(x) { - r <- new(if(.hasSlot(x, "diag")) # triangularMatrix, diagonalMatrix - "ntCMatrix" - else if(.hasSlot(x, "uplo")) # symmetricMatrix - "nsCMatrix" - else "ngCMatrix") # generalMatrix - r@Dim <- d <- x@Dim - r@Dimnames <- x@Dimnames - r@p <- integer(d[2L] + 1) - r -} - -setMethod("is.na", signature(x = "diagonalMatrix"), +setMethod("is.na", signature(x = "denseMatrix"), function(x) { - r <- new("ldiMatrix") - r@Dim <- d <- x@Dim + cl <- .M.nonvirtual(x) + never <- substr(cl, 1L, 1L) == "n" + substr(cl, 1L, 1L) <- "n" + r <- new(cl) + r@Dim <- x@Dim r@Dimnames <- x@Dimnames - r@x <- if(x@diag == "N") is.na(x@x) else logical(d[1L]) + if((shape <- substr(cl, 2L, 2L)) != "g") { + r@uplo <- x@uplo + if(!never && shape == "t" && x@diag != "N") { + x@diag <- "N" + if(anyNA(diag(x, names = FALSE))) + diag(x) <- TRUE + } + } + r@x <- if(never) + logical(length(x@x)) + else is.na(x@x) r }) -setMethod("is.na", signature(x = "indMatrix"), - allFalseMatrix) - -setMethod("is.na", signature(x = "nMatrix"), - allFalseMatrix) - -setMethod("is.na", signature(x = "dsparseMatrix"), +setMethod("is.na", signature(x = "sparseMatrix"), function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - r <- .M2kind(diagU2N(x), "l") - r@x <- is.na(r@x) + cl <- .M.nonvirtual(x) + never <- substr(cl, 1L, 1L) == "n" + substr(cl, 1L, 1L) <- if(never) "n" else "l" + r <- new(cl) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + if(substr(cl, 2L, 2L) != "g") + r@uplo <- x@uplo + if(never) { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- integer(d[2L] + 1) }, + "R" = { r@p <- integer(d[1L] + 1) }) + r + } else { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- x@p; r@i <- x@i }, + "R" = { r@p <- x@p; r@j <- x@j }, + "T" = { r@i <- x@i; r@j <- x@j }) + r@x <- is.na(x@x) .M2kind(.drop0(r), "n") - } else allFalseMatrix(x) + } }) -setMethod("is.na", signature(x = "lsparseMatrix"), +setMethod("is.na", signature(x = "diagonalMatrix"), function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - r <- diagU2N(x) - r@x <- is.na(r@x) - .M2kind(.drop0(r), "n") - } else allFalseMatrix(x) + r <- new("ndiMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- if(x@diag != "N" || .M.kind(x) == "n") + logical(d[1L]) + else is.na(x@x) + r }) -.is.na.ge <- function(x) { - if(anyNA(x@x)) # don't allocate in FALSE case - new("ngeMatrix", Dim = x@Dim, Dimnames = x@Dimnames, x = is.na(x@x)) - else allFalseMatrix(x) -} - -.is.na.tr <- function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - d <- x@Dim - i <- is.na(x@x) - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = x@diag != "N", packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("ntrMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.na.tp <- function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - d <- x@Dim - i <- is.na(x@x) - if(x@diag != "N") { - k <- indDiag(n = d[1L], upper = x@uplo == "U", - packed = TRUE) - i[k] <- FALSE - } - if(any(i)) - new("ntpMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.na.sy <- function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - d <- x@Dim - i <- is.na(x@x) - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = FALSE, packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("nsyMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.na.sp <- function(x) { - if(anyNA(x@x)) # don't allocate in FALSE case - new("nspMatrix", Dim = x@Dim, Dimnames = x@Dimnames, - x = is.na(x@x), uplo = x@uplo) - else allFalseMatrix(x) -} - -for(.kind in c("d", "l")) - for(.xx in c("ge", "tr", "tp", "sy", "sp")) - setMethod("is.na", signature(x = paste0(.kind, .xx, "Matrix")), - get(paste0(".is.na.", .xx), - mode = "function", inherits = FALSE)) -rm(.is.na.ge, .is.na.tr, .is.na.tp, - .is.na.sy, .is.na.sp, - .kind, .xx) +setMethod("is.na", signature(x = "indMatrix"), + function(x) { + m <- x@margin + r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@p <- integer(d[m] + 1) + r + }) setMethod("is.na", signature(x = "sparseVector"), - function(x) new("nsparseVector", length = x@length, - i = x@i[is.na(x@x)])) - -setMethod("is.na", signature(x = "nsparseVector"), - function(x) new("nsparseVector", length = x@length)) + function(x) { + r <- new("nsparseVector") + r@length <- x@length + if(.M.kind(x) != "n") + r@i <- x@i[is.na(x@x)] + r + }) -## METHODS FOR GENERIC: is.finite -## [[ one more in ./abIndex.R ]] +## METHODS FOR GENERIC: is.nan +## NB: mostly parallel to is.na, completely parallel to is.infinite ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -allTrueMatrix <- function(x, symmetric = NA, packed = TRUE) { - if(is.na(symmetric)) - ## TRUE for symmetricMatrix, diagonalMatrix - ## FALSE for triangularMatrix, generalMatrix - symmetric <- if(.hasSlot(x, "uplo")) - !.hasSlot(x, "diag") - else .hasSlot(x, "diag") - r <- new(if(!symmetric) - "ngeMatrix" - else if(packed) - "nspMatrix" - else "nsyMatrix") - r@Dim <- d <- x@Dim - r@Dimnames <- x@Dimnames - r@x <- rep.int(TRUE, if(symmetric && packed) { - n <- d[1L] - 0.5 * n * (n + 1) - } else prod(d)) - if(symmetric && .hasSlot(x, "uplo")) - r@uplo <- x@uplo - r -} - -..allTrueMatrix <- function(x) allTrueMatrix(x) - -setMethod("is.finite", signature(x = "diagonalMatrix"), +setMethod("is.nan", signature(x = "denseMatrix"), function(x) { - r <- allTrueMatrix(x, symmetric = TRUE, packed = TRUE) - if(x@diag == "N") { - k <- indDiag(n = x@Dim[1L], upper = r@uplo == "U", - packed = TRUE) - r@x[k] <- is.finite(x@x) + cl <- .M.nonvirtual(x) + never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE) + substr(cl, 1L, 1L) <- "n" + r <- new(cl) + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames + if((shape <- substr(cl, 2L, 2L)) != "g") { + r@uplo <- x@uplo + if(!never && shape == "t" && x@diag != "N") { + x@diag <- "N" + if(any(is.nan(diag(x, names = FALSE)))) + diag(x) <- TRUE + } } + r@x <- if(never) + logical(length(x@x)) + else is.nan(x@x) r }) -setMethod("is.finite", signature(x = "indMatrix"), - ..allTrueMatrix) - -setMethod("is.finite", signature(x = "nMatrix"), - ..allTrueMatrix) - -setMethod("is.finite", signature(x = "dsparseMatrix"), +setMethod("is.nan", signature(x = "sparseMatrix"), function(x) { - if(!all(is.finite(x@x))) { - ## FIXME: use packed=TRUE once [<- is fast for packedMatrix - r <- allTrueMatrix(x, symmetric = NA, packed = FALSE) - if(.hasSlot(x, "p")) - x <- .M2T(x) - n <- x@Dim[1L] - w <- which(!is.finite(x@x)) - r@x[as.double(n) * x@j[w] + x@i[w] + 1] <- FALSE + cl <- .M.nonvirtual(x) + never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE) + substr(cl, 1L, 1L) <- if(never) "n" else "l" + r <- new(cl) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + if(substr(cl, 2L, 2L) != "g") + r@uplo <- x@uplo + if(never) { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- integer(d[2L] + 1) }, + "R" = { r@p <- integer(d[1L] + 1) }) r - } else allTrueMatrix(x, symmetric = NA, packed = TRUE) + } else { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- x@p; r@i <- x@i }, + "R" = { r@p <- x@p; r@j <- x@j }, + "T" = { r@i <- x@i; r@j <- x@j }) + r@x <- is.nan(x@x) + .M2kind(.drop0(r), "n") + } }) -setMethod("is.finite", signature(x = "lsparseMatrix"), +setMethod("is.nan", signature(x = "diagonalMatrix"), function(x) { - if(anyNA(x@x)) { # don't allocate in FALSE case - ## FIXME: use packed=TRUE once [<- is fast for packedMatrix - r <- allTrueMatrix(x, symmetric = NA, packed = FALSE) - if(.hasSlot(x, "p")) - x <- .M2T(x) - n <- x@Dim[1L] - w <- which(is.na(x@x)) - r@x[as.double(n) * x@j[w] + x@i[w] + 1] <- FALSE - r - } else allTrueMatrix(x, symmetric = NA, packed = TRUE) + r <- new("ndiMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- if(x@diag != "N") + logical(d[1L]) + else switch(.M.kind(x), "d" = , "z" = is.nan(x@x), + logical(d[1L])) + r }) -.is.finite.ge <- function(x) - new("ngeMatrix", Dim = x@Dim, Dimnames = x@Dimnames, x = is.finite(x@x)) - -.is.finite.tr <- function(x) { - d <- x@Dim - i <- is.finite(x@x) - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = x@diag != "N", packed = FALSE) - i[k] <- TRUE - new("ngeMatrix", Dim = d, Dimnames = x@Dimnames, x = i) -} - -.is.finite.tp <- function(x) { - d <- x@Dim - i <- rep.int(TRUE, prod(d)) - k <- indTri(n = d[1L], upper = x@uplo == "U", - diag = TRUE, packed = FALSE) - i[k] <- is.finite(x@x) - if(x@diag != "N") { - k <- indDiag(n = d[1L], packed = FALSE) - i[k] <- TRUE - } - new("ngeMatrix", Dim = d, Dimnames = x@Dimnames, x = i) -} - -.is.finite.sy <- function(x) - new("nsyMatrix", Dim = x@Dim, Dimnames = x@Dimnames, - x = is.finite(x@x), uplo = x@uplo) - -.is.finite.sp <- function(x) - new("nspMatrix", Dim = x@Dim, Dimnames = x@Dimnames, - x = is.finite(x@x), uplo = x@uplo) - -for(.kind in c("d", "l")) - for(.xx in c("ge", "tr", "tp", "sy", "sp")) - setMethod("is.finite", signature(x = paste0(.kind, .xx, "Matrix")), - get(paste0(".is.finite.", .xx), - mode = "function", inherits = FALSE)) -rm(.is.finite.ge, .is.finite.tr, .is.finite.tp, - .is.finite.sy, .is.finite.sp, ..allTrueMatrix, - .kind, .xx) - -setMethod("is.finite", signature(x = "sparseVector"), - function(x) { - r <- rep.int(TRUE, x@length) - r[x@i[!is.finite(x@x)]] <- FALSE +setMethod("is.nan", signature(x = "indMatrix"), + function(x) { + m <- x@margin + r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@p <- integer(d[m] + 1) r }) -setMethod("is.finite", signature(x = "nsparseVector"), - function(x) rep.int(TRUE, x@length)) +setMethod("is.nan", signature(x = "sparseVector"), + function(x) { + r <- new("nsparseVector") + r@length <- x@length + switch(.M.kind(x), "d" = , "z" = { r@i <- x@i[is.nan(x@x)] }) + r + }) ## METHODS FOR GENERIC: is.infinite -## NB: completely (!) parallel to 'is.infinite' -## [[ one more in ./abIndex.R ]] +## NB: mostly parallel to is.na, completely parallel to is.nan ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("is.infinite", signature(x = "ddiMatrix"), +setMethod("is.infinite", signature(x = "denseMatrix"), function(x) { - r <- new("ldiMatrix") - r@Dim <- d <- x@Dim + cl <- .M.nonvirtual(x) + never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE) + substr(cl, 1L, 1L) <- "n" + r <- new(cl) + r@Dim <- x@Dim r@Dimnames <- x@Dimnames - r@x <- if(x@diag == "N") is.infinite(x@x) else logical(d[1L]) + if((shape <- substr(cl, 2L, 2L)) != "g") { + r@uplo <- x@uplo + if(!never && shape == "t" && x@diag != "N") { + x@diag <- "N" + if(any(is.infinite(diag(x, names = FALSE)))) + diag(x) <- TRUE + } + } + r@x <- if(never) + logical(length(x@x)) + else is.infinite(x@x) r }) -setMethod("is.infinite", signature(x = "indMatrix"), - allFalseMatrix) - -setMethod("is.infinite", signature(x = "nMatrix"), - allFalseMatrix) - -setMethod("is.infinite", signature(x = "lMatrix"), - allFalseMatrix) - -setMethod("is.infinite", signature(x = "dsparseMatrix"), +setMethod("is.infinite", signature(x = "sparseMatrix"), function(x) { - if(any(is.infinite(x@x))) { - r <- .M2kind(x <- diagU2N(x), "l") + cl <- .M.nonvirtual(x) + never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE) + substr(cl, 1L, 1L) <- if(never) "n" else "l" + r <- new(cl) + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + if(substr(cl, 2L, 2L) != "g") + r@uplo <- x@uplo + if(never) { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- integer(d[2L] + 1) }, + "R" = { r@p <- integer(d[1L] + 1) }) + r + } else { + switch(substr(cl, 3L, 3L), + "C" = { r@p <- x@p; r@i <- x@i }, + "R" = { r@p <- x@p; r@j <- x@j }, + "T" = { r@i <- x@i; r@j <- x@j }) r@x <- is.infinite(x@x) .M2kind(.drop0(r), "n") - } else allFalseMatrix(x) + } }) -.is.infinite.ge <- function(x) { - if(any(i <- is.infinite(x@x))) - new("ngeMatrix", Dim = x@Dim, Dimnames = x@Dimnames, x = i) - else allFalseMatrix(x) -} - -.is.infinite.tr <- function(x) { - if(any(i <- is.infinite(x@x))) { - d <- x@Dim - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = x@diag != "N", packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("ntrMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.infinite.tp <- function(x) { - if(any(i <- is.infinite(x@x))) { - d <- x@Dim - if(x@diag != "N") { - k <- indDiag(n = d[1L], upper = x@uplo == "U", - packed = TRUE) - i[k] <- FALSE - } - if(any(i)) - new("ntpMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.infinite.sy <- function(x) { - if(any(i <- is.infinite(x@x))) { - d <- x@Dim - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = FALSE, packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("nsyMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.infinite.sp <- function(x) { - if(any(i <- is.infinite(x@x))) - new("nspMatrix", Dim = x@Dim, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) -} - -for(.xx in c("ge", "tr", "tp", "sy", "sp")) - setMethod("is.infinite", signature(x = paste0("d", .xx, "Matrix")), - get(paste0(".is.infinite.", .xx), - mode = "function", inherits = FALSE)) -rm(.is.infinite.ge, .is.infinite.tr, .is.infinite.tp, - .is.infinite.sy, .is.infinite.sp, - .xx) +setMethod("is.infinite", signature(x = "diagonalMatrix"), + function(x) { + r <- new("ndiMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- if(x@diag != "N") + logical(d[1L]) + else switch(.M.kind(x), "d" = , "z" = is.infinite(x@x), + logical(d[1L])) + r + }) -setMethod("is.infinite", signature(x = "sparseVector"), - function(x) new("nsparseVector", length = x@length, - i = x@i[is.infinite(x@x)])) +setMethod("is.infinite", signature(x = "indMatrix"), + function(x) { + m <- x@margin + r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@p <- integer(d[m] + 1) + r + }) -setMethod("is.infinite", signature(x = "nsparseVector"), - function(x) new("nsparseVector", length = x@length)) +setMethod("is.infinite", signature(x = "sparseVector"), + function(x) { + r <- new("nsparseVector") + r@length <- x@length + switch(.M.kind(x), "d" = , "z" = { r@i <- x@i[is.infinite(x@x)] }) + r + }) -## METHODS FOR GENERIC: is.nan -## NB: completely (!) parallel to 'is.infinite' +## METHODS FOR GENERIC: is.finite ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("is.nan", signature(x = "ddiMatrix"), +setMethod("is.finite", signature(x = "denseMatrix"), function(x) { - r <- new("ldiMatrix") + cl <- .M.nonvirtual(x) + always <- substr(cl, 1L, 1L) == "n" + packed <- substr(cl, 3L, 3L) == "p" + if((shape <- substr(cl, 2L, 2L)) != "s") + r <- new("ngeMatrix") + else { + r <- new(if(!packed) "nsyMatrix" else "nspMatrix") + r@uplo <- x@uplo + } r@Dim <- d <- x@Dim r@Dimnames <- x@Dimnames - r@x <- if(x@diag == "N") is.nan(x@x) else logical(d[1L]) + r@x <- + if(shape != "t") { + if(always) + rep.int(TRUE, length(x@x)) + else is.finite(x@x) + } else { + if(always) + rep.int(TRUE, prod(d)) + else if(!packed) { + tmp <- is.finite(x@x) + tmp[indTri(d[1L], x@uplo != "U", x@diag != "N", FALSE)] <- + TRUE + tmp + } else { + tmp <- rep.int(TRUE, prod(d)) + tmp[indTri(d[1L], x@uplo == "U", TRUE, FALSE)] <- + is.finite(x@x) + if(x@diag != "N") { + dim(tmp) <- d + diag(tmp) <- TRUE + dim(tmp) <- NULL + } + tmp + } + } r }) -setMethod("is.nan", signature(x = "indMatrix"), - allFalseMatrix) - -setMethod("is.nan", signature(x = "nMatrix"), - allFalseMatrix) - -setMethod("is.nan", signature(x = "lMatrix"), - allFalseMatrix) - -setMethod("is.nan", signature(x = "dsparseMatrix"), +setMethod("is.finite", signature(x = "sparseMatrix"), function(x) { - if(any(is.nan(x@x))) { - r <- .M2kind(x <- diagU2N(x), "l") - r@x <- is.nan(x@x) - .M2kind(.drop0(r), "n") - } else allFalseMatrix(x) + cl <- .M.nonvirtual(x) + always <- substr(cl, 1L, 1L) == "n" + if(substr(cl, 2L, 2L) != "s") + r <- new("ngeMatrix") + else { + r <- new("nsyMatrix") + r@uplo <- x@uplo + } + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + tmp <- rep.int(TRUE, prod(d)) + if(!always && !all(k <- is.finite(x@x))) { + if(substr(cl, 3L, 3L) != "T") { + x <- .M2T(x) + if(length(k) > length(x@x)) # was overallocated + k <- is.finite(x@x) + } + i <- c(x@i, x@j) + 1L + dim(i) <- c(length(k), 2L) + dim(tmp) <- d + tmp[i] <- k + dim(tmp) <- NULL + } + r@x <- tmp + r }) -.is.nan.ge <- function(x) { - if(any(i <- is.nan(x@x))) - new("ngeMatrix", Dim = x@Dim, Dimnames = x@Dimnames, x = i) - else allFalseMatrix(x) -} - -.is.nan.tr <- function(x) { - if(any(i <- is.nan(x@x))) { - d <- x@Dim - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = x@diag != "N", packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("ntrMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.nan.tp <- function(x) { - if(any(i <- is.nan(x@x))) { - d <- x@Dim - if(x@diag != "N") { - k <- indDiag(n = d[1L], upper = x@uplo == "U", - packed = TRUE) - i[k] <- FALSE - } - if(any(i)) - new("ntpMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.nan.sy <- function(x) { - if(any(i <- is.nan(x@x))) { - d <- x@Dim - k <- indTri(n = d[1L], upper = x@uplo != "U", - diag = FALSE, packed = FALSE) - i[k] <- FALSE - if(any(i)) - new("nsyMatrix", Dim = d, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) - } else allFalseMatrix(x) -} - -.is.nan.sp <- function(x) { - if(any(i <- is.nan(x@x))) - new("nspMatrix", Dim = x@Dim, Dimnames = x@Dimnames, - x = i, uplo = x@uplo) - else allFalseMatrix(x) -} - -for(.xx in c("ge", "tr", "tp", "sy", "sp")) - setMethod("is.nan", signature(x = paste0("d", .xx, "Matrix")), - get(paste0(".is.nan.", .xx), - mode = "function", inherits = FALSE)) -rm(.is.nan.ge, .is.nan.tr, .is.nan.tp, - .is.nan.sy, .is.nan.sp, - .xx) +setMethod("is.finite", signature(x = "diagonalMatrix"), + function(x) { + r <- new("nsyMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + tmp <- rep.int(TRUE, prod(d)) + if(x@diag == "N" && .M.kind(x) != "n" && !all(k <- is.finite(x@x))) { + dim(tmp) <- d + diag(tmp) <- k + dim(tmp) <- NULL + } + r@x <- tmp + r + }) -setMethod("is.nan", signature(x = "sparseVector"), - function(x) new("nsparseVector", length = x@length, - i = x@i[is.nan(x@x)])) +setMethod("is.finite", signature(x = "indMatrix"), + function(x) { + r <- new("ngeMatrix") + r@Dim <- d <- x@Dim + r@Dimnames <- x@Dimnames + r@x <- rep.int(TRUE, prod(d)) + r + }) -setMethod("is.nan", signature(x = "nsparseVector"), - function(x) new("nsparseVector", length = x@length)) +setMethod("is.finite", signature(x = "sparseVector"), + function(x) { + r <- rep.int(TRUE, x@length) + if(.M.kind(x) != "n") + r[x@i[!is.finite(x@x)]] <- FALSE + r + }) diff -Nru rmatrix-1.6-1.1/R/kappa.R rmatrix-1.6-5/R/kappa.R --- rmatrix-1.6-1.1/R/kappa.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/kappa.R 2023-09-26 06:40:29.000000000 +0000 @@ -0,0 +1,283 @@ +## METHODS FOR GENERIC: norm +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("norm", signature(x = "ANY", type = "missing"), + function(x, type, ...) norm(x, type = "O", ...)) + +setMethod("norm", signature(x = "denseMatrix", type = "character"), + function(x, type, ...) { + if(identical(type, "2")) + return(base::norm(.M2m(x), type = "2")) + x <- .M2kind(x, ",") + switch(substr(.M.nonvirtual(x), 2L, 3L), + "ge" = .Call(dgeMatrix_norm, x, type), + "sy" = .Call(dsyMatrix_norm, x, type), + "sp" = .Call(dspMatrix_norm, x, type), + "tr" = .Call(dtrMatrix_norm, x, type), + "tp" = .Call(dtpMatrix_norm, x, type)) + }) + +setMethod("norm", signature(x = "sparseMatrix", type = "character"), + function(x, type, ...) { + if(any(x@Dim == 0L)) + return(0) + switch(EXPR = type[1L], + "O" = , "o" = , "1" = + max(colSums(abs(x))), + "I" = , "i" = + max(rowSums(abs(x))), + "2" = + { + warning(gettextf("'%s' via sparse -> dense coercion", + "norm"), + domain = NA) + base::norm(.M2m(x), type = "2") + }, + "M" = , "m" = + max(abs(x)), + "F" = , "f" = , "E" = , "e" = + { + if(.M.kind(x) == "z") + x <- abs(x) + sqrt(sum(x * x)) + }, + stop(gettextf("invalid %s=\"%s\"", "type", type[1L]), + domain = NA)) + }) + +setMethod("norm", signature(x = "diagonalMatrix", type = "character"), + function(x, type, ...) { + if((n <- x@Dim[1L]) == 0L) + return(0) + if(nonunit <- x@diag == "N") { + y <- x@x + if(.M.kind(x) == "n" && anyNA(y)) + y <- y | is.na(y) + } + switch(EXPR = type[1L], + "O" = , "o" = , "1" = , + "I" = , "i" = , + "2" = , + "M" = , "m" = + if(nonunit) max(abs(y)) else 1, + "F" = , "f" = , "E" = , "e" = + if(nonunit) { + if(is.complex(y)) + y <- abs(y) + sqrt(sum(y * y)) + } else sqrt(n), + stop(gettextf("invalid %s=\"%s\"", "type", type[1L]), + domain = NA)) + }) + +setMethod("norm", signature(x = "indMatrix", type = "character"), + function(x, type, ...) { + d <- x@Dim + if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) + return(0) + switch(EXPR = type[1L], + "O" = , "o" = , "1" = + if(x@margin == 1L) max(tabulate(x@perm, n)) else 1, + "I" = , "i" = + if(x@margin == 1L) 1 else max(tabulate(x@perm, m)), + "2" = + sqrt(max(tabulate(x@perm, if(x@margin == 1L) n else m))), + "M" = , "m" = + 1, + "F" = , "f" = , "E" = , "e" = + if(x@margin == 1L) sqrt(m) else sqrt(n), + stop(gettextf("invalid %s=\"%s\"", "type", type[1L]), + domain = NA)) + }) + +setMethod("norm", signature(x = "pMatrix", type = "character"), + function(x, type, ...) { + if((n <- x@Dim[1L]) == 0L) + return(0) + switch(EXPR = type[1L], + "O" = , "o" = , "1" = , + "I" = , "i" = , + "2" = , + "M" = , "m" = + 1, + "F" = , "f" = , "E" = , "e" = + sqrt(n), + stop(gettextf("invalid %s=\"%s\"", "type", type[1L]), + domain = NA)) + }) + + +## METHODS FOR GENERIC: rcond +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("rcond", signature(x = "ANY", norm = "missing"), + function(x, norm, ...) rcond(x, norm = "O", ...)) + +setMethod("rcond", signature(x = "denseMatrix", norm = "character"), + function(x, norm, ...) { + x <- .M2kind(x, ",") + switch(substr(.M.nonvirtual(x, strict = TRUE), 2L, 3L), + "ge" = + { + d <- x@Dim + m <- d[1L] + n <- d[2L] + if(m == n) { + trf <- lu(x, warnSing = FALSE) + .Call(dgeMatrix_rcond, x, trf, norm) + } else { + ## MJ: norm(A = P1' Q R P2') = norm(R) holds + ## in general only for norm == "2", but + ## La_rcond_type() disallows norm == "2" + ## ... FIXME ?? + if(m < n) { + x <- t(x) + n <- m + } + R <- triu(qr(x)[["qr"]][seq_len(n), , drop = FALSE]) + rcond(R, norm = norm, ...) + } + }, + "sy" = + { + trf <- BunchKaufman(x, warnSing = FALSE) + .Call(dsyMatrix_rcond, x, trf, norm) + }, + "sp" = + { + trf <- BunchKaufman(x, warnSing = FALSE) + .Call(dspMatrix_rcond, x, trf, norm) + }, + "po" = , + "or" = # corMatrix + { + ok <- TRUE + trf <- tryCatch( + Cholesky(x, perm = FALSE), + error = function(e) { + ok <<- FALSE + BunchKaufman(x, warnSing = FALSE) + }) + if(ok) + .Call(dpoMatrix_rcond, x, trf, norm) + else .Call(dsyMatrix_rcond, x, trf, norm) + }, + "pp" = , + "co" = # pcorMatrix + { + ok <- TRUE + trf <- tryCatch( + Cholesky(x, perm = FALSE), + error = function(e) { + ok <<- FALSE + BunchKaufman(x, warnSing = FALSE) + }) + if(ok) + .Call(dppMatrix_rcond, x, trf, norm) + else .Call(dspMatrix_rcond, x, trf, norm) + }, + "tr" = .Call(dtrMatrix_rcond, x, norm), + "tp" = .Call(dtpMatrix_rcond, x, norm)) + }) + +setMethod("rcond", signature(x = "sparseMatrix", norm = "character"), + function(x, norm, useInv = FALSE, ...) { + d <- x@Dim + if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) + return(Inf) + if(m == n) { + if(isS4(useInv) || useInv) { + if(!isS4(useInv)) + useInv <- solve(x) + 1 / (norm(x, type = norm) * norm(useInv, type = norm)) + } else { + warning(gettextf("'%s' via sparse -> dense coercion", + "rcond"), + domain = NA) + rcond(.M2unpacked(x), norm = norm, ...) + } + } else { + ## MJ: norm(A = P1' Q R P2') = norm(R) holds in general + ## only for norm == "2", but La_rcond_type() disallows + ## norm == "2" ... FIXME ?? + if(m < n) { + x <- t(x) + n <- m + } + R <- triu(qr(x)@R[seq_len(n), , drop = FALSE]) + rcond(R, norm = norm, ...) + } + }) + +setMethod("rcond", signature(x = "diagonalMatrix", norm = "character"), + function(x, norm, ...) { + if((n <- x@Dim[1L]) == 0L) + return(Inf) + if(nonunit <- x@diag == "N") { + y <- x@x + if(.M.kind(x) == "n" && anyNA(y)) + y <- y | is.na(y) + } + switch(EXPR = norm[1L], + "O" = , "o" = , "1" = , + "I" = , "i" = , + "2" = , + "M" = , "m" = + if(nonunit) { + ry <- range(abs(y)) + ry[1L] / ry[2L] + } else 1, + "F" = , "f" = , "E" = , "e" = + if(nonunit) { + if(is.complex(y)) + y <- abs(y) + yy <- y * y + 1 / sqrt(sum(yy) * sum(1 / yy)) + } else 1 / n, + stop(gettext("invalid %s=\"%s\"", "norm", norm[1L]), + domain = NA)) + }) + +setMethod("rcond", signature(x = "indMatrix", norm = "character"), + function(x, norm, ...) { + d <- x@Dim + if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) + return(Inf) + if (m == n) { + if(anyDuplicated.default(x@perm)) + return(0) + switch(EXPR = norm[1L], + "O" = , "o" = , "1" = , + "I" = , "i" = , + "2" = , + "M" = , "m" = + 1, + "F" = , "f" = , "E" = , "e" = + 1 / n, + stop(gettext("invalid %s=\"%s\"", "norm", norm[1L]), + domain = NA)) + } else { + if(m < n) { + x <- t(x) + n <- m + } + R <- triu(qr(x)@R[seq_len(n), , drop = FALSE]) + rcond(R, norm = norm, ...) + } + }) + +setMethod("rcond", signature(x = "pMatrix", norm = "character"), + function(x, norm, ...) { + if((n <- x@Dim[1L]) == 0L) + return(Inf) + switch(EXPR = norm[1L], + "O" = , "o" = , "1" = , + "I" = , "i" = , + "2" = , + "M" = , "m" = + 1, + "F" = , "f" = , "E" = , "e" = + 1 / n, + stop(gettext("invalid %s=\"%s\"", "norm", norm[1L]), + domain = NA)) + }) diff -Nru rmatrix-1.6-1.1/R/kronecker.R rmatrix-1.6-5/R/kronecker.R --- rmatrix-1.6-1.1/R/kronecker.R 2023-07-30 19:36:55.000000000 +0000 +++ rmatrix-1.6-5/R/kronecker.R 2023-09-22 19:22:19.000000000 +0000 @@ -1,9 +1,9 @@ ## METHODS FOR GENERIC: kronecker ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.kroneckerDimnames <- function(dnX, dX = lengths(dnX, FALSE), - dnY, dY = lengths(dnX, FALSE), - sep = ":") { +kroneckerDN <- function(dnX, dX = lengths(dnX, FALSE), + dnY, dY = lengths(dnX, FALSE), + sep = ":") { dnr <- list(NULL, NULL) if(identical(dnX, dnr) && identical(dnY, dnr)) return(NULL) @@ -28,22 +28,39 @@ setMethod("kronecker", signature(X = "diagonalMatrix", Y = "diagonalMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) r <- new("ddiMatrix") r@Dim <- dX * dY - if((uX <- X@diag != "N") & (uY <- Y@diag != "N")) + uX <- X@diag != "N" + uY <- Y@diag != "N" + if(uX && uY) r@diag <- "U" - else if(uX) - r@x <- rep.int(as.double(Y@x), dX[1L]) - else if(uY) - r@x <- rep(as.double(X@x), each = dY[1L]) - else r@x <- rep(X@x, each = dY[1L]) * Y@x + else { + if(!uX) { + X.ii <- X@x + if(.M.kind(X) == "n" && anyNA(X.ii)) + X.ii <- X.ii | is.na(X.ii) + } + if(!uY) { + Y.ii <- Y@x + if(.M.kind(Y) == "n" && anyNA(Y.ii)) + Y.ii <- Y.ii | is.na(Y.ii) + } + r@x <- + if(uX) + rep.int(as.double(Y.ii), dX[1L]) + else if(uY) + rep(as.double(X.ii), each = dY[1L]) + else rep(X.ii, each = dY[1L]) * Y.ii + } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) r@Dimnames <- dnr r }) @@ -52,10 +69,13 @@ setMethod("kronecker", signature(X = "diagonalMatrix", Y = "denseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- X@diag != "N" uY <- FALSE shape <- .M.shape(Y) @@ -79,7 +99,8 @@ nY <- length(y <- Y@x) } if(as.double(nX) * nY > .Machine$integer.max) - stop("number of nonzero entries cannot exceed 2^31-1") + stop(gettextf("number of nonzero entries cannot exceed %s", "2^31-1"), + domain = NA) if(!uX && uY) { diag(Y) <- TRUE nY <- length(y <- Y@x) @@ -108,13 +129,17 @@ r@x <- if(uX) rep.int(as.double(y), nX) - else as.double(y) * rep(X@x, each = nY) + else { + X.ii <- X@x + if(.M.kind(X) == "n" && anyNA(X.ii)) + X.ii <- X.ii | is.na(X.ii) + as.double(y) * rep(X.ii, each = nY) + } if(uX && uY) r <- ..diagN2U(r, sparse = TRUE) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -125,10 +150,13 @@ setMethod("kronecker", signature(X = "denseMatrix", Y = "diagonalMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) shape <- .M.shape(X) uX <- FALSE uY <- Y@diag != "N" @@ -153,7 +181,8 @@ nX <- length(x <- X@x) } if(as.double(nX) * nY > .Machine$integer.max) - stop("number of nonzero entries cannot exceed 2^31-1") + stop(gettextf("number of nonzero entries cannot exceed %s", "2^31-1"), + domain = NA) if(uX && !uY) { diag(X) <- TRUE nX <- length(x <- X@x) @@ -173,7 +202,12 @@ r@x <- if(uY) x.() - else x.() * rep(Y@x, each = m) + else { + Y.ii <- Y@x + if(.M.kind(Y) == "n" && anyNA(Y.ii)) + Y.ii <- Y.ii | is.na(Y.ii) + x.() * rep(Y.ii, each = m) + } } else if(uplo == "U") { rep.1.n <- rep(1:n, each = nY) s <- sequence.default( @@ -213,8 +247,7 @@ r <- ..diagN2U(r, sparse = TRUE) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -226,10 +259,13 @@ setMethod("kronecker", signature(X = "denseMatrix", Y = "denseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) shape <- switch(.M.shape(X), g = "g", t = if(.M.shape(Y) == "t" && X@uplo == Y@uplo) @@ -259,8 +295,7 @@ as.vector(Y[rep.int(seq_len(dY[1L]), dX[1L]), ]) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -271,10 +306,13 @@ setMethod("kronecker", signature(X = "diagonalMatrix", Y = "CsparseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- X@diag != "N" uY <- FALSE shape <- .M.shape(Y) @@ -293,7 +331,8 @@ if((nY <- (p <- Y@p)[length(p)]) == 0L) r@p <- integer(dr[2L] + 1) else if(as.double(nX <- dX[1L]) * nY > .Machine$integer.max) - stop("number of nonzero entries cannot exceed 2^31-1") + stop(gettextf("number of nonzero entries cannot exceed %s", "2^31-1"), + domain = NA) else { head. <- if(length(Y@i) > nY) @@ -306,20 +345,22 @@ head.(Y@i) r@x <- if(uX) { - if(.M.kind(Y) != "n") - rep.int(as.double(head.(Y@x)), nX) - else rep.int(1, nX * nY) + if(.M.kind(Y) == "n") + rep.int(1, nX * nY) + else rep.int(as.double(head.(Y@x)), nX) } else { - if(.M.kind(Y) != "n") - rep(as.double(X@x), each = nY) * + X.ii <- X@x + if(.M.kind(X) == "n" && anyNA(X.ii)) + X.ii <- X.ii | is.na(X.ii) + if(.M.kind(Y) == "n") + rep(as.double(X.ii), each = nY) + else rep(as.double(X.ii), each = nY) * as.double(head.(Y@x)) - else rep(as.double(X@x), each = nY) } } } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -330,10 +371,13 @@ setMethod("kronecker", signature(X = "CsparseMatrix", Y = "diagonalMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- FALSE uY <- Y@diag != "N" shape <- .M.shape(X) @@ -352,7 +396,8 @@ if((nX <- (p <- X@p)[length(p)]) == 0L) r@p <- integer(dr[2L] + 1) else if(as.double(nY <- dY[1L]) * nX > .Machine$integer.max) - stop("number of nonzero entries cannot exceed 2^31-1") + stop(gettextf("number of nonzero entries cannot exceed %s", "2^31-1"), + domain = NA) else { dp <- p[-1L] - p[-length(p)] j. <- which(dp > 0L) @@ -369,22 +414,23 @@ rep.int(rep.int(0:(nY-1L), nj.), rep.dp) r@x <- if(uY) { - if(.M.kind(X) != "n") - as.double(X@x)[s.] - else + if(.M.kind(X) == "n") rep.int(1, nX * nY) + else as.double(X@x)[s.] } else { - if(.M.kind(X) != "n") - rep.int(rep.int(as.double(Y@x), nj.), rep.dp) * - as.double(X@x)[s.] - else - rep.int(rep.int(as.double(Y@x), nj.), rep.dp) + Y.ii <- Y@x + if(.M.kind(Y) == "n" && anyNA(Y.ii)) + Y.ii <- Y.ii | is.na(Y.ii) + if(.M.kind(X) == "n") + rep.int(rep.int(as.double(Y.ii), nj.), rep.dp) + else rep.int(rep.int(as.double(Y.ii), nj.), rep.dp) * + as.double(X@x)[s.] + } } } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -395,10 +441,13 @@ setMethod("kronecker", signature(X = "CsparseMatrix", Y = "CsparseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- uY <- FALSE if((sX <- .M.shape(X)) == "t") uX <- X@diag != "N" @@ -436,7 +485,8 @@ (nY <- (pY <- Y@p)[length(pY)]) == 0L) r@p <- integer(dr[2L] + 1) else if(as.double(nX) * nY > .Machine$integer.max) - stop("number of nonzero entries cannot exceed 2^31-1") + stop(gettextf("number of nonzero entries cannot exceed %s", "2^31-1"), + domain = NA) else { dpX <- pX[-1L] - (pX. <- pX[-length(pX)]) dpY <- pY[-1L] - (pY. <- pY[-length(pY)]) @@ -459,17 +509,15 @@ r@p <- c(0L, cumsum(rep.dpX * dpY)) r@i <- rep.int((dY[1L] * X@i)[s1], t1) + Y@i[s2] r@x <- - if(.M.kind(X) != "n") { - if(.M.kind(Y) != "n") - rep.int(as.double(X@x)[s1], t1) * - as.double(Y@x)[s2] - else - rep.int(as.double(X@x)[s1], t1) - } else { - if(.M.kind(Y) != "n") - as.double(Y@x)[s2] - else + if(.M.kind(X) == "n") { + if(.M.kind(Y) == "n") rep.int(1, nX * nY) + else as.double(Y@x)[s2] + } else { + if(.M.kind(Y) == "n") + rep.int(as.double(X@x)[s1], t1) + else rep.int(as.double(X@x)[s1], t1) * + as.double(Y@x)[s2] } } if(shape == "t") { @@ -480,8 +528,7 @@ r <- .Call(R_sparse_force_symmetric, r, X@uplo) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -504,10 +551,13 @@ setMethod("kronecker", signature(X = "diagonalMatrix", Y = "TsparseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- X@diag != "N" uY <- FALSE shape <- .M.shape(Y) @@ -520,7 +570,7 @@ } if(all(dr)) { if(any((kind <- .M.kind(Y)) == c("n", "l"))) - Y <- .Call(Tsparse_aggregate, Y) + Y <- aggregateT(Y) if(!uX && uY) Y <- ..diagU2N(Y) nX <- dX[1L] @@ -535,18 +585,20 @@ Y@j r@x <- if(uX) { - if(kind != "n") - rep.int(as.double(Y@x), nX) - else rep.int(1, as.double(nX) * nY) + if(kind == "n") + rep.int(1, as.double(nX) * nY) + else rep.int(as.double(Y@x), nX) } else { - if(kind != "n") - rep(as.double(X@x), each = nY) * as.double(Y@x) - else rep(as.double(X@x), each = nY) + X.ii <- X@x + if(.M.kind(X) == "n" && anyNA(X.ii)) + X.ii <- X.ii | is.na(X.ii) + if(kind == "n") + rep(as.double(X.ii), each = nY) + else rep(as.double(X.ii), each = nY) * as.double(Y@x) } } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -557,10 +609,13 @@ setMethod("kronecker", signature(X = "TsparseMatrix", Y = "diagonalMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- FALSE uY <- Y@diag != "N" shape <- .M.shape(X) @@ -573,7 +628,7 @@ } if(all(dr)) { if(any((kind <- .M.kind(X)) == c("n", "l"))) - X <- .Call(Tsparse_aggregate, X) + X <- aggregateT(X) if(uX && !uY) X <- ..diagU2N(X) nX <- length(X@i) @@ -582,18 +637,20 @@ r@j <- rep(nY * X@j, each = nY) + 0:(nY-1L) r@x <- if(uY) { - if(kind != "n") - rep.int(as.double(Y@x), nY) - else rep.int(1, as.double(nX) * nY) - } else { - if(kind != "n") - rep(as.double(X@x), each = nY) * as.double(Y@x) + if(kind == "n") + rep.int(1, as.double(nX) * nY) else rep(as.double(X@x), each = nY) + } else { + Y.ii <- Y@x + if(.M.kind(Y) == "n" && anyNA(Y.ii)) + Y.ii <- Y.ii | is.na(Y.ii) + if(kind == "n") + rep.int(as.double(Y.ii), nX) + else rep(as.double(X@x), each = nY) * as.double(Y.ii) } } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -604,10 +661,13 @@ setMethod("kronecker", signature(X = "TsparseMatrix", Y = "TsparseMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) uX <- uY <- FALSE if((sX <- .M.shape(X)) == "t") uX <- X@diag != "N" @@ -644,18 +704,15 @@ r@i <- i. <- rep(dY[1L] * X@i, each = nY) + Y@i r@j <- rep(dY[2L] * X@j, each = nY) + Y@j r@x <- - if(.M.kind(X) != "n") { - if(.M.kind(Y) != "n") - rep(as.double(X@x), each = nY) * as.double(Y@x) - else - rep(as.double(X@x), each = nY) - } else { - if(.M.kind(Y) != "n") - rep.int(as.double(X@x), nY) - else + if(.M.kind(X) == "n") { + if(.M.kind(Y) == "n") rep.int(1, length(i.)) + else rep.int(as.double(X@x), nY) + } else { + if(.M.kind(Y) == "n") + rep(as.double(X@x), each = nY) + else rep(as.double(X@x), each = nY) * as.double(Y@x) } - if(shape == "t") { r@uplo <- X@uplo if(uX && uY) @@ -664,8 +721,7 @@ r <- .Call(R_sparse_force_symmetric, r, X@uplo) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) { + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) { if(shape == "s" && !isSymmetricDN(dnr)) r <- .M2gen(r) r@Dimnames <- dnr @@ -675,22 +731,24 @@ setMethod("kronecker", signature(X = "diagonalMatrix", Y = "indMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, as(Y, "nsparseMatrix"), FUN, make.dimnames, ...)) + kronecker(X, .M2kind(Y, "n"), FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "indMatrix", Y = "diagonalMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(as(X, "nsparseMatrix"), Y, FUN, make.dimnames, ...)) + kronecker(.M2kind(X, "n"), Y, FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "indMatrix", Y = "indMatrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) { if((margin <- X@margin) != Y@margin) - kronecker(as(X, "CsparseMatrix"), as(Y, "CsparseMatrix"), - FUN, make.dimnames, ...) + kronecker(.M2C(X), .M2C(Y), FUN, make.dimnames, ...) if(!(missing(FUN) || identical(FUN, "*"))) - stop("method for kronecker() must use default FUN=\"*\"") + stop(gettextf("'%s' method must use default %s=\"%s\"", + "kronecker", "FUN", "*"), + domain = NA) if(any(as.double(dX <- X@Dim) * (dY <- Y@Dim) > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) r <- new("indMatrix") r@Dim <- dX * dY r@perm <- @@ -703,50 +761,44 @@ rep.int(Y@perm, dX[2L]) } if(make.dimnames && - !is.null(dnr <- .kroneckerDimnames(dimnames(X), dX, - dimnames(Y), dY))) + !is.null(dnr <- kroneckerDN(dimnames(X), dX, dimnames(Y), dY))) r@Dimnames <- dnr r }) ## Catch everything else with these: -setMethod("kronecker", signature(X = "Matrix", Y = "matrix"), - function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, .m2dense(Y, "dge"), FUN, make.dimnames, ...)) - -setMethod("kronecker", signature(X = "Matrix", Y = "vector"), +for(.cl in c("vector", "matrix")) { +setMethod("kronecker", signature(X = "Matrix", Y = .cl), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, .m2dense(Y, "dge"), FUN, make.dimnames, ...)) + kronecker(X, .m2dense(Y, ",ge"), FUN, make.dimnames, ...)) -setMethod("kronecker", signature(X = "matrix", Y = "Matrix"), +setMethod("kronecker", signature(X = .cl, Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(.m2dense(X, "dge"), Y, FUN, make.dimnames, ...)) - -setMethod("kronecker", signature(X = "vector", Y = "Matrix"), - function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(.m2dense(X, "dge"), Y, FUN, make.dimnames, ...)) + kronecker(.m2dense(X, ",ge"), Y, FUN, make.dimnames, ...)) +} +rm(.cl) setMethod("kronecker", signature(X = "denseMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(as(X, "CsparseMatrix"), Y, FUN, make.dimnames, ...)) + kronecker(.M2C(X), Y, FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "CsparseMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, as(Y, "CsparseMatrix"), FUN, make.dimnames, ...)) + kronecker(X, .M2C(Y), FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "RsparseMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, as(Y, "RsparseMatrix"), FUN, make.dimnames, ...)) + kronecker(X, .M2R(Y), FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "TsparseMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, as(Y, "TsparseMatrix"), FUN, make.dimnames, ...)) + kronecker(X, .M2T(Y), FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "diagonalMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(X, as(Y, "CsparseMatrix"), FUN, make.dimnames, ...)) + kronecker(X, .M2C(Y), FUN, make.dimnames, ...)) setMethod("kronecker", signature(X = "indMatrix", Y = "Matrix"), function(X, Y, FUN = "*", make.dimnames = FALSE, ...) - kronecker(as(X, "CsparseMatrix"), Y, FUN, make.dimnames, ...)) + kronecker(.M2kind(X, "n"), Y, FUN, make.dimnames, ...)) diff -Nru rmatrix-1.6-1.1/R/nearPD.R rmatrix-1.6-5/R/nearPD.R --- rmatrix-1.6-1.1/R/nearPD.R 2019-07-01 14:00:18.000000000 +0000 +++ rmatrix-1.6-5/R/nearPD.R 2023-08-15 22:44:33.000000000 +0000 @@ -119,12 +119,16 @@ 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") + r <- + if(base.matrix) + X + else + new("dpoMatrix", + Dim = c(n, n), + Dimnames = dimnames(x) %||% list(NULL, NULL), + x = as.vector(X)) + structure(list(mat = r, eigenvalues = d, corr = corr, + normF = norm(x - X, "F"), iterations = iter, + rel.tol = conv, converged = converged), + class = "nearPD") } diff -Nru rmatrix-1.6-1.1/R/nnzero.R rmatrix-1.6-5/R/nnzero.R --- rmatrix-1.6-1.1/R/nnzero.R 2023-07-30 20:02:35.000000000 +0000 +++ rmatrix-1.6-5/R/nnzero.R 2023-09-14 00:01:56.000000000 +0000 @@ -9,13 +9,13 @@ ## TRUE ... NA is treated as nonzero and so included in count ## NA ... NA is indeterminate (could be zero or nonzero) hence count is NA + sparseDefault <- function(x) length(x) > 2 * nnzero(x, na.counted = TRUE) +.sparseDefault <- function(x) length(x) > 2 * .nnzero(x, na.counted = TRUE) + ## For logical, integer, double, and complex vectors .nnzero <- function(x, na.counted = NA, nnzmax = length(x)) .Call(R_nnz, x, na.counted, nnzmax) - sparseDefault <- function(x) length(x) > 2 * nnzero(x, na.counted = TRUE) -.sparseDefault <- function(x) length(x) > 2 * .nnzero(x, na.counted = TRUE) - ## For any class with methods for 'is.na' and '!=' .nnzero.fallback <- function(x, na.counted = NA) sum(if(is.na(na.counted)) @@ -30,62 +30,58 @@ setMethod("nnzero", "ANY", .nnzero.fallback) setMethod("nnzero", "vector", .nnzero.dispatching) -setMethod("nnzero", "array", .nnzero.dispatching) - -rm(.nnzero.dispatching) -setMethod("nnzero", "CHMfactor", - function(x, na.counted = NA) - nnzero(as(x, "CsparseMatrix"), na.counted)) - -setMethod("nnzero", "diagonalMatrix", - function(x, na.counted = NA) - if(x@diag == "N") .nnzero(x@x, na.counted) else x@Dim[1L]) - -setMethod("nnzero", "indMatrix", - function(x, na.counted = NA) length(x@perm)) - -setMethod("nnzero", "sparseMatrix", +setMethod("nnzero", "denseMatrix", function(x, na.counted = NA) { d <- x@Dim if(any(d == 0L)) return(0L) - cld <- getClassDef(class(x)) - N <- if(extends(cld, "CsparseMatrix")) - x@p[d[2L]+1L] - else if(extends(cld, "RsparseMatrix")) - x@p[d[1L]+1L] - else length((x <- .Call(Tsparse_aggregate, x))@i) - if(!extends(cld, "nsparseMatrix")) - N <- .nnzero(x@x, na.counted, N) - if(extends(cld, "generalMatrix")) - N - else if(extends(cld, "symmetricMatrix")) - N + N - .nnzero(diag(x), na.counted) - else if(x@diag != "N") - N + d[1L] - else N + if(.M.kind(x) == "n") + na.counted <- TRUE + if((shape <- .M.shape(x)) != "g") + x <- .M2packed(x) + N <- .nnzero(x@x, na.counted) + switch(shape, + "g" = N, + "s" = N + N - .nnzero(diag(x, names = FALSE), na.counted), + "t" = if(x@diag == "N") N else N + d[1L] - .nnzero(x@x[indDiag(d[1L], upper = x@uplo == "U", packed = TRUE)], na.counted)) }) -setMethod("nnzero", "denseMatrix", +setMethod("nnzero", "sparseMatrix", function(x, na.counted = NA) { d <- x@Dim if(any(d == 0L)) return(0L) - xx <- x@x - cld <- getClassDef(class(x)) - if(extends(cld, "ndenseMatrix")) - na.counted <- TRUE - if(extends(cld, "generalMatrix")) - return(.nnzero(xx, na.counted)) - n <- d[1L] - upper <- x@uplo == "U" - if(extends(cld, "unpackedMatrix")) - xx <- xx[indTri(n, upper, diag = TRUE, packed = FALSE)] - N <- .nnzero(xx, na.counted) - if(extends(cld, "symmetricMatrix")) - N + N - .nnzero(diag(x), na.counted) - else if(x@diag != "N") - N + n - .nnzero(xx[indDiag(n, upper, packed = TRUE)], na.counted) - else N + N <- switch(.M.repr(x), + "C" = x@p[d[2L]+1L], + "R" = x@p[d[1L]+1L], + "T" = length((x <- aggregateT(x))@i)) + if(.M.kind(x) != "n") + N <- .nnzero(x@x, na.counted, N) + switch(.M.shape(x), + "g" = N, + "s" = N + N - .nnzero(diag(x, names = FALSE), na.counted), + "t" = if(x@diag == "N") N else N + d[1L]) + }) + +setMethod("nnzero", "diagonalMatrix", + function(x, na.counted = NA) { + if(x@diag != "N") + x@Dim[1L] + else { + y <- x@x + if(.M.kind(x) == "n" && anyNA(y)) + y <- y | is.na(y) + .nnzero(y, na.counted) + } }) + +setMethod("nnzero", "indMatrix", + function(x, na.counted = NA) + length(x@perm)) + +setMethod("nnzero", "CHMfactor", + function(x, na.counted = NA) + nnzero(as(x, "CsparseMatrix"), na.counted)) + +rm(.nnzero.dispatching) diff -Nru rmatrix-1.6-1.1/R/norm.R rmatrix-1.6-5/R/norm.R --- rmatrix-1.6-1.1/R/norm.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/norm.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,109 +0,0 @@ -## METHODS FOR GENERIC: norm -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("norm", signature(x = "ANY", type = "missing"), - function(x, type, ...) norm(x, type = "O", ...)) - -setMethod("norm", signature(x = "sparseMatrix", type = "character"), - function(x, type, ...) { - if(any(x@Dim == 0L)) - return(0) - switch(EXPR = type[1L], - "O" = , "o" = , "1" = - max(colSums(abs(x))), - "I" = , "i" = - max(rowSums(abs(x))), - "2" = - { - warning("'norm' via sparse -> dense coercion") - base::norm(.M2m(x), type = "2") - }, - "M" = , "m" = - max(abs(x)), - "F" = , "f" = , "E" = , "e" = - sqrt(sum(x * x)), - stop("invalid 'type'")) - }) - -setMethod("norm", signature(x = "diagonalMatrix", type = "character"), - function(x, type, ...) { - if((n <- x@Dim[1L]) == 0L) - return(0) - switch(EXPR = type[1L], - "O" = , "o" = , "1" = , - "I" = , "i" = , - "2" = , - "M" = , "m" = - if(x@diag == "N") max(abs(x@x)) else 1, - "F" = , "f" = , "E" = , "e" = - if(x@diag == "N") sqrt(sum(x@x * x@x)) else sqrt(n), - stop("invalid 'type'")) - }) - -setMethod("norm", signature(x = "indMatrix", type = "character"), - function(x, type, ...) { - d <- x@Dim - if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) - return(0) - switch(EXPR = type[1L], - "O" = , "o" = , "1" = - if(x@margin == 1L) max(tabulate(x@perm, n)) else 1, - "I" = , "i" = - if(x@margin == 1L) 1 else max(tabulate(x@perm, m)), - "2" = - sqrt(max(tabulate(x@perm, if(x@margin == 1L) n else m))), - "M" = , "m" = - 1, - "F" = , "f" = , "E" = , "e" = - if(x@margin == 1L) sqrt(m) else sqrt(n), - stop("invalid 'type'")) - }) - -setMethod("norm", signature(x = "pMatrix", type = "character"), - function(x, type, ...) { - if((n <- x@Dim[1L]) == 0L) - return(0) - switch(EXPR = type[1L], - "O" = , "o" = , "1" = , - "I" = , "i" = , - "2" = , - "M" = , "m" = - 1, - "F" = , "f" = , "E" = , "e" = - sqrt(n), - stop("invalid 'type'")) - }) - -setMethod("norm", signature(x = "denseMatrix", type = "character"), - function(x, type, ...) norm(.M2kind(x, "d"), type = type, ...)) - -setMethod("norm", signature(x = "dgeMatrix", type = "character"), - function(x, type, ...) - if(identical(type, "2")) - base::norm(.M2m(x), type = "2") - else .Call(dgeMatrix_norm, x, type)) - -setMethod("norm", signature(x = "dtrMatrix", type = "character"), - function(x, type, ...) { - if(identical(type, "2")) - base::norm(.M2m(x), type = "2") - else .Call(dtrMatrix_norm, x, type) - }) - -setMethod("norm", signature(x = "dtpMatrix", type = "character"), - function(x, type, ...) - if(identical(type, "2")) - base::norm(.M2m(x), type = "2") - else .Call(dtpMatrix_norm, x, type)) - -setMethod("norm", signature(x = "dsyMatrix", type = "character"), - function(x, type, ...) - if(identical(type, "2")) - base::norm(.M2m(x), type = "2") - else .Call(dsyMatrix_norm, x, type)) - -setMethod("norm", signature(x = "dspMatrix", type = "character"), - function(x, type, ...) - if(identical(type, "2")) - base::norm(.M2m(x), type = "2") - else .Call(dspMatrix_norm, x, type)) diff -Nru rmatrix-1.6-1.1/R/not.R rmatrix-1.6-5/R/not.R --- rmatrix-1.6-1.1/R/not.R 2023-07-30 17:42:36.000000000 +0000 +++ rmatrix-1.6-5/R/not.R 2023-09-22 15:53:02.000000000 +0000 @@ -1,93 +1,63 @@ ## METHODS FOR GENERIC: ! (not) -## logical negation ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## Divert everything other than [ln]Matrix to lMatrix: -setMethod("!", "Matrix", function(x) !as(x, "lMatrix")) +setMethod("!", signature(x = "Matrix"), + function(x) !.M2kind(x, "l")) -## -- diagonalMatrix -- +setMethod("!", signature(x = "sparseVector"), + function(x) !.V2kind(x, "l")) -setMethod("!", "ldiMatrix", +setMethod("!", signature(x = "ndenseMatrix"), function(x) { - r <- new("lspMatrix") - r@Dim <- d <- x@Dim - r@Dimnames <- x@Dimnames - if((n <- d[1L]) > 0L) { - r@x <- rep.int(TRUE, 0.5 * n * (n + 1)) - r@x[indDiag(n = n, upper = TRUE, packed = TRUE)] <- - if(x@diag == "N") !x@x else FALSE - } - r - }) - -## -- [ln]sparseMatrix -- [[ FALSE->TRUE => dense result ]] - -setMethod("!", "lsparseMatrix", function(x) !.sparse2dense(x)) -setMethod("!", "nsparseMatrix", function(x) !.sparse2dense(x)) - -## -- [ln]denseMatrix -- - -for(.cl in paste0("l", c("ge", "sy", "sp"), "Matrix")) - setMethod("!", .cl, - function(x) { - x@x <- !x@x - x - }) - -for(.cl in paste0("n", c("ge", "sy", "sp"), "Matrix")) - setMethod("!", .cl, - function(x) { - x@x <- !(is.na(x@x) | x@x) # NA <=> TRUE - x - }) - -for(.cl in paste0("l", c("tr", "tp"), "Matrix")) - setMethod("!", .cl, - function(x) { - r <- .M2gen(x) - r@x <- !r@x - r - }) - -for(.cl in paste0("n", c("tr", "tp"), "Matrix")) - setMethod("!", .cl, - function(x) { - r <- .M2gen(x) - r@x <- !(is.na(r@x) | r@x) # NA <=> TRUE - r - }) - -### -- 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) - } + if(.M.shape(x) == "t") + x <- .M2gen(x) + x@x <- { y <- x@x; if(anyNA(y)) !(y | is.na(y)) else !y } + x + }) +setMethod("!", signature(x = "ldenseMatrix"), + function(x) { + if(.M.shape(x) == "t") + x <- .M2gen(x) + x@x <- !x@x + x + }) + +setMethod("!", signature(x = "nsparseMatrix"), + function(x) { + x <- .sparse2dense(if(.M.shape(x) == "t") .M2gen(x) else x) + x@x <- !x@x + x + }) +setMethod("!", signature(x = "lsparseMatrix"), + function(x) { + x <- .sparse2dense(if(.M.shape(x) == "t") .M2gen(x) else x) + x@x <- !x@x + x + }) + +setMethod("!", signature(x = "ndiMatrix"), + function(x) { + if(x@diag == "N" && anyNA(y <- x@x)) + x@x <- y | is.na(y) + x <- .diag2dense(x, ".", "g") + x@x <- !x@x + x + }) +setMethod("!", signature(x = "ldiMatrix"), + function(x) { + x <- .diag2dense(x, ".", "g") + x@x <- !x@x + x + }) + +setMethod("!", signature(x = "nsparseVector"), + function(x) !.V2v(x)) +setMethod("!", signature(x = "lsparseVector"), + function(x) !.V2v(x)) + +setMethod("!", signature(x = "indMatrix"), + function(x) { + x <- .ind2dense(x) + x@x <- !x@x + x }) diff -Nru rmatrix-1.6-1.1/R/objects.R rmatrix-1.6-5/R/objects.R --- rmatrix-1.6-1.1/R/objects.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/objects.R 2023-10-11 13:25:02.000000000 +0000 @@ -0,0 +1,92 @@ +## if strict=FALSE then gives "...Matrix" or ".sparseVector" or "" +## if strict= TRUE then may also give one of these: +## "pMatrix", "dpoMatrix", "dppMatrix", "corMatrix", "pcorMatrix" +.M.nonvirtual <- function(x, strict = FALSE) + .Call(R_Matrix_nonvirtual, x, strict) + +## "[nlidz]" for Matrix, sparseVector, logical, integer, double, complex 'x'; +## otherwise "" +.M.kind <- function(x) .Call(R_Matrix_kind, x) + +## "[gstd]" for Matrix, sparseVector 'x'; +## otherwise "" +.M.shape <- function(x) .Call(R_Matrix_shape, x) + +## "[CRTdiup]" for [CRT]sparseMatrix, diagonalMatrix, indMatrix +## unpackedMatrix, packedMatrix 'x' {resp.}; +## otherwise "" +.M.repr <- function(x) .Call(R_Matrix_repr, x) + +.isMatrix <- function(x) + nzchar(cl <- .M.nonvirtual(x)) && substr(cl, 4L, 4L) == "M" +.isVector <- function(x) + nzchar(cl <- .M.nonvirtual(x)) && substr(cl, 8L, 8L) == "V" +.isDense <- function(x) any(.M.repr(x) == c("u", "p")) +.isUnpacked <- function(x) .M.repr(x) == "u" +.isPacked <- function(x) .M.repr(x) == "p" +.isSparse <- function(x) any(.M.repr(x) == c("C", "R", "T", "d", "i")) +.isCRT <- function(x) any(.M.repr(x) == c("C", "R", "T")) +.isC <- function(x) .M.repr(x) == "C" +.isR <- function(x) .M.repr(x) == "R" +.isT <- function(x) .M.repr(x) == "T" +.isDiagonal <- function(x) .M.repr(x) == "d" +.isInd <- function(x) .M.repr(x) == "i" + +## for .type.kind[.M.kind(x)]: +.type.kind <- c("n" = "logical", + "l" = "logical", + "i" = "integer", + "d" = "double", + "z" = "complex") + +## for .kind.type[ typeof(x)]: +.kind.type <- c("logical" = "l", + "integer" = "i", + "double" = "d", + "complex" = "z") + +extends1of <- function(class, classes, ...) { + if(is.character(class)) + class <- getClassDef(class[[1L]]) + for(cl in classes) + if(extends(class, cl, ...)) + return(TRUE) + FALSE +} + +MatrixClass <- function(cl, cld = getClassDef(cl), + ...Matrix = TRUE, dropVirtual = TRUE, ...) { + if(!is.character(cl) || length(cl) != 1L || is.na(cl)) + stop("'cl' is not a character string") + if(is.null(pkg <- cld@package) && is.null(pkg <- attr(cl, "package"))) + return(character(0L)) + if(identical(pkg, "Matrix") && (!...Matrix || + grepl("^[nlidz](ge|sy|sp|tr|tp|di|[gst][CRT])Matrix$", cl))) + return(cl) + r <- .selectSuperClasses(cld@contains, dropVirtual = dropVirtual, + namesOnly = TRUE, ...) + if(length(r) == 0L) + return(character(0L)) + while({ + r1 <- Recall(r[1L], ...Matrix = ...Matrix, dropVirtual = dropVirtual, ...) + length(r1) == 0L && length(r) > 1L + }) + r <- r[-1L] + r1 +} + +class2 <- function(cl, kind = "l") + sub("^[nlidz]", kind, MatrixClass(cl)) + +copyClass <- function(from, to.class, + sNames = intersect(slotNames(to.class), slotNames(from)), + check = TRUE) { + to <- new(to.class) + if(check) + for(nm in sNames) + slot(to, nm) <- slot(from, nm) + else + for(nm in sNames) + attr(to, nm) <- attr(from, nm) + to +} diff -Nru rmatrix-1.6-1.1/R/pMatrix.R rmatrix-1.6-5/R/pMatrix.R --- rmatrix-1.6-1.1/R/pMatrix.R 2023-07-30 19:36:55.000000000 +0000 +++ rmatrix-1.6-5/R/pMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,249 +0,0 @@ -## METHODS FOR CLASS: pMatrix -## permutation matrices, i.e., matrices with standard unit vectors -## for all rows _and_ all columns -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## MJ: could export without dot -.changeMargin <- function(x) { - x@margin <- if(x@margin == 1L) 2L else 1L - x@perm <- invertPerm(x@perm) - x -} - -setAs("numeric", "pMatrix", - function(from) { - J <- new("pMatrix") - if((m <- length(from)) == 0L) - return(J) - if(m > .Machine$integer.max) - stop("dimensions cannot exceed 2^31-1") - from.i <- from - if(anyNA(r <- range(from)) || any(r != c(1L, m)) || - (is.double(from) && any(from != (from.i <- as.integer(from)))) || - anyDuplicated.default(from.i)) - stop("'perm' slot must be a permutation of seq_along(perm)") - nms <- names(from) - J@Dim <- c(m, m) - J@Dimnames <- list(nms, nms) - J@perm <- from.i - J - }) - -setAs("nsparseMatrix", "pMatrix", - function(from) { - d <- from@Dim - if((n <- d[1L]) != d[2L]) - stop("attempt to coerce non-square matrix to pMatrix") - from <- .M2gen(from) - J <- new("pMatrix") - J@Dim <- d - J@Dimnames <- from@Dimnames - from. <- as(from, "RsparseMatrix") - p <- from.@p - m <- length(p) - 1L - if(all(p == 0:m) && !anyDuplicated.default(j <- from.@j)) { - J@perm <- j + 1L - return(J) - } - from. <- as(from, "CsparseMatrix") - p <- from.@p - n <- length(p) - 1L - if(all(p == 0:n) && !anyDuplicated.default(i <- from.@i)) { - J@perm <- i + 1L - J@margin <- 2L - return(J) - } - stop("matrix must have exactly one nonzero element in each row and column") - }) - -setAs("indMatrix", "pMatrix", - function(from) new("pMatrix", from)) - -setMethod("t", signature(x = "pMatrix"), - function(x) { - r <- new("pMatrix") - r@Dim <- x@Dim - r@Dimnames = x@Dimnames[2:1] - r@perm <- x@perm - if(x@margin == 1L) - r@margin <- 2L - r - }) - -for(.op in c("%*%", "%&%")) { -setMethod(.op, signature(x = "pMatrix", y = "pMatrix"), - function(x, y) { - r <- new("pMatrix") - r@Dim <- mmultDim(x@Dim, y@Dim, type = 1L) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - r@perm <- - if(y@margin == 1L) - y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] - else { - r@margin <- 2L - (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] - } - r - }) - -setMethod(.op, signature(x = "pMatrix", y = "indMatrix"), - function(x, y) { - r <- new("indMatrix") - r@Dim <- mmultDim(x@Dim, y@Dim, type = 1L) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - r@perm <- - if(y@margin == 1L) - y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] - else { - r@margin <- 2L - (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] - } - r - }) - -setMethod(.op, signature(x = "indMatrix", y = "pMatrix"), - function(x, y) { - r <- new("indMatrix") - r@Dim <- mmultDim(x@Dim, y@Dim, type = 1L) - r@Dimnames <- mmultDimnames(x@Dimnames, y@Dimnames, type = 1L) - r@perm <- - if(x@margin == 1L) - (if(y@margin == 1L) y@perm else invertPerm(y@perm))[x@perm] - else { - r@margin <- 2L - x@perm[if(y@margin == 1L) invertPerm(x@perm) else y@perm] - } - r - }) -} -rm(.op) - -setMethod("%*%", signature(x = "pMatrix", y = "matrix"), - function(x, y) { - mmultDim(x@Dim, dim(y), type = 1L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- .m2dense(y[perm, , drop = FALSE], "dge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%*%", signature(x = "matrix", y = "pMatrix"), - function(x, y) { - mmultDim(dim(x), y@Dim, type = 1L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- .m2dense(x[, perm, drop = FALSE], "dge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%*%", signature(x = "pMatrix", y = "Matrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- as(y[perm, , drop = FALSE], "dMatrix") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%*%", signature(x = "Matrix", y = "pMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- as(x[, perm, drop = FALSE], "dMatrix") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "pMatrix", y = "matrix"), - function(x, y) { - mmultDim(x@Dim, dim(y), type = 1L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- .m2dense(y[perm, , drop = FALSE], "nge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "matrix", y = "pMatrix"), - function(x, y) { - mmultDim(dim(x), y@Dim, type = 1L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- .m2dense(x[, perm, drop = FALSE], "nge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("%&%", signature(x = "pMatrix", y = "Matrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- as(y[perm, , drop = FALSE], "nMatrix") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 1L) - r - }) - -setMethod("%&%", signature(x = "Matrix", y = "pMatrix"), - function(x, y) { - mmultDim(x@Dim, y@Dim, type = 1L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- as(x[, perm, drop = FALSE], "nMatrix") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 1L) - r - }) - -setMethod("crossprod", signature(x = "pMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) { - r <- new(if(isTRUE(boolArith)) "ldiMatrix" else "ddiMatrix") - r@Dim <- x@Dim - r@Dimnames <- x@Dimnames[c(2L, 2L)] - r@diag <- "U" - r - }) - -setMethod("crossprod", signature(x = "matrix", y = "pMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(dim(x), y@Dim, type = 2L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- .m2dense(t(x)[, perm, drop = FALSE], - if(isTRUE(boolArith)) "nge" else "dge") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("crossprod", signature(x = "Matrix", y = "pMatrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 2L) - perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm - r <- as(t(x)[, perm, drop = FALSE], - if(isTRUE(boolArith)) "nMatrix" else "dMatrix") - r@Dimnames <- mmultDimnames(dimnames(x), y@Dimnames, type = 2L) - r - }) - -setMethod("tcrossprod", signature(x = "pMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) { - r <- new(if(isTRUE(boolArith)) "ldiMatrix" else "ddiMatrix") - r@Dim <- x@Dim - r@Dimnames <- x@Dimnames[c(1L, 1L)] - r@diag <- "U" - r - }) - -setMethod("tcrossprod", signature(x = "pMatrix", y = "matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, dim(y), type = 3L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- .m2dense(t(y)[perm, , drop = FALSE], - if(isTRUE(boolArith)) "nge" else "dge") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) - -setMethod("tcrossprod", signature(x = "pMatrix", y = "Matrix"), - function(x, y = NULL, boolArith = NA, ...) { - mmultDim(x@Dim, y@Dim, type = 3L) - perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) - r <- as(t(y)[perm, , drop = FALSE], - if(isTRUE(boolArith)) "nMatrix" else "dMatrix") - r@Dimnames <- mmultDimnames(x@Dimnames, dimnames(y), type = 3L) - r - }) diff -Nru rmatrix-1.6-1.1/R/packedMatrix.R rmatrix-1.6-5/R/packedMatrix.R --- rmatrix-1.6-1.1/R/packedMatrix.R 2023-07-30 20:04:58.000000000 +0000 +++ rmatrix-1.6-5/R/packedMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,77 +0,0 @@ -## METHODS FOR CLASS: packedMatrix (virtual) -## dense triangular or symmetric matrices with packed storage -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.pM.subclasses <- names(getClassDef("packedMatrix")@subclasses) - -setMethod("unpack", signature(x = "packedMatrix"), - function(x, ...) .Call(R_dense_as_unpacked, x)) - -setMethod("pack", signature(x = "packedMatrix"), - function(x, ...) x) - -setMethod("forceSymmetric", signature(x = "packedMatrix", uplo = "missing"), - function(x, uplo) .Call(packedMatrix_force_symmetric, x, NULL)) -setMethod("forceSymmetric", signature(x = "packedMatrix", uplo = "character"), - function(x, uplo) .Call(packedMatrix_force_symmetric, x, uplo)) - -## Not all of these .pM.is.* are used, because all packedMatrix inherit -## from symmetricMatrix or triangularMatrix, and those classes have -## their own methods. They are retained here somewhat for completeness ... - -.pM.is.sy <- function(object, checkDN = TRUE, ...) { - ## backwards compatibility: don't check DN if check.attributes=FALSE - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - ## requiring exact symmetry (fast): - .Call(packedMatrix_is_symmetric, object, checkDN) -} - -.pM.is.sy.dz <- function(object, tol = 100 * .Machine$double.eps, - tol1 = 8 * tol, checkDN = TRUE, ...) { - if (tol <= 0) - . - else { - ## going via all.equal (slow): - isSymmetric(unpack(object), tol = tol, tol1 = tol1, - checkDN = checkDN, ...) - } -} -body(.pM.is.sy.dz) <- - do.call(substitute, list(body(.pM.is.sy.dz), list(. = body(.pM.is.sy)))) - -.pM.is.tr <- function(object, upper = NA, ...) - .Call(packedMatrix_is_triangular, object, upper) - -.pM.is.di <- function(object) .Call(packedMatrix_is_diagonal, object) - -## method for .spMatrix in ./symmetricMatrix.R -## method for [lni]tpMatrix in ./triangularMatrix.R -for (.cl in grep("^[dz]tpMatrix$", .pM.subclasses, value = TRUE)) - setMethod("isSymmetric", signature(object = .cl), .pM.is.sy.dz) - -setMethod("isDiagonal", signature(object = "packedMatrix"), .pM.is.di) - -rm(.pM.is.sy, .pM.is.sy.dz, .pM.is.tr, .pM.is.di, .cl) - -setMethod("t", signature(x = "packedMatrix"), - function(x) - .Call(packedMatrix_transpose, x)) -setMethod("diag", signature(x = "packedMatrix"), - function(x, nrow, ncol, names = TRUE) - .Call(packedMatrix_diag_get, x, names)) -setMethod("diag<-", signature(x = "packedMatrix"), - function(x, value) - .Call(packedMatrix_diag_set, x, value)) - -setMethod("symmpart", signature(x = "packedMatrix"), - function(x) .Call(packedMatrix_symmpart, x)) -setMethod("skewpart", signature(x = "packedMatrix"), - function(x) .Call(packedMatrix_skewpart, x)) - -setMethod("cov2cor", signature(V = "packedMatrix"), - function(V) as(forceSymmetric(V), "pcorMatrix")) - -rm(.pM.subclasses) diff -Nru rmatrix-1.6-1.1/R/perm.R rmatrix-1.6-5/R/perm.R --- rmatrix-1.6-1.1/R/perm.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/perm.R 2023-08-16 05:12:14.000000000 +0000 @@ -0,0 +1,15 @@ +invertPerm <- function(p, off = 1L, ioff = 1L) + .Call(R_invertPerm, as.integer(p), as.integer(off), as.integer(ioff)) + +signPerm <- function(p, off = 1L) + .Call(R_signPerm, as.integer(p), as.integer(off)) + +isPerm <- function(p, off = 1L) + .Call(R_isPerm, as.integer(p), as.integer(off)) + +asPerm <- function(pivot, off = 1L, ioff = 1L, n = length(pivot)) + .Call(R_asPerm, as.integer(pivot), as.integer(off), as.integer(ioff), + as.integer(n)) + +invPerm <- function(p, zero.p = FALSE, zero.res = FALSE) + invertPerm(p, if(zero.p) 0L else 1L, if(zero.res) 0L else 1L) diff -Nru rmatrix-1.6-1.1/R/posdef.R rmatrix-1.6-5/R/posdef.R --- rmatrix-1.6-1.1/R/posdef.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/posdef.R 2023-09-22 19:22:19.000000000 +0000 @@ -0,0 +1,171 @@ +## METHODS FOR CLASS: dpoMatrix, dppMatrix +## dense symmetric positive semidefinite matrices +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +## Operations such as rounding can lose positive semidefiniteness +## but not symmetry, hence: +.indefinite <- function(x) { + cl <- .M.nonvirtual(x, TRUE) + if(any(cl == c("dpoMatrix", "corMatrix"))) + as(x, "dsyMatrix") + else if(any(cl == c("dppMatrix", "pcorMatrix"))) + as(x, "dspMatrix") + else x +} + +.dsy2dpo <- .dsp2dpp <- function(from) { + if(is.null(tryCatch(Cholesky(from, perm = FALSE), + error = function(e) NULL))) + stop("not a positive definite matrix (and positive semidefiniteness is not checked)") + to <- new(.CLASS) + to@Dim <- from@Dim + to@Dimnames <- from@Dimnames + to@uplo <- from@uplo + to@x <- from@x + to@factors <- from@factors + to +} +body(.dsy2dpo)[[3L]][[3L]][[2L]] <- "dpoMatrix" +body(.dsp2dpp)[[3L]][[3L]][[2L]] <- "dppMatrix" + +setAs("dppMatrix", "dpoMatrix", function(from) unpack(from)) +setAs("dpoMatrix", "dppMatrix", function(from) pack(from)) + +setAs("dsyMatrix", "dpoMatrix", .dsy2dpo) +setAs("dspMatrix", "dppMatrix", .dsp2dpp) + +setAs("Matrix", "dpoMatrix", + function(from) .dsy2dpo(.M2unpacked(.M2sym(.M2kind(from, "d"))))) +setAs("Matrix", "dppMatrix", + function(from) .dsp2dpp(.M2packed (.M2sym(.M2kind(from, "d"))))) + +setAs("matrix", "dpoMatrix", + function(from) { + storage.mode(from) <- "double" + .dsy2dpo(.M2sym(from)) + }) +setAs("matrix", "dppMatrix", + function(from) { + storage.mode(from) <- "double" + .dsp2dpp(pack(from, symmetric = TRUE)) + }) + + +## METHODS FOR CLASS: corMatrix, pcorMatrix +## dense correlation matrices +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.dpo2cor <- function(from) { + if(!is.null(to <- from@factors$correlation)) + return(to) + sd <- sqrt(diag(from, names = FALSE)) + + to <- new("corMatrix") + to@Dim <- d <- from@Dim + to@Dimnames <- from@Dimnames + to@uplo <- from@uplo + to@sd <- sd + + n <- d[1L] + x <- from@x / sd / rep(sd, each = n) + x[indDiag(n)] <- 1 + to@x <- x + + .set.factor(from, "correlation", to) +} + +.dpp2pcor <- function(from) { + if(!is.null(to <- from@factors$correlation)) + return(to) + sd <- sqrt(diag(from, names = FALSE)) + + to <- new("pcorMatrix") + to@Dim <- d <- from@Dim + to@Dimnames <- from@Dimnames + to@uplo <- uplo <- from@uplo + to@sd <- sd + + n <- d[1L] + u <- uplo == "U" + if(u) { + r <- seq_len(n) + s <- 1L + } else { + r <- seq.int(to = 1L, by = -1L, length.out = n) + s <- seq_len(n) + } + x <- from@x / rep.int(sd, r) / sd[sequence.default(r, s)] + x[indDiag(n, upper = u, packed = TRUE)] <- 1 + to@x <- x + + .set.factor(from, "correlation", to) +} + +setAs("pcorMatrix", "corMatrix", function(from) unpack(from)) +setAs( "corMatrix", "pcorMatrix", function(from) pack(from)) + +setAs("dpoMatrix", "corMatrix", .dpo2cor) +setAs("dppMatrix", "pcorMatrix", .dpp2pcor) + +setAs("dsyMatrix", "corMatrix", + function(from) .dpo2cor (.dsy2dpo(from))) +setAs("dspMatrix", "pcorMatrix", + function(from) .dpp2pcor(.dsp2dpp(from))) + +setAs("Matrix", "corMatrix", + function(from) .dpo2cor (.dsy2dpo(.M2unpacked(.M2sym(.M2kind(from, "d")))))) +setAs("Matrix", "pcorMatrix", + function(from) .dpp2pcor(.dsp2dpp(.M2packed (.M2sym(.M2kind(from, "d")))))) + +setAs("matrix", "corMatrix", + function(from) { + storage.mode(from) <- "double" + .dpo2cor (.dsy2dpo(.M2sym(from))) + }) +setAs("matrix", "pcorMatrix", + function(from) { + storage.mode(from) <- "double" + .dpp2pcor(.dsp2dpp(pack(from, symmetric = TRUE))) + }) + + +## METHODS FOR GENERIC: cov2cor +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("cov2cor", signature(V = "unpackedMatrix"), + function(V) { + d <- V@Dim + if(d[1L] != d[2L] || .M.kind(V) == "z") + stop(gettextf("'%s' is not a square numeric matrix", "V"), + domain = NA) + as(forceSymmetric(V), "corMatrix") + }) + +setMethod("cov2cor", signature(V = "packedMatrix"), + function(V) { + d <- V@Dim + if(d[1L] != d[2L] || .M.kind(V) == "z") + stop(gettextf("'%s' is not a square numeric matrix", "V"), + domain = NA) + as(forceSymmetric(V), "pcorMatrix") + }) + +setMethod("cov2cor", signature(V = "sparseMatrix"), + function(V) { + d <- V@Dim + if(d[1L] != d[2L] || .M.kind(V) == "z") + stop(gettextf("'%s' is not a square numeric matrix", "V"), + domain = NA) + dn <- symDN(V@Dimnames) + V <- .M2kind(V, "d") + V.ii <- diag(V, names = FALSE) + if(length(V.ii) > 0L && is.na(m <- min(V.ii)) || m <= 0) + warning(gettextf("diag(%s) has non-positive or non-finite entries; finite result is doubtful", + "V"), + domain = NA) + D <- Diagonal(x = sqrt(1/V.ii)) + r <- forceSymmetric(D %*% V %*% D) + diag(r) <- 1 + r@Dimnames <- dn + r + }) diff -Nru rmatrix-1.6-1.1/R/products.R rmatrix-1.6-5/R/products.R --- rmatrix-1.6-1.1/R/products.R 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/R/products.R 2023-10-11 13:25:02.000000000 +0000 @@ -1,1072 +1,1603 @@ -#### 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) -rm(.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) .m2dense(x, "dge") %*% 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 ldensematrix argument to a lsparseMatrix. -setMethod("%*%", signature(x = "lsparseMatrix", y = "ldenseMatrix"), - function(x, y) x %*% .dense2sparse(y, "C")) - -setMethod("%*%", signature(x = "ldenseMatrix", y = "lsparseMatrix"), - function(x, y) .dense2sparse(x, "C") %*% y) - -## and coerce lsparse* to lgC* -setMethod("%*%", signature(x = "lsparseMatrix", y = "lsparseMatrix"), - function(x, y) .M2gen(as(x, "CsparseMatrix")) %*% - .M2gen(as(y, "CsparseMatrix"))) - -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")) +matmultDim <- function(d.a, d.b, type = 1L) { + ## Return the 'dim' of the product indicated by 'type': + ## type 1: a %*% b + ## 2: t(a) %*% b { crossprod} + ## 3: a %*% t(b) {tcrossprod} + ## after asserting that ncol() == nrow() + i.a <- 1L + (type != 2L) + i.b <- 1L + (type == 3L) + if(d.a[i.a] != d.b[i.b]) + stop("non-conformable arguments") + c(d.a[-i.a], d.b[-i.b]) } +matmultDN <- function(dn.a, dn.b, type = 1L) + ## Return the 'dimnames' of the product indicated by 'type': + ## type 1: a %*% b + ## 2: t(a) %*% b { crossprod} + ## 3: a %*% t(b) {tcrossprod} + c(if(is.null(dn.a)) list(NULL) else dn.a[2L - (type != 2L)], + if(is.null(dn.b)) list(NULL) else dn.b[2L - (type == 3L)]) + + +## METHODS FOR GENERIC: %*% +## NB: x %*% y == t(t(y) %*% t(x)) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +for(.cl in c("Matrix", "sparseVector")) { +setMethod("%*%", signature(x = .cl, y = "ANY"), + function(x, y) + x %*% (if(length(dim(y)) == 2L) as.matrix else as.vector)(y)) + +setMethod("%*%", signature(x = "ANY", y = .cl), + function(x, y) + (if(length(dim(x)) == 2L) as.matrix else as.vector)(x) %*% y) +} + + +## .... denseMatrix .................................................... + +setMethod("%*%", signature(x = "denseMatrix", y = "denseMatrix"), + function(x, y) + .Call(R_dense_matmult, x, y, FALSE, FALSE)) + +for(.cl in c("matrix", "vector")) { +setMethod("%*%", signature(x = "denseMatrix", y = .cl), + function(x, y) + .Call(R_dense_matmult, x, y, FALSE, FALSE)) + +setMethod("%*%", signature(x = .cl, y = "denseMatrix"), + function(x, y) + .Call(R_dense_matmult, x, y, FALSE, FALSE)) +} + + +## .... CsparseMatrix .................................................. + setMethod("%*%", signature(x = "CsparseMatrix", y = "CsparseMatrix"), - function(x, y) .Call(Csparse_Csparse_prod, x, y, boolArith=NA)) + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = "CsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = "CsparseMatrix", y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%*%", signature(x = "CsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = .cl, y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) +} + + +## .... RsparseMatrix .................................................. + +setMethod("%*%", signature(x = "RsparseMatrix", y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) + +setMethod("%*%", signature(x = "RsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) + +setMethod("%*%", signature(x = "RsparseMatrix", y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%*%", signature(x = "RsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = .cl, y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) +} + + +## .... TsparseMatrix .................................................. + +setMethod("%*%", signature(x = "TsparseMatrix", y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = "TsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) -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) .M2C(x) %*% y) -setMethod("%*%", signature(x = "ANY", y = "TsparseMatrix"), - function(x, y) x %*% .M2C(y)) -setMethod("%*%", signature(x = "TsparseMatrix", y = "Matrix"), - function(x, y) .M2C(x) %*% y) -setMethod("%*%", signature(x = "Matrix", y = "TsparseMatrix"), - function(x, y) x %*% .M2C(y)) setMethod("%*%", signature(x = "TsparseMatrix", y = "TsparseMatrix"), - function(x, y) .M2C(x) %*% .M2C(y)) + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%*%", signature(x = "TsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = .cl, y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, FALSE)) +} + + +## .... diagonalMatrix ................................................. + +setMethod("%*%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), + function(x, y) { + r <- new("ddiMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + xu <- x@diag != "N" + yu <- y@diag != "N" + if(xu && yu) + r@diag <- "U" + else { + if(!xu) { + xii <- x@x + if(.M.kind(x) == "n" && anyNA(xii)) + xii <- xii | is.na(xii) + } + if(!yu) { + yii <- y@x + if(.M.kind(y) == "n" && anyNA(yii)) + yii <- yii | is.na(yii) + } + r@x <- + if(xu) + as.double(yii) + else if(yu) + as.double(xii) + else as.double(xii * yii) + } + r + }) + +for(.cl in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix", + "denseMatrix", "matrix", "vector")) { +setMethod("%*%", signature(x = "diagonalMatrix", y = .cl), + function(x, y) + .Call(R_diagonal_matmult, x, y, FALSE, FALSE, FALSE)) + +setMethod("%*%", signature(x = .cl, y = "diagonalMatrix"), + function(x, y) + .Call(R_diagonal_matmult, x, y, FALSE, FALSE, FALSE)) +} + + +## .... indMatrix ...................................................... + +setMethod("%*%", signature(x = "indMatrix", y = "indMatrix"), + function(x, y) { + mx <- x@margin + my <- y@margin + px <- x@perm + py <- y@perm + r <- new(if(mx == my) + "indMatrix" + else if(mx == 1L) + "dgeMatrix" + else "dgTMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + if(mx == my) + r@perm <- if(mx == 1L) py[px] else { r@margin <- 2L; px[py] } + else if(mx == 1L) + r@x <- as.double(px == rep(py, each = length(px))) + else { + r@i <- px - 1L + r@j <- py - 1L + r@x <- rep.int(1, length(px)) + } + r + }) + +setMethod("%*%", signature(x = "indMatrix", y = "Matrix"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "d") %*% y) + matmultDim(x@Dim, y@Dim, type = 1L) + r <- .M2kind(y[x@perm, , drop = FALSE], ",") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%*%", signature(x = "Matrix", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %*% .M2kind(y, "d")) + matmultDim(x@Dim, y@Dim, type = 1L) + r <- .M2kind(x[, y@perm, drop = FALSE], ",") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%*%", signature(x = "indMatrix", y = "matrix"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "d") %*% y) + matmultDim(x@Dim, dim(y), type = 1L) + r <- .m2dense(y[x@perm, , drop = FALSE], ",ge") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%*%", signature(x = "matrix", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %*% .M2kind(y, "d")) + matmultDim(dim(x), y@Dim, type = 1L) + r <- .m2dense(x[, y@perm, drop = FALSE], ",ge") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%*%", signature(x = "indMatrix", y = "vector"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "d") %*% y) + k <- (d <- x@Dim)[2L] + r <- + if(k == length(y)) + .m2dense(y[x@perm], ",ge") + else if(k == 1L) + .m2dense(matrix(y, d[1L], length(y), byrow = TRUE), ",ge") + else stop("non-conformable arguments") + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r + }) + +setMethod("%*%", signature(x = "vector", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %*% .M2kind(y, "d")) + k <- (d <- y@Dim)[1L] + r <- + if(k == length(x)) + .m2dense(x[y@perm], ",ge", trans = TRUE) + else if(k == 1L) + .m2dense(matrix(x, length(x), d[2L]), ",ge") + else stop("non-conformable arguments") + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + r + }) + + +## .... pMatrix ........................................................ + +setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"), + function(x, y) { + r <- new("pMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(y@margin == 1L) + y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] + else { + r@margin <- 2L + (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] + } + r + }) + +setMethod("%*%", signature(x = "pMatrix", y = "indMatrix"), + function(x, y) { + r <- new("indMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(y@margin == 1L) + y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] + else { + r@margin <- 2L + (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] + } + r + }) + +setMethod("%*%", signature(x = "indMatrix", y = "pMatrix"), + function(x, y) { + r <- new("indMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(x@margin == 1L) + (if(y@margin == 1L) y@perm else invertPerm(y@perm))[x@perm] + else { + r@margin <- 2L + x@perm[if(y@margin == 1L) invertPerm(x@perm) else y@perm] + } + r + }) + +setMethod("%*%", signature(x = "pMatrix", y = "Matrix"), + function(x, y) { + matmultDim(x@Dim, y@Dim, type = 1L) + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .M2kind(y[perm, , drop = FALSE], ",") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%*%", signature(x = "Matrix", y = "pMatrix"), + function(x, y) { + matmultDim(x@Dim, y@Dim, type = 1L) + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .M2kind(x[, perm, drop = FALSE], ",") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%*%", signature(x = "pMatrix", y = "matrix"), + function(x, y) { + matmultDim(x@Dim, dim(y), type = 1L) + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .m2dense(y[perm, , drop = FALSE], ",ge") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%*%", signature(x = "matrix", y = "pMatrix"), + function(x, y) { + matmultDim(dim(x), y@Dim, type = 1L) + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .m2dense(x[, perm, drop = FALSE], ",ge") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%*%", signature(x = "pMatrix", y = "vector"), + function(x, y) { + k <- x@Dim[2L] + r <- + if(k == length(y)) { + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + .m2dense(y[perm], ",ge") + } + else if(k == 1L) + .m2dense(y, ",ge", trans = TRUE) + else stop("non-conformable arguments") + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r + }) + +setMethod("%*%", signature(x = "vector", y = "pMatrix"), + function(x, y) { + k <- y@Dim[1L] + r <- + if(k == length(x)) { + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + .m2dense(x[perm], ",ge", trans = TRUE) + } + else if(k == 1L) + .m2dense(x, ",ge") + else stop("non-conformable arguments") + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + r + }) + + +## .... sparseVector ................................................... + +setMethod("%*%", signature(x = "sparseVector", y = "sparseVector"), + function(x, y) + if((nx <- length(x)) == 1L) + .tCRT(.V2C(x * y)) + else if(nx == length(y)) + ## else if((ny <- length(y)) == 1L) + ## .V2C(x * y) + ## else if(nx == ny) + .m2sparse(sum(x * y), ",gR") + else stop("non-conformable arguments")) + +for(.cl in c("Matrix", "matrix")) { +setMethod("%*%", signature(x = "sparseVector", y = .cl), + function(x, y) + if((k <- dim(y)[1L]) == length(x)) + .tCRT(.V2C(x)) %*% y + else if(k == 1L) + .V2C(x) %*% y + else stop("non-conformable arguments")) + +setMethod("%*%", signature(x = .cl, y = "sparseVector"), + function(x, y) + if((k <- dim(x)[2L]) == length(y)) + x %*% .V2C(y) + else if(k == 1L) + x %*% .tCRT(.V2C(y)) + else stop("non-conformable arguments")) +} +setMethod("%*%", signature(x = "sparseVector", y = "vector"), + function(x, y) + if((nx <- length(x)) == 1L) + .m2dense(.V2v(x * y), ",ge", trans = TRUE) + else if(nx == length(y)) + ## else if((ny <- length(y)) == 1L) + ## .m2dense(.V2v(x * y), ",ge") + ## else if(nx == ny) + .m2dense(sum(x * y), ",ge") + else stop("non-conformable arguments")) + +setMethod("%*%", signature(x = "vector", y = "sparseVector"), + function(x, y) + if((nx <- length(x)) == 1L) + .m2dense(.V2v(x * y), ",ge", trans = TRUE) + else if(nx == length(y)) + ## else if((ny <- length(y)) == 1L) + ## .m2dense(.V2v(x * y), ",ge") + ## else if(nx == ny) + .m2dense(sum(x * y), ",ge") + else stop("non-conformable arguments")) + + +## METHODS FOR GENERIC: %&% +## NB: x %*% y == t(t(y) %*% t(x)) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +setMethod("%&%", signature(x = "ANY", y = "ANY"), + function(x, y) + (if(length(dim(x)) == 2L) as.matrix else as.vector)(x) %&% + (if(length(dim(y)) == 2L) as.matrix else as.vector)(y)) + +for(.cl in c("Matrix", "sparseVector", "matrix", "vector")) { +setMethod("%&%", signature(x = .cl, y = "ANY"), + function(x, y) + x %&% (if(length(dim(y)) == 2L) as.matrix else as.vector)(y)) + +setMethod("%&%", signature(x = "ANY", y = .cl), + function(x, y) + (if(length(dim(x)) == 2L) as.matrix else as.vector)(x) %&% y) +} + + +setMethod("%&%", signature(x = "matrix", y = "matrix"), + function(x, y) + .m2sparse(x, "ngC") %&% .m2sparse(y, "ngC")) + +setMethod("%&%", signature(x = "matrix", y = "vector"), + function(x, y) + .m2sparse(x, "ngC") %&% y ) + +setMethod("%&%", signature(x = "vector", y = "matrix"), + function(x, y) + x %&% .m2sparse(y, "ngC")) + +setMethod("%&%", signature(x = "vector", y = "vector"), + function(x, y) { + r <- + if((nx <- length(x)) == 1L) + .m2sparse(x, "ngC") %&% .m2sparse(y, "ngR", trans = TRUE) + else if(nx == length(y)) + ## else if((ny <- length(y)) == 1L || nx == ny) + .m2sparse(x, "ngR", trans = TRUE) %&% .m2sparse(y, "ngC") + else stop("non-conformable arguments") + r@Dimnames <- list(NULL, NULL) + r + }) + + +## .... denseMatrix .................................................... + +setMethod("%&%", signature(x = "denseMatrix", y = "denseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +for(.cl in c("matrix", "vector")) { +setMethod("%&%", signature(x = "denseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = .cl, y = "denseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) +} + + +## .... CsparseMatrix .................................................. + +setMethod("%&%", signature(x = "CsparseMatrix", y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = "CsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = "CsparseMatrix", y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%&%", signature(x = "CsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = .cl, y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) +} -##-------- Work via as(*, lgC) : ------------ -## For multiplication operations, sparseMatrix overrides other method -## selections. Coerce a ndensematrix argument to a nsparseMatrix. -setMethod("%*%", signature(x = "nsparseMatrix", y = "ndenseMatrix"), - function(x, y) x %*% .dense2sparse(y, "C")) - -setMethod("%*%", signature(x = "ndenseMatrix", y = "nsparseMatrix"), - function(x, y) .dense2sparse(x, "C") %*% y) -## and coerce nsparse* to lgC* -setMethod("%*%", signature(x = "nsparseMatrix", y = "nsparseMatrix"), - function(x, y) .M2gen(as(x, "CsparseMatrix")) %*% - .M2gen(as(y, "CsparseMatrix"))) - -## 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) - -## RsparseMatrix -- via CsparseMatrix: -setMethod("%*%", signature(x = "mMatrix", y = "RsparseMatrix"), - function(x, y) x %*% as(y, "CsparseMatrix")) -setMethod("%*%", signature(x = "RsparseMatrix", y = "mMatrix"), - function(x, y) as(x, "CsparseMatrix") %*% 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) -rm(.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)) - -rm(sp.X.sp, v.X.sp) - -###--- II --- crossprod ----------------------------------------------------- - -setMethod("crossprod", signature(x = "dgeMatrix", y = "missing"), - function(x, y = NULL, boolArith=NA, ...) { - if(isTRUE(boolArith)) ## FIXME: very inefficient - crossprod(.dense2sparse(x, "C"), 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .m2sparse(y, ".gC"), - 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(.dense2sparse(x, "C"), 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(.m2dense(x, "dge"), 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(.dense2sparse(x, "C"), 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(.dense2sparse(x, "C"), - .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .m2sparse(y, ".gC"), - 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(.m2sparse(x, ".gC"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .m2sparse(y, ".gC"), - 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"))) +## .... RsparseMatrix .................................................. + +setMethod("%&%", signature(x = "RsparseMatrix", y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) + +setMethod("%&%", signature(x = "RsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) + +setMethod("%&%", signature(x = "RsparseMatrix", y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%&%", signature(x = "RsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) + +setMethod("%&%", signature(x = .cl, y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) +} + + +## .... TsparseMatrix .................................................. + +setMethod("%&%", signature(x = "TsparseMatrix", y = "CsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = "TsparseMatrix", y = "RsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, y, x, TRUE, TRUE, TRUE, TRUE)) + +setMethod("%&%", signature(x = "TsparseMatrix", y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("%&%", signature(x = "TsparseMatrix", y = .cl), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = .cl, y = "TsparseMatrix"), + function(x, y) + .Call(R_sparse_matmult, x, y, FALSE, FALSE, FALSE, TRUE)) +} + + +## .... diagonalMatrix ................................................. + +setMethod("%&%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), + function(x, y) { + r <- new("ndiMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + xu <- x@diag != "N" + yu <- y@diag != "N" + if(xu && yu) + r@diag <- "U" + else + r@x <- + if(xu) + as.logical(y@x) + else if(yu) + as.logical(x@x) + else x@x & y@x + r + }) + +for(.cl in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix", + "denseMatrix", "matrix", "vector")) { +setMethod("%&%", signature(x = "diagonalMatrix", y = .cl), + function(x, y) + .Call(R_diagonal_matmult, x, y, FALSE, FALSE, TRUE)) + +setMethod("%&%", signature(x = .cl, y = "diagonalMatrix"), + function(x, y) + .Call(R_diagonal_matmult, x, y, FALSE, FALSE, TRUE)) +} + + +## .... indMatrix ...................................................... + +setMethod("%&%", signature(x = "indMatrix", y = "indMatrix"), + function(x, y) { + mx <- x@margin + my <- y@margin + px <- x@perm + py <- y@perm + r <- new(if(mx == my) + "indMatrix" + else if(mx == 1L) + "ngeMatrix" + else "ngTMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + if(mx == my) + r@perm <- if(mx == 1L) py[px] else { r@margin <- 2L; px[py] } + else if(mx == 1L) + r@x <- px == rep(py, each = length(px)) + else { + r@i <- px - 1L + r@j <- py - 1L + } + r + }) + +setMethod("%&%", signature(x = "indMatrix", y = "Matrix"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "n") %&% y) + matmultDim(x@Dim, y@Dim, type = 1L) + r <- .M2kind(y[x@perm, , drop = FALSE], "n") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%&%", signature(x = "Matrix", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %&% .M2kind(y, "n")) + matmultDim(x@Dim, y@Dim, type = 1L) + r <- .M2kind(x[, y@perm, drop = FALSE], "n") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%&%", signature(x = "indMatrix", y = "matrix"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "n") %&% y) + matmultDim(x@Dim, dim(y), type = 1L) + r <- .m2dense(y[x@perm, , drop = FALSE], "nge") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%&%", signature(x = "matrix", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %&% .M2kind(y, "n")) + matmultDim(dim(x), y@Dim, type = 1L) + r <- .m2dense(x[, y@perm, drop = FALSE], "nge") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%&%", signature(x = "indMatrix", y = "vector"), + function(x, y) { + if(x@margin != 1L) + return(.M2kind(x, "n") %&% y) + k <- (d <- x@Dim)[2L] + r <- + if(k == length(y)) + .m2dense(y[x@perm], "nge") + else if(k == 1L) + .m2dense(matrix(y, d[1L], length(y), byrow = TRUE), "nge") + else stop("non-conformable arguments") + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r + }) + +setMethod("%&%", signature(x = "vector", y = "indMatrix"), + function(x, y) { + if(y@margin == 1L) + return(x %&% .M2kind(y, "n")) + k <- (d <- y@Dim)[1L] + r <- + if(k == length(x)) + .m2dense(x[y@perm], "nge", trans = TRUE) + else if(k == 1L) + .m2dense(matrix(x, length(x), d[2L]), "nge") + else stop("non-conformable arguments") + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + r + }) + + +## .... pMatrix ........................................................ + +setMethod("%&%", signature(x = "pMatrix", y = "pMatrix"), + function(x, y) { + r <- new("pMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(y@margin == 1L) + y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] + else { + r@margin <- 2L + (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] + } + r + }) + +setMethod("%&%", signature(x = "pMatrix", y = "indMatrix"), + function(x, y) { + r <- new("indMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(y@margin == 1L) + y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] + else { + r@margin <- 2L + (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] + } + r + }) + +setMethod("%&%", signature(x = "indMatrix", y = "pMatrix"), + function(x, y) { + r <- new("indMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 1L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 1L) + r@perm <- + if(x@margin == 1L) + (if(y@margin == 1L) y@perm else invertPerm(y@perm))[x@perm] + else { + r@margin <- 2L + x@perm[if(y@margin == 1L) invertPerm(x@perm) else y@perm] + } + r + }) + +setMethod("%&%", signature(x = "pMatrix", y = "Matrix"), + function(x, y) { + matmultDim(x@Dim, y@Dim, type = 1L) + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .M2kind(y[perm, , drop = FALSE], "n") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%&%", signature(x = "Matrix", y = "pMatrix"), + function(x, y) { + matmultDim(x@Dim, y@Dim, type = 1L) + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .M2kind(x[, perm, drop = FALSE], "n") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%&%", signature(x = "pMatrix", y = "matrix"), + function(x, y) { + matmultDim(x@Dim, dim(y), type = 1L) + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .m2dense(y[perm, , drop = FALSE], "nge") + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 1L) + r + }) + +setMethod("%&%", signature(x = "matrix", y = "pMatrix"), + function(x, y) { + matmultDim(dim(x), y@Dim, type = 1L) + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .m2dense(x[, perm, drop = FALSE], "nge") + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 1L) + r + }) + +setMethod("%&%", signature(x = "pMatrix", y = "vector"), + function(x, y) { + k <- x@Dim[2L] + r <- + if(k == length(y)) { + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + .m2dense(y[perm], "nge") + } + else if(k == 1L) + .m2dense(y, "nge", trans = TRUE) + else stop("non-conformable arguments") + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r + }) + +setMethod("%&%", signature(x = "vector", y = "pMatrix"), + function(x, y) { + k <- y@Dim[1L] + r <- + if(k == length(x)) { + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + .m2dense(x[perm], "nge", trans = TRUE) + } + else if(k == 1L) + .m2dense(x, "nge") + else stop("non-conformable arguments") + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + r + }) + + +## .... sparseVector ................................................... + +setMethod("%&%", signature(x = "sparseVector", y = "sparseVector"), + function(x, y) { + x <- .V2kind(.drop0(x, isM = FALSE), "n") + y <- .V2kind(.drop0(y, isM = FALSE), "n") + if((nx <- length(x)) == 1L) { + if(length(x@i) == 0L) + y@i <- integer(0L) + .tCRT(.V2C(y)) + } else if(nx == length(y)) + ## } else if((ny <- length(y)) == 1L) { + ## if(length(y@i)) + ## x@i <- integer(0L) + ## .V2C(x) + ## } else if(nx == ny) + .m2sparse(any(match(x@i, y@i, 0L)), "ngR") + else stop("non-conformable arguments") + }) + +for(.cl in c("Matrix", "matrix")) { +setMethod("%&%", signature(x = "sparseVector", y = .cl), + function(x, y) { + x <- .V2kind(.drop0(x, isM = FALSE), "n") + if((k <- dim(y)[1L]) == length(x)) + .tCRT(.V2C(x)) %&% y + else if(k == 1L) + .V2C(x) %&% y + else stop("non-conformable arguments") + }) + +setMethod("%&%", signature(x = .cl, y = "sparseVector"), + function(x, y) { + y <- .V2kind(.drop0(y, isM = FALSE), "n") + if((k <- dim(x)[2L]) == length(y)) + x %&% .V2C(y) + else if(k == 1L) + x %&% .tCRT(.V2C(y)) + else stop("non-conformable arguments") + }) +} + +setMethod("%&%", signature(x = "sparseVector", y = "vector"), + function(x, y) + .V2kind(.drop0(x, isM = FALSE), "n") %&% .m2V(y, "n")) + +setMethod("%&%", signature(x = "vector", y = "sparseVector"), + function(x, y) + .m2V(x, "n") %&% .V2kind(.drop0(y, isM = FALSE), "n")) + + +## METHODS FOR GENERIC: crossprod +## NB: t(x) %*% y == t(t(y) %*% x) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +for(.cl in c("Matrix", "sparseVector")) { +setMethod("crossprod", signature(x = .cl, y = "ANY"), + function(x, y = NULL, ...) + crossprod(x, (if(length(dim(y)) == 2L) as.matrix else as.vector)(y), ...)) + +setMethod("crossprod", signature(x = "ANY", y = .cl), + function(x, y = NULL, ...) + crossprod((if(length(dim(x)) == 2L) as.matrix else as.vector)(x), y, ...)) +} + + +## .... denseMatrix .................................................... + +setMethod("crossprod", signature(x = "denseMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" else boolArith) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, TRUE, FALSE)) + +setMethod("crossprod", signature(x = "denseMatrix", y = "denseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" && .M.kind(y) == "n" else boolArith) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, TRUE, FALSE)) + +for(.cl in c("matrix", "vector")) { +setMethod("crossprod", signature(x = "denseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, TRUE, FALSE)) + +setMethod("crossprod", signature(x = .cl, y = "denseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, TRUE, FALSE)) +} + + +## .... CsparseMatrix .................................................. setMethod("crossprod", signature(x = "CsparseMatrix", y = "missing"), - function(x, y = NULL, boolArith=NA, ...) - .Call(Csparse_crossprod, x, trans = FALSE, boolArith=boolArith)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) setMethod("crossprod", signature(x = "CsparseMatrix", y = "CsparseMatrix"), - function(x, y = NULL, boolArith = NA, ...) - .Call(Csparse_Csparse_crossprod, x, y, trans = FALSE, boolArith=boolArith)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = "CsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = "CsparseMatrix", y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("crossprod", signature(x = "CsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = .cl, y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, boolArith)) +} + + +## .... RsparseMatrix .................................................. + +setMethod("crossprod", signature(x = "RsparseMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, TRUE, boolArith)) + +setMethod("crossprod", signature(x = "RsparseMatrix", y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, boolArith)) + +setMethod("crossprod", signature(x = "RsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, boolArith)) + +setMethod("crossprod", signature(x = "RsparseMatrix", y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, boolArith)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("crossprod", signature(x = "RsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = .cl, y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, 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, .dense2sparse(y, "C"), 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, .m2sparse(y, ".gC"), 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, " ")) +## .... TsparseMatrix .................................................. setMethod("crossprod", signature(x = "TsparseMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) - .Call(Csparse_crossprod, x, trans = FALSE, boolArith=boolArith)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = "TsparseMatrix", y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = "TsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) -setMethod("crossprod", signature(x = "TsparseMatrix", y = "ANY"), - function(x, y = NULL, boolArith = NA, ...) - crossprod(.M2C(x), y, boolArith=boolArith, ...)) -setMethod("crossprod", signature(x = "ANY", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(x, .M2C(y), boolArith=boolArith, ...)) -setMethod("crossprod", signature(x = "TsparseMatrix", y = "Matrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.M2C(x), y, boolArith=boolArith, ...)) -setMethod("crossprod", signature(x = "Matrix", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(x, .M2C(y), boolArith=boolArith, ...)) setMethod("crossprod", signature(x = "TsparseMatrix", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.M2C(x), .M2C(y), boolArith=boolArith, ...)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("crossprod", signature(x = "TsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, TRUE, FALSE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = .cl, y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, TRUE, FALSE, TRUE, boolArith)) +} + + +## .... diagonalMatrix ................................................. + +setMethod("crossprod", signature(x = "diagonalMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) { + boolArith <- !is.na(boolArith) && boolArith + r <- new(if(boolArith) "ndiMatrix" else "ddiMatrix") + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames[c(2L, 2L)] + if(x@diag != "N") + r@diag <- "U" + else { + xii <- x@x + r@x <- + if(boolArith) + as.logical(xii) + else { + if(.M.kind(x) == "n" && anyNA(xii)) + xii <- xii | is.na(xii) + as.double(xii * xii) + } + } + r + }) + +setMethod("crossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), + function(x, y = NULL, boolArith = NA, ...) + (if(!is.na(boolArith) && boolArith) `%&%` else `%*%`)(t(x), y)) + +for(.cl in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix", + "denseMatrix", "matrix", "vector")) { +setMethod("crossprod", signature(x = "diagonalMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_diagonal_matmult, x, y, TRUE, FALSE, boolArith)) + +setMethod("crossprod", signature(x = .cl, y = "diagonalMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_diagonal_matmult, x, y, TRUE, FALSE, boolArith)) +} + + +## .... indMatrix ...................................................... + +setMethod("crossprod", signature(x = "indMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) { + if(x@margin != 1L) + return(tcrossprod(t(x), boolArith = boolArith, ...)) + boolArith <- !is.na(boolArith) && boolArith + tt <- tabulate(x@perm, x@Dim[2L]) + r <- new(if(boolArith) "ndiMatrix" else "ddiMatrix") + r@Dim <- x@Dim[c(2L, 2L)] + r@Dimnames <- x@Dimnames[c(2L, 2L)] + r@x <- if(boolArith) as.logical(tt) else as.double(tt) + r + }) + +for(.cl in c("Matrix", "matrix", "vector")) +setMethod("crossprod", signature(x = "indMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + (if(!is.na(boolArith) && boolArith) `%&%` else `%*%`)(t(x), y)) + +setMethod("crossprod", signature(x = "Matrix", y = "indMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, y@Dim, type = 2L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + if(y@margin == 1L) + r <- crossprod(x, .M2kind(y, l), boolArith = boolArith, ...) + else { + r <- .M2kind(t(x)[, y@perm, drop = FALSE], l) + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 2L) + } + r + }) + +setMethod("crossprod", signature(x = "matrix", y = "indMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(dim(x), y@Dim, type = 2L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + if(y@margin == 1L) + r <- crossprod(x, .M2kind(y, l), boolArith = boolArith, ...) + else { + r <- .m2dense(t(x)[, y@perm, drop = FALSE], paste0(l, "ge")) + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 2L) + } + r + }) + +setMethod("crossprod", signature(x = "vector", y = "indMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + if(y@Dim[1L] != length(x)) + stop("non-conformable arguments") + l <- if(!is.na(boolArith) && boolArith) "n" else "," + if(y@margin == 1L) + r <- crossprod(x, .M2kind(y, l), boolArith = boolArith, ...) + else { + r <- .m2dense(x[y@perm], paste0(l, "ge"), trans = TRUE) + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + } + r + }) + + +## .... pMatrix ........................................................ + +setMethod("crossprod", signature(x = "pMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) { + boolArith <- !is.na(boolArith) && boolArith + r <- new(if(boolArith) "ndiMatrix" else "ddiMatrix") + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames[c(2L, 2L)] + r@diag <- "U" + r + }) + +setMethod("crossprod", signature(x = "pMatrix", y = "pMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + r <- new("pMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 2L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 2L) + r@perm <- + if(y@margin == 1L) + y@perm[if(x@margin == 1L) invertPerm(x@perm) else x@perm] + else { + r@margin <- 2L + (if(x@margin == 1L) x@perm else invertPerm(x@perm))[y@perm] + } + r + }) + +setMethod("crossprod", signature(x = "Matrix", y = "pMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, y@Dim, type = 2L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .M2kind(t(x)[, perm, drop = FALSE], l) + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 2L) + r + }) + +setMethod("crossprod", signature(x = "matrix", y = "pMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(dim(x), y@Dim, type = 2L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .m2dense(t(x)[, perm, drop = FALSE], paste0(l, "ge")) + r@Dimnames <- matmultDN(dimnames(x), y@Dimnames, type = 2L) + r + }) + +setMethod("crossprod", signature(x = "vector", y = "pMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + if(y@Dim[1L] != length(x)) + stop("non-conformable arguments") + l <- if(!is.na(boolArith) && boolArith) "n" else "," + perm <- if(y@margin == 1L) invertPerm(y@perm) else y@perm + r <- .m2dense(x[perm], paste0(l, "ge"), trans = TRUE) + r@Dimnames <- c(list(NULL), y@Dimnames[2L]) + r + }) + + +## .... sparseVector ................................................... -setMethod("crossprod", signature(x = "dsparseMatrix", y = "ddenseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - if(isTRUE(boolArith)) - crossprod(as(x, "CsparseMatrix"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), 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(.dense2sparse(x, "C"), 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, .dense2sparse(y, "C"), 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"), .dense2sparse(y, "C"), - 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, .dense2sparse(y, "C"), boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "ldenseMatrix", y = "lsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.dense2sparse(x, "C"), y, boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "lsparseMatrix", y = "lsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.M2gen(as(x, "CsparseMatrix")), - .M2gen(as(y, "CsparseMatrix")), - boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "nsparseMatrix", y = "ndenseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(x, .dense2sparse(y, "C"), boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "ndenseMatrix", y = "nsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.dense2sparse(x, "C"), y, boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "nsparseMatrix", y = "nsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - crossprod(.M2gen(as(x, "CsparseMatrix")), - .M2gen(as(y, "CsparseMatrix")), - boolArith=boolArith, ...)) - -setMethod("crossprod", signature(x = "ddenseMatrix", y = "CsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - if(isTRUE(boolArith)) - crossprod(.dense2sparse(x, "C"), 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(.m2sparse(x, ".gC"), 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, ...)) + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" else boolArith) { + if(!is.na(boolArith)) + x <- .V2kind(.drop0(x, isM = FALSE), "n") + .m2sparse(length(x@i) > 0L, "nsR") + } else .m2sparse(sum(x * x), ",sR")) + +setMethod("crossprod", signature(x = "sparseVector", y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" && .M.kind(y) == "n" else boolArith) { + if(!is.na(boolArith)) { + x <- .V2kind(.drop0(x, isM = FALSE), "n") + y <- .V2kind(.drop0(y, isM = FALSE), "n") + } + if((nx <- length(x)) == 1L) { + if(length(x@i) == 0L) + y@i <- integer(0L) + .tCRT(.V2C(y)) + } else if(nx == length(y)) + .m2sparse(any(match(x@i, y@i, 0L)), "ngR") + else stop("non-conformable arguments") + } else { + if((nx <- length(x)) == 1L) + .tCRT(.V2C(x * y)) + else if(nx == length(y)) + .m2sparse(sum(x * y), ",gR") + else stop("non-conformable arguments") + }) + +for(.cl in c("Matrix", "matrix")) { +setMethod("crossprod", signature(x = "sparseVector", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + crossprod(.tCRT(.V2C(x)), y, boolArith = boolArith, ...)) + +setMethod("crossprod", signature(x = .cl, y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) + if(dim(x)[1L] == length(y)) + crossprod(x, .V2C(y) , boolArith = boolArith, ...) + else + crossprod(x, .tCRT(.V2C(y)), boolArith = boolArith, ...)) +} -rm(sp.T.sp, v.T.sp) +setMethod("crossprod", signature(x = "sparseVector", y = "vector"), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) { + x <- .V2kind(.drop0(x, isM = FALSE), "n") + y <- .m2V(y, "n") + if((nx <- length(x)) == 1L) { + if(length(x@i) == 0L) + y@i <- integer(0L) + .tCRT(.V2C(y)) + } else if(nx == length(y)) + .m2sparse(any(match(x@i, y@i, 0L)), "ngR") + else stop("non-conformable arguments") + } else { + if((nx <- length(x)) == 1L) + .m2dense(.V2v(x * y), ",ge", trans = TRUE) + else if(nx == length(y)) + .m2dense(sum(x * y), ",ge") + else stop("non-conformable arguments") + }) + +setMethod("crossprod", signature(x = "vector", y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) { + x <- .m2V(x, "n") + y <- .V2kind(.drop0(y, isM = FALSE), "n") + if((nx <- length(x)) == 1L) { + if(length(x@i) == 0L) + y@i <- integer(0L) + .tCRT(.V2C(y)) + } else if(nx == length(y)) + .m2sparse(any(match(x@i, y@i, 0L)), "ngR") + else stop("non-conformable arguments") + } else { + if((nx <- length(x)) == 1L) + .m2dense(.V2v(x * y), ",ge", trans = TRUE) + else if(nx == length(y)) + .m2dense(sum(x * y), ",ge") + else stop("non-conformable arguments") + }) + + +## METHODS FOR GENERIC: tcrossprod +## NB: x %*% t(y) == t(y %*% t(x)) +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +for(.cl in c("Matrix", "sparseVector")) { +setMethod("tcrossprod", signature(x = .cl, y = "ANY"), + function(x, y = NULL, ...) + tcrossprod(x, (if(length(dim(y)) == 2L) as.matrix else as.vector)(y), ...)) + +setMethod("tcrossprod", signature(x = "ANY", y = .cl), + function(x, y = NULL, ...) + tcrossprod((if(length(dim(x)) == 2L) as.matrix else as.vector)(x), y, ...)) +} -## 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) - -## RsparseMatrix -- via CsparseMatrix: -for(mClass in c("mMatrix", "ANY")) { - setMethod("crossprod", signature(x = mClass, y = "RsparseMatrix"), - function(x, y, boolArith=NA, ...) - crossprod(x, as(y, "CsparseMatrix"), - boolArith=boolArith, ...)) - setMethod("crossprod", signature(x = "RsparseMatrix", y = mClass), - function(x, y, boolArith=NA, ...) - crossprod(as(x, "CsparseMatrix"), y, - boolArith=boolArith, ...)) -} -rm(mClass) - -## 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .m2sparse(y, ".gC"), - 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(.dense2sparse(x, "C"), 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(.m2dense(x, "dge"), 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(.dense2sparse(x, "C"), 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(.dense2sparse(x, "C"), 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(.dense2sparse(x, "C"), - .dense2sparse(y, "C"), - boolArith=TRUE) - else - .Call(geMatrix_geMatrix_crossprod, x, y, TRUE)) -} -rm(c.x, c.y) - -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(.m2sparse(x, ".gC"), 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(.M2gen(x), boolArith=boolArith, ...)) - - -setMethod("tcrossprod", signature(x = "dtrMatrix", y = "dtrMatrix"), - function(x, y=NULL, boolArith=NA, ...) - if(isTRUE(boolArith)) ## FIXME: very inefficient - tcrossprod(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.m2sparse(x, ".gC"), .dense2sparse(y, "C"), - 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(.dense2sparse(x, "C"), .dense2sparse(y, "C"), - 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(.m2sparse(x, ".gC"), .dense2sparse(y, "C"), - boolArith=TRUE) - else - .Call(dtpMatrix_matrix_mm, y, x, TRUE, TRUE)) -}# FALSE +## .... denseMatrix .................................................... +setMethod("tcrossprod", signature(x = "denseMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" else boolArith) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, FALSE, TRUE)) -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 = "denseMatrix", y = "denseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + if(if(is.na(boolArith)) .M.kind(x) == "n" && .M.kind(y) == "n" else boolArith) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, FALSE, TRUE)) -setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) - .Call(Csparse_crossprod, x, trans = TRUE, boolArith=boolArith)) +for(.cl in c("matrix", "vector")) { +setMethod("tcrossprod", signature(x = "denseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, TRUE) + else + .Call(R_dense_matmult, x, y, FALSE, TRUE)) -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, .dense2sparse(y, "C"), 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(.dense2sparse(x, "C"), y, boolArith=TRUE) +setMethod("tcrossprod", signature(x = .cl, y = "denseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + if(!is.na(boolArith) && boolArith) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, TRUE) else - .Call(Csparse_dense_prod, y, x, "B")) + .Call(R_dense_matmult, x, y, FALSE, TRUE)) +} + +## .... CsparseMatrix .................................................. + +setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("tcrossprod", signature(x = "CsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = .cl, y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) } -rm(dmat) -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(.dense2sparse(x, "C"), y, boolArith=TRUE) - else - .Call(Csparse_dense_prod, y, x, "B") -} -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) + +## .... RsparseMatrix .................................................. + +setMethod("tcrossprod", signature(x = "RsparseMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, TRUE, boolArith)) + +setMethod("tcrossprod", signature(x = "RsparseMatrix", y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) + +setMethod("tcrossprod", signature(x = "RsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) + +setMethod("tcrossprod", signature(x = "RsparseMatrix", y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) + +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("tcrossprod", signature(x = "RsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = .cl, y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) } -rm(.sCMatrix, tcr.dd.sC) + + +## .... TsparseMatrix .................................................. setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "missing"), - function(x, y = NULL, boolArith = NA, ...) - .Call(Csparse_crossprod, x, trans = TRUE, boolArith=boolArith)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "CsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "RsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) -setMethod("tcrossprod", signature(x = "ANY", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - tcrossprod(x, .M2C(y), boolArith=boolArith, ...)) -setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "ANY"), - function(x, y=NULL, boolArith=NA, ...) - tcrossprod(.M2C(x), y, boolArith=boolArith, ...)) -setMethod("tcrossprod", signature(x = "Matrix", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - tcrossprod(x, .M2C(y), boolArith=boolArith, ...)) -setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "Matrix"), - function(x, y=NULL, boolArith=NA, ...) - tcrossprod(.M2C(x), y, boolArith=boolArith, ...)) setMethod("tcrossprod", signature(x = "TsparseMatrix", y = "TsparseMatrix"), - function(x, y=NULL, boolArith=NA, ...) - tcrossprod(.M2C(x), .M2C(y), boolArith=boolArith, ...)) + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) +for(.cl in c("denseMatrix", "matrix", "vector")) { +setMethod("tcrossprod", signature(x = "TsparseMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, x, y, FALSE, TRUE, FALSE, boolArith)) + +setMethod("tcrossprod", signature(x = .cl, y = "TsparseMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_sparse_matmult, y, x, FALSE, TRUE, TRUE, boolArith)) +} + + +## .... diagonalMatrix ................................................. + +setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) { + boolArith <- !is.na(boolArith) && boolArith + r <- new(if(boolArith) "ndiMatrix" else "ddiMatrix") + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames[c(1L, 1L)] + if(x@diag != "N") + r@diag <- "U" + else { + xii <- x@x + r@x <- + if(boolArith) + as.logical(xii) + else { + if(.M.kind(x) == "n" && anyNA(xii)) + xii <- xii | is.na(xii) + as.double(xii * xii) + } + } + r + }) + +setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "diagonalMatrix"), + function(x, y = NULL, boolArith = NA, ...) + (if(!is.na(boolArith) && boolArith) `%&%` else `%*%`)(x, t(y))) + +for(.cl in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix", + "denseMatrix", "matrix", "vector")) { +setMethod("tcrossprod", signature(x = "diagonalMatrix", y = .cl), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_diagonal_matmult, x, y, FALSE, TRUE, boolArith)) + +setMethod("tcrossprod", signature(x = .cl, y = "diagonalMatrix"), + function(x, y = NULL, boolArith = NA, ...) + .Call(R_diagonal_matmult, x, y, FALSE, TRUE, boolArith)) +} + + +## .... indMatrix ...................................................... + +setMethod("tcrossprod", signature(x = "indMatrix", y = "missing"), + function(x, y = NULL, boolArith = TRUE, ...) { + if(x@margin != 1L) + return(crossprod(t(x), boolArith = boolArith, ...)) + boolArith <- !is.na(boolArith) && boolArith + r <- new(if(boolArith) "ngeMatrix" else "dgeMatrix") + r@Dim <- x@Dim[c(1L, 1L)] + r@Dimnames <- x@Dimnames[c(1L, 1L)] + r@x <- as.vector(`storage.mode<-`( + .M2m(x), if(boolArith) "logical" else "double")[, x@perm]) + r + }) + +for(.cl in c("Matrix", "matrix", "vector")) +setMethod("tcrossprod", signature(x = .cl, y = "indMatrix"), + function(x, y = NULL, boolArith = NA, ...) + (if(!is.na(boolArith) && boolArith) `%&%` else `%*%`)(x, t(y))) + +setMethod("tcrossprod", signature(x = "indMatrix", y = "Matrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, y@Dim, type = 3L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + if(y@margin != 1L) + r <- tcrossprod(.M2kind(x, l), y, boolArith = boolArith, ...) + else { + r <- .M2kind(t(y)[x@perm, , drop = FALSE], l) + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 3L) + } + r + }) + +setMethod("tcrossprod", signature(x = "indMatrix", y = "matrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, dim(y), type = 3L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + if(y@margin != 1L) + r <- tcrossprod(.M2kind(x, l), y, boolArith = boolArith, ...) + else { + r <- .m2dense(t(y)[x@perm, , drop = FALSE], paste0(l, "ge")) + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 3L) + } + r + }) + +setMethod("tcrossprod", signature(x = "indMatrix", y = "vector"), + function(x, y = NULL, boolArith = NA, ...) { + d <- x@Dim + m <- d[1L] + k <- d[2L] + if(k != (if(m == 1L) length(y) else 1L)) + stop("non-conformable arguments") + boolArith <- !is.na(boolArith) && boolArith + h <- if(boolArith) isN0 else as.double + r <- new(if(boolArith) "ngeMatrix" else "dgeMatrix") + r@Dim <- d <- c(m, if(m == 1L) 1L else length(y)) + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r@x <- + if(m == 1L) { + if(x@margin == 1L) + h(y[x@perm]) + else (if(boolArith) any else sum)(h(y)) + } else { + if(x@margin == 1L) + as.vector(matrix(h(y), m, length(y), byrow = TRUE)) + else { + tmp <- array(if(boolArith) FALSE else 0, d) + tmp[y@perm, ] <- h(y) + dim(tmp) <- NULL + tmp + } + } + r + }) + + +## .... pMatrix ........................................................ + +setMethod("tcrossprod", signature(x = "pMatrix", y = "missing"), + function(x, y = NULL, boolArith = NA, ...) { + boolArith <- !is.na(boolArith) && boolArith + r <- new(if(boolArith) "ndiMatrix" else "ddiMatrix") + r@Dim <- x@Dim + r@Dimnames <- x@Dimnames[c(1L, 1L)] + r@diag <- "U" + r + }) + +setMethod("tcrossprod", signature(x = "pMatrix", y = "pMatrix"), + function(x, y = NULL, boolArith = NA, ...) { + r <- new("pMatrix") + r@Dim <- matmultDim(x@Dim, y@Dim, type = 2L) + r@Dimnames <- matmultDN(x@Dimnames, y@Dimnames, type = 2L) + r@perm <- + if(y@margin != 1L) + y@perm[if(x@margin == 1L) x@perm else invertPerm(x@perm)] + else { + r@margin <- 2L + (if(x@margin == 1L) invertPerm(x@perm) else x@perm)[y@perm] + } + r + }) + +setMethod("tcrossprod", signature(x = "pMatrix", y = "Matrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, y@Dim, type = 3L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .M2kind(t(y)[perm, , drop = FALSE], l) + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 3L) + r + }) + +setMethod("tcrossprod", signature(x = "pMatrix", y = "matrix"), + function(x, y = NULL, boolArith = NA, ...) { + matmultDim(x@Dim, dim(y), type = 3L) + l <- if(!is.na(boolArith) && boolArith) "n" else "," + perm <- if(x@margin == 1L) x@perm else invertPerm(x@perm) + r <- .m2dense(t(y)[perm, , drop = FALSE], paste0(l, "ge")) + r@Dimnames <- matmultDN(x@Dimnames, dimnames(y), type = 3L) + r + }) + +setMethod("tcrossprod", signature(x = "pMatrix", y = "vector"), + function(x, y = NULL, boolArith = NA, ...) { + if(x@Dim[2L] != 1L || length(y) != 1L) + stop("non-conformable arguments") + l <- if(!is.na(boolArith) && boolArith) "n" else "," + r <- .m2dense(y, paste0(l, "ge"), trans = TRUE) + r@Dimnames <- c(x@Dimnames[1L], list(NULL)) + r + }) + + +## .... sparseVector ................................................... -## "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) - } - }) - - -## RsparseMatrix -- via CsparseMatrix: -for(mClass in c("mMatrix", "ANY")) { - setMethod("tcrossprod", signature(x = mClass, y = "RsparseMatrix"), - function(x, y, boolArith=NA, ...) - tcrossprod(x, as(y, "CsparseMatrix"), - boolArith=boolArith, ...)) - setMethod("tcrossprod", signature(x = "RsparseMatrix", y = mClass), - function(x, y, boolArith=NA, ...) - tcrossprod(as(x, "CsparseMatrix"), y, - boolArith=boolArith, ...)) -} -rm(mClass) - - -## 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 + function(x, y = NULL, boolArith = NA, ...) + tcrossprod(.V2C(x), boolArith = boolArith, ...)) -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 --- NB: These are *not* sufficient: sparse d* and l* need to drop0() or use do(.., drop0=TRUE) -## 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")) -## ==> restrict signatures to *dense* -setMethod("%&%", signature(x = "matrix", y = "matrix"), - function(x, y) as(x, "nMatrix") %&% as(y, "nMatrix")) -setMethod("%&%", signature(x = "Matrix", y = "Matrix"), - function(x, y) as(x, "denseMatrix") %&% as(y, "denseMatrix")) -setMethod("%&%", signature(x = "denseMatrix", y = "denseMatrix"), - function(x, y) as(x, "nMatrix") %&% as(y, "nMatrix")) -## ensure drop0() happens (*efficiently*) for sparse matrices: -for(c1 in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix")) { - if(c1 == "CsparseMatrix") - for(c2 in c("RsparseMatrix", "TsparseMatrix")) - setMethod("%&%", signature(x = c1, y = c2), - function(x, y) .M2kind(.drop0(x), "n") %&% - as(.M2kind(.drop0(y), "n"), "CsparseMatrix")) - else # c1 = "R..." or "T..." - for(c2 in c("CsparseMatrix", "RsparseMatrix", "TsparseMatrix")) - setMethod("%&%", signature(x = c1, y = c2), - function(x, y) as(.M2kind(.drop0(x), "n"), "CsparseMatrix") %&% - as(.M2kind(.drop0(y), "n"), "CsparseMatrix")) - ## FIXME? coercion to 'CsparseMatrix' is too bossy; need one of C,R,T however : - setMethod("%&%", signature(x = "mMatrix", y = c1), - function(x, y) .M2kind(.drop0(as(x, "CsparseMatrix")), "n") %&% - .M2kind(.drop0(y), "n")) - setMethod("%&%", signature(x = c1, y = "mMatrix"), - function(x, y) .M2kind(.drop0(x), "n") %&% - .M2kind(.drop0(as(y, "CsparseMatrix")), "n")) -} -rm(c1,c2) - -## 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) - -rm(sp.bX.sp, 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)) - -rm(.M.v, .v.M, .M.vt, .v.Mt) - -## Local variables: -## mode: R -## page-delimiter: "^###---" -## End: +setMethod("tcrossprod", signature(x = "sparseVector", y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) + (if(if(is.na(boolArith)) .M.kind(x) == "n" && .M.kind(y) == "n" else boolArith) `%&%` else `%*%`)(x, .tCRT(.V2C(y)))) + +for(.cl in c("Matrix", "matrix")) { +setMethod("tcrossprod", signature(x = "sparseVector", y = .cl), + function(x, y = NULL, boolArith = NA, ...) { + x <- if(dim(y)[2L] == length(x)) .tCRT(.V2C(x)) else .V2C(x) + tcrossprod(x, y, boolArith = boolArith, ...) + }) + +setMethod("tcrossprod", signature(x = .cl, y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) { + y <- if(dim(x)[1L] == 1L) .tCRT(.V2C(y)) else .V2C(y) + tcrossprod(x, y, boolArith = boolArith, ...) + }) +} + +setMethod("tcrossprod", signature(x = "sparseVector", y = "vector"), + function(x, y = NULL, boolArith = NA, ...) { + r <- + if(!is.na(boolArith) && boolArith) + x %&% .m2sparse(y, "ngR", trans = TRUE) + else + x %*% .m2dense (y, ",ge", trans = TRUE) + r@Dimnames <- list(NULL, NULL) + r + }) + +setMethod("tcrossprod", signature(x = "vector", y = "sparseVector"), + function(x, y = NULL, boolArith = NA, ...) + (if(!is.na(boolArith) && boolArith) `%&%` else `%*%`)(x, .tCRT(.V2C(y)))) + +rm(.cl) diff -Nru rmatrix-1.6-1.1/R/qr.R rmatrix-1.6-5/R/qr.R --- rmatrix-1.6-1.1/R/qr.R 2023-07-30 19:36:55.000000000 +0000 +++ rmatrix-1.6-5/R/qr.R 2023-09-22 19:22:19.000000000 +0000 @@ -8,14 +8,15 @@ .qr.rank.def.warn <- function(qr) { if(m0 <- qr@V@Dim[1L] - qr@Dim[1L]) - warning(gettextf("matrix is structurally rank deficient; using augmented matrix with additional %d row(s) of zeros", m0), + warning(gettextf("matrix is structurally rank deficient; using augmented matrix with additional %d row(s) of zeros", + m0), domain = NA) m0 } setMethod("qr", signature(x = "sparseMatrix"), function(x, ...) - qr(.M2gen(as(x, "CsparseMatrix"), "d"), ...)) + qr(.M2gen(.M2C(x), ","), ...)) setMethod("qr", signature(x = "dgCMatrix"), function(x, order = 3L, ...) { @@ -56,7 +57,9 @@ "Q1" = .Call(sparseQR_matmult, x, NULL, 6L, FALSE, NULL), "R" = R, "R1" = triu(if(m == n) R else R[seq_len(n), , drop = FALSE]), - stop("'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or \"R1\"")) + stop(gettextf("'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", \"%3$s1\", \"%4$s\", or \"%4$s1\"", + "which", "P", "Q", "R"), + domain = NA)) }) ## returning list(P1', Q, R, P2'), where A = P1' Q R P2' @@ -99,7 +102,8 @@ else { storage.mode(Dvec) <- "double" if(length(Dvec) != qr@V@Dim[if(complete) 1L else 2L]) - stop("'Dvec' has the wrong length") + stop(gettextf("'%s' has the wrong length", "Dvec"), + domain = NA) } Q <- .Call(sparseQR_matmult, qr, NULL, 4L, complete, Dvec) dn <- c(qr@Dimnames[1L], list(NULL)) @@ -169,13 +173,16 @@ else { ncol <- as.integer(ncol) if(ncol < 0L || ncol > m) - stop(gettextf("invalid 'ncol': not in 0:%d", m), + stop(gettextf("invalid '%s': not in %d:%d", + "ncol", 0L, m), domain = NA) } p2 <- qr@q + 1L p2.uns <- is.unsorted(p2, strictly = TRUE) # FALSE if length is 0 if(p2.uns && ncol < n) - stop("need larger value of 'ncol' as pivoting occurred") + stop(gettextf("need greater '%s' as pivoting occurred", + "ncol"), + domain = NA) else if(ncol < n) R <- R[, seq_len(ncol), drop = FALSE] else if(ncol > n) { @@ -234,17 +241,17 @@ r }) -setMethod("qr.coef", signature(qr = "sparseQR", y = "numLike"), +setMethod("qr.coef", signature(qr = "sparseQR", y = "vector"), function(qr, y) - drop(qr.coef(qr, .m2dense(y, "dge")))) + drop(qr.coef(qr, .m2dense(y, ",ge")))) setMethod("qr.coef", signature(qr = "sparseQR", y = "matrix"), function(qr, y) - qr.coef(qr, .m2dense(y, "dge"))) + qr.coef(qr, .m2dense(y, ",ge"))) setMethod("qr.coef", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) - qr.coef(qr, .m2dense(as(y, "matrix"), "dge"))) + qr.coef(qr, .m2dense(.M2m(y), ",ge"))) setMethod("qr.fitted", signature(qr = "sparseQR", y = "dgeMatrix"), function(qr, y, k = qr$rank) { @@ -257,17 +264,17 @@ r }) -setMethod("qr.fitted", signature(qr = "sparseQR", y = "numLike"), +setMethod("qr.fitted", signature(qr = "sparseQR", y = "vector"), function(qr, y, k = qr$rank) - drop(qr.fitted(qr, .m2dense(y, "dge")))) + drop(qr.fitted(qr, .m2dense(y, ",ge")))) setMethod("qr.fitted", signature(qr = "sparseQR", y = "matrix"), function(qr, y, k = qr$rank) - qr.fitted(qr, .m2dense(y, "dge"))) + qr.fitted(qr, .m2dense(y, ",ge"))) setMethod("qr.fitted", signature(qr = "sparseQR", y = "Matrix"), function(qr, y, k = qr$rank) - qr.fitted(qr, .m2dense(as(y, "matrix"), "dge"))) + qr.fitted(qr, .m2dense(.M2m(y), ",ge"))) setMethod("qr.resid", signature(qr = "sparseQR", y = "dgeMatrix"), function(qr, y) { @@ -280,17 +287,17 @@ r }) -setMethod("qr.resid", signature(qr = "sparseQR", y = "numLike"), +setMethod("qr.resid", signature(qr = "sparseQR", y = "vector"), function(qr, y) - drop(qr.resid(qr, .m2dense(y, "dge")))) + drop(qr.resid(qr, .m2dense(y, ",ge")))) setMethod("qr.resid", signature(qr = "sparseQR", y = "matrix"), function(qr, y) - qr.resid(qr, .m2dense(y, "dge"))) + qr.resid(qr, .m2dense(y, ",ge"))) setMethod("qr.resid", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) - qr.resid(qr, .m2dense(as(y, "matrix"), "dge"))) + qr.resid(qr, .m2dense(.M2m(y), ",ge"))) setMethod("qr.qty", signature(qr = "sparseQR", y = "dgeMatrix"), function(qr, y) { @@ -303,17 +310,17 @@ r }) -setMethod("qr.qty", signature(qr = "sparseQR", y = "numLike"), +setMethod("qr.qty", signature(qr = "sparseQR", y = "vector"), function(qr, y) - drop(qr.qty(qr, .m2dense(y, "dge")))) + drop(qr.qty(qr, .m2dense(y, ",ge")))) setMethod("qr.qty", signature(qr = "sparseQR", y = "matrix"), function(qr, y) - qr.qty(qr, .m2dense(y, "dge"))) + qr.qty(qr, .m2dense(y, ",ge"))) setMethod("qr.qty", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) - qr.qty(qr, .m2dense(as(y, "matrix"), "dge"))) + qr.qty(qr, .m2dense(.M2m(y), ",ge"))) setMethod("qr.qy", signature(qr = "sparseQR", y = "dgeMatrix"), function(qr, y) { @@ -334,14 +341,14 @@ r }) -setMethod("qr.qy", signature(qr = "sparseQR", y = "numLike"), +setMethod("qr.qy", signature(qr = "sparseQR", y = "vector"), function(qr, y) - drop(qr.qy(qr, .m2dense(y, "dge")))) + drop(qr.qy(qr, .m2dense(y, ",ge")))) setMethod("qr.qy", signature(qr = "sparseQR", y = "matrix"), function(qr, y) - qr.qy(qr, .m2dense(y, "dge"))) + qr.qy(qr, .m2dense(y, ",ge"))) setMethod("qr.qy", signature(qr = "sparseQR", y = "Matrix"), function(qr, y) - qr.qy(qr, .m2dense(as(y, "matrix"), "dge"))) + qr.qy(qr, .m2dense(.M2m(y), ",ge"))) diff -Nru rmatrix-1.6-1.1/R/rankMatrix.R rmatrix-1.6-5/R/rankMatrix.R --- rmatrix-1.6-1.1/R/rankMatrix.R 2020-12-24 06:48:12.000000000 +0000 +++ rmatrix-1.6-5/R/rankMatrix.R 2023-10-25 15:50:21.000000000 +0000 @@ -37,9 +37,7 @@ ## 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")) + diagR <- abs(diagR) # sign( diag(R) ) are *not* coerced to positive ## declare those entries to be zero that are < tol*max(.) if((mdi <- max(diagR, na.rm=TRUE)) > 0) { if(!is.numeric(tol)) { diff -Nru rmatrix-1.6-1.1/R/rcond.R rmatrix-1.6-5/R/rcond.R --- rmatrix-1.6-1.1/R/rcond.R 2023-07-30 19:48:51.000000000 +0000 +++ rmatrix-1.6-5/R/rcond.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,169 +0,0 @@ -## METHODS FOR GENERIC: rcond -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("rcond", signature(x = "ANY", norm = "missing"), - function(x, norm, ...) - rcond(x, norm = "O", ...)) - -setMethod("rcond", signature(x = "sparseMatrix", norm = "character"), - function(x, norm, useInv = FALSE, ...) { - d <- x@Dim - if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) - stop("rcond(x) is undefined: 'x' has length 0") - if(m == n) { - if(isS4(useInv) || useInv) { - if(!isS4(useInv)) - useInv <- solve(x) - 1 / (norm(x, type = norm) * norm(useInv, type = norm)) - } else { - warning("'rcond' via sparse -> dense coercion") - rcond(as(x, "denseMatrix"), norm = norm, ...) - } - } else { - ## MJ: norm(A = P1' Q R P2') = norm(R) holds in general - ## only for norm == "2", but La_rcond_type() disallows - ## norm == "2" ... FIXME ?? - if(m < n) { - x <- t(x) - n <- m - } - R <- triu(qr(x)@R[seq_len(n), , drop = FALSE]) - rcond(R, norm = norm, ...) - } - }) - -setMethod("rcond", signature(x = "diagonalMatrix", norm = "character"), - function(x, norm, ...) { - if((n <- x@Dim[1L]) == 0L) - stop("rcond(x) is undefined: 'x' has length 0") - switch(EXPR = norm[1L], - "O" = , "o" = , "1" = , - "I" = , "i" = , - "2" = , - "M" = , "m" = - if(x@diag == "N") { - rx <- range(abs(x@x)) - rx[1L] / rx[2L] - } else 1, - "F" = , "f" = , "E" = , "e" = - if(x@diag == "N") { - xx <- x@x * x@x - 1 / sqrt(sum(xx) * sum(1 / xx)) - } else 1 / n, - stop("invalid 'norm'")) - }) - -setMethod("rcond", signature(x = "indMatrix", norm = "character"), - function(x, norm, ...) { - d <- x@Dim - if((m <- d[1L]) == 0L || (n <- d[2L]) == 0L) - stop("rcond(x) is undefined: 'x' has length 0") - if (m == n) { - if(anyDuplicated.default(x@perm)) - return(0) - switch(EXPR = norm[1L], - "O" = , "o" = , "1" = , - "I" = , "i" = , - "2" = , - "M" = , "m" = - 1, - "F" = , "f" = , "E" = , "e" = - 1 / n, - stop("invalid 'norm'")) - } else { - if(m < n) { - x <- t(x) - n <- m - } - R <- triu(qr(x)@R[seq_len(n), , drop = FALSE]) - rcond(R, norm = norm, ...) - } - }) - -setMethod("rcond", signature(x = "pMatrix", norm = "character"), - function(x, norm, ...) { - if((n <- x@Dim[1L]) == 0L) - stop("rcond(x) is undefined: 'x' has length 0") - switch(EXPR = norm[1L], - "O" = , "o" = , "1" = , - "I" = , "i" = , - "2" = , - "M" = , "m" = - 1, - "F" = , "f" = , "E" = , "e" = - 1 / n, - stop("invalid 'norm'")) - }) - -setMethod("rcond", signature(x = "denseMatrix", norm = "character"), - function(x, norm, ...) - rcond(.M2kind(x, "d"), norm = norm, ...)) - -setMethod("rcond", signature(x = "dgeMatrix", norm = "character"), - function(x, norm, ...) { - d <- x@Dim - m <- d[1L] - n <- d[2L] - if(m == n) { - trf <- lu(x, warnSing = FALSE) - .Call(dgeMatrix_rcond, x, trf, norm) - } else { - ## MJ: norm(A = P1' Q R P2') = norm(R) holds in general - ## only for norm == "2", but La_rcond_type() disallows - ## norm == "2" ... FIXME ?? - if(m < n) { - x <- t(x) - n <- m - } - R <- triu(qr(x)[["qr"]][seq_len(n), , drop = FALSE]) - rcond(R, norm = norm, ...) - } - }) - -setMethod("rcond", signature(x = "dtrMatrix", norm = "character"), - function(x, norm, ...) - .Call(dtrMatrix_rcond, x, norm)) - -setMethod("rcond", signature(x = "dtpMatrix", norm = "character"), - function(x, norm, ...) - .Call(dtpMatrix_rcond, x, norm)) - -setMethod("rcond", signature(x = "dsyMatrix", norm = "character"), - function(x, norm, ...) { - trf <- BunchKaufman(x, warnSing = FALSE) - .Call(dsyMatrix_rcond, x, trf, norm) - }) - -setMethod("rcond", signature(x = "dspMatrix", norm = "character"), - function(x, norm, ...) { - trf <- BunchKaufman(x, warnSing = FALSE) - .Call(dspMatrix_rcond, x, trf, norm) - }) - -setMethod("rcond", signature(x = "dpoMatrix", norm = "character"), - function(x, norm, ...) { - ok <- TRUE - trf <- tryCatch( - Cholesky(x, perm = FALSE), - error = function(e) { - ok <<- FALSE - BunchKaufman(x, warnSing = FALSE) - }) - if(ok) - .Call(dpoMatrix_rcond, x, trf, norm) - else .Call(dsyMatrix_rcond, x, trf, norm) - }) - -setMethod("rcond", signature(x = "dppMatrix", norm = "character"), - function(x, norm, ...) { - ok <- TRUE - trf <- tryCatch( - Cholesky(x, perm = FALSE), - error = function(e) { - ok <<- FALSE - BunchKaufman(x, warnSing = FALSE) - }) - if(ok) - .Call(dppMatrix_rcond, x, trf, norm) - else .Call(dspMatrix_rcond, x, trf, norm) - }) diff -Nru rmatrix-1.6-1.1/R/show.R rmatrix-1.6-5/R/show.R --- rmatrix-1.6-1.1/R/show.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/show.R 2023-08-16 08:22:43.000000000 +0000 @@ -0,0 +1,588 @@ +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 +} + +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) +} + +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) +} + +emptyColnames <- function(x, msg.if.not.empty = FALSE) { + ## Useful for compact printing of (parts) of sparse matrices + ## possibly dimnames(x) "==" NULL : + if((nd <- length(d <- dim(x))) < 2L) + return(x) + nc <- d[2L] + if(is.null(dn <- dimnames(x))) + dn <- vector("list", nd) + else if(msg.if.not.empty && + is.character(cn <- dn[[2L]]) && + any(nzchar(cn))) + message(gettextf(" [[ suppressing %d column name%s %s ... ]]", + nc, + if(nc == 1L) "" else "s", + paste0(sQuote(if(nc <= 3L) cn else cn[1:3]), + collapse = ", ")), + domain = NA) + dn[[2L]] <- character(nc) + dimnames(x) <- dn + x +} + +.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 +} + +## 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", "lsparseMatrix")) || + # simple TRUE/FALSE + (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 +} + +## The `format()` method for sparse Matrices; +## also used inside sparseMatrix print()ing, +## exported as it might be useful directly. +formatSpMatrix <- function(x, + digits = NULL, + maxp = 1e+09, # ~ 0.5 * .Machine$integer.max + 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) + x <- .Call(R_sparse_diag_U2N, 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 +} + + +## 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, + 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) +} + +##' The "real" show() / print() method, calling the above printSpMatrix(): +printSpMatrix2 <- function(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) { + 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) + } +} + +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 +} + + +## METHODS FOR GENERIC: show +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("show", signature(object = "denseMatrix"), + function(object) prMatrix(object)) + +setMethod("show", signature(object = "sparseMatrix"), + function(object) printSpMatrix2(object)) + +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) + } + }) + +setMethod("show", "MatrixFactorization", + function(object) { + cat("matrix factorization of ") + str(object) + }) + +setMethod("show", "CholeskyFactorization", + function(object) { + cat("Cholesky factorization of ") + str(object) + }) + +setMethod("show", "BunchKaufmanFactorization", + function(object) { + cat("Bunch-Kaufman factorization of ") + str(object) + }) + +setMethod("show", "SchurFactorization", + function(object) { + cat("Schur factorization of ") + str(object) + }) + +setMethod("show", "LU", + function(object) { + cat("LU factorization of ") + str(object) + }) + +setMethod("show", "QR", + function(object) { + cat("QR factorization of ") + str(object) + }) + +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) + }) + + +## METHODS FOR GENERIC: print +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("print", signature(x = "sparseMatrix"), + printSpMatrix2) + +setMethod("print", signature(x = "diagonalMatrix"), + prDiag) + + +## METHODS FOR GENERIC: format +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("format", signature(x = "sparseMatrix"), + formatSpMatrix) + + +## METHODS FOR GENERIC: summary +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("summary", signature(object = "sparseMatrix"), + function(object, uniqT = FALSE, ...) { + d <- object@Dim + ## 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[1L], d[2L], class(object), nrow(r)) + class(r) <- c("sparseSummary", oldClass(r)) + r + }) + +setMethod("summary", signature(object = "diagonalMatrix"), + function(object, ...) { + d <- object@Dim + r <- summary(object@x, ...) + attr(r, "header") <- + sprintf("%d x %d diagonal Matrix of class \"%s\"", + d[1L], d[2L], class(object)) + class(r) <- c("diagSummary", class(r)) + r + }) + +print.sparseSummary <- print.diagSummary <- function (x, ...) { + cat(attr(x, "header"), "\n", sep = "") + NextMethod() + invisible(x) +} diff -Nru rmatrix-1.6-1.1/R/solve.R rmatrix-1.6-5/R/solve.R --- rmatrix-1.6-1.1/R/solve.R 2023-07-30 19:55:40.000000000 +0000 +++ rmatrix-1.6-5/R/solve.R 2023-12-06 18:46:20.000000000 +0000 @@ -4,19 +4,22 @@ .solve.checkDim1 <- function(nrow.a, ncol.a) { if(nrow.a != ncol.a) - stop("'a' is not square") + stop(gettextf("'%s' is not square", "a"), + domain = NA) } .solve.checkDim2 <- function(nrow.a, nrow.b) { if(nrow.a != nrow.b) - stop("dimensions of 'a' and 'b' are inconsistent") + stop(gettextf("dimensions of '%s' and '%s' are inconsistent", "a", "b"), + domain = NA) } .solve.checkCond <- function(a, tol, rcond.a = rcond(a)) { if(tol > 0 && a@Dim[1L] > 0L && rcond.a < tol) - stop(gettextf("'a' is computationally singular, rcond(a)=%g", rcond.a), + stop(gettextf("'%1$s' is computationally singular, rcond(%1$s)=%2$g", + "a", rcond.a), domain = NA) } @@ -42,8 +45,8 @@ if(tol > 0 && u@Dim[1L] > 0L) { r <- rad.u[1L] / rad.u[2L] if(r < tol) - stop(gettextf("'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))", - r), + stop(gettextf("'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))", + "a", r), domain = NA) } } @@ -77,37 +80,37 @@ for(.cl in c("MatrixFactorization", "triangularMatrix")) { -setMethod("solve", signature(a = .cl, b = "numLike"), +setMethod("solve", signature(a = .cl, b = "vector"), function(a, b, ...) - drop(solve(a, .m2dense(b, "dge"), ...))) + drop(solve(a, .m2dense(b, ",ge"), ...))) setMethod("solve", signature(a = .cl, b = "matrix"), function(a, b, ...) - solve(a, .m2dense(b, "dge"), ...)) + solve(a, .m2dense(b, ",ge"), ...)) setMethod("solve", signature(a = .cl, b = "denseMatrix"), function(a, b, ...) - solve(a, .M2gen(b, "d"), ...)) + solve(a, .M2gen(b, ","), ...)) setMethod("solve", signature(a = .cl, b = "CsparseMatrix"), function(a, b, ...) - solve(a, .M2gen(b, "d"), ...)) + solve(a, .M2gen(b, ","), ...)) setMethod("solve", signature(a = .cl, b = "RsparseMatrix"), function(a, b, ...) - solve(a, .M2gen(.M2C(b), "d"), ...)) + solve(a, .M2gen(.M2C(b), ","), ...)) setMethod("solve", signature(a = .cl, b = "TsparseMatrix"), function(a, b, ...) - solve(a, .M2gen(.M2C(b), "d"), ...)) + solve(a, .M2gen(.M2C(b), ","), ...)) setMethod("solve", signature(a = .cl, b = "diagonalMatrix"), function(a, b, ...) - solve(a, .diag2sparse(.M2kind(b, "d"), "g", "C"), ...)) + solve(a, .diag2sparse(b, ",", "g", "C"), ...)) setMethod("solve", signature(a = .cl, b = "indMatrix"), function(a, b, ...) - solve(a, as(b, "dMatrix"), ...)) + solve(a, .ind2sparse(b, ","), ...)) setMethod("solve", signature(a = .cl, b = "dgeMatrix"), function(a, b, ...) @@ -118,6 +121,7 @@ solve(a, .sparse2dense(b, FALSE), ...)) } +rm(.cl) setMethod("solve", signature(a = "denseLU", b = "missing"), function(a, b, ...) @@ -127,45 +131,27 @@ function(a, b, ...) .Call(denseLU_solve, a, b)) -setMethod("solve", signature(a = "BunchKaufman", b = "missing"), - function(a, b, ...) - .Call(BunchKaufman_solve, a, NULL, FALSE)) - -setMethod("solve", signature(a = "BunchKaufman", b = "dgeMatrix"), - function(a, b, ...) - .Call(BunchKaufman_solve, a, b, FALSE)) - -setMethod("solve", signature(a = "pBunchKaufman", b = "missing"), - function(a, b, ...) - .Call(BunchKaufman_solve, a, NULL, TRUE)) - -setMethod("solve", signature(a = "pBunchKaufman", b = "dgeMatrix"), - function(a, b, ...) - .Call(BunchKaufman_solve, a, b, TRUE)) - -setMethod("solve", signature(a = "Cholesky", b = "missing"), - function(a, b, ...) - .Call(Cholesky_solve, a, NULL, FALSE)) - -setMethod("solve", signature(a = "Cholesky", b = "dgeMatrix"), +for(.cl in c("BunchKaufman", "pBunchKaufman")) { +setMethod("solve", signature(a = .cl, b = "missing"), function(a, b, ...) - .Call(Cholesky_solve, a, b, FALSE)) + .Call(BunchKaufman_solve, a, NULL)) -setMethod("solve", signature(a = "pCholesky", b = "missing"), - function(a, b, ...) - .Call(Cholesky_solve, a, NULL, TRUE)) - -setMethod("solve", signature(a = "pCholesky", b = "dgeMatrix"), +setMethod("solve", signature(a = .cl, b = "dgeMatrix"), function(a, b, ...) - .Call(Cholesky_solve, a, b, TRUE)) + .Call(BunchKaufman_solve, a, b)) +} +rm(.cl) -setMethod("solve", signature(a = "pCholesky", b = "missing"), +for(.cl in c("Cholesky", "pCholesky")) { +setMethod("solve", signature(a = .cl, b = "missing"), function(a, b, ...) - .Call(Cholesky_solve, a, NULL, TRUE)) + .Call(Cholesky_solve, a, NULL)) -setMethod("solve", signature(a = "pCholesky", b = "dgeMatrix"), +setMethod("solve", signature(a = .cl, b = "dgeMatrix"), function(a, b, ...) - .Call(Cholesky_solve, a, b, TRUE)) + .Call(Cholesky_solve, a, b)) +} +rm(.cl) setMethod("solve", signature(a = "sparseLU", b = "missing"), function(a, b, tol = .Machine$double.eps, sparse = TRUE, ...) { @@ -235,29 +221,20 @@ system = c("A","LDLt","LD","DLt","L","Lt","D","P","Pt"), ...) .Call(CHMfactor_solve, a, b, TRUE, system)) -setMethod("solve", signature(a = "dtrMatrix", b = "missing"), - function(a, b, tol = .Machine$double.eps, ...) { - .solve.checkCond(a, tol) - .Call(dtrMatrix_solve, a, NULL, FALSE) - }) - -setMethod("solve", signature(a = "dtrMatrix", b = "dgeMatrix"), +for(.cl in c("dtrMatrix", "dtpMatrix")) { +setMethod("solve", signature(a = .cl, b = "missing"), function(a, b, tol = .Machine$double.eps, ...) { .solve.checkCond(a, tol) - .Call(dtrMatrix_solve, a, b, FALSE) + .Call(dtrMatrix_solve, a, NULL) }) -setMethod("solve", signature(a = "dtpMatrix", b = "missing"), - function(a, b, tol = .Machine$double.eps, ...) { - .solve.checkCond(a, tol) - .Call(dtrMatrix_solve, a, NULL, TRUE) - }) - -setMethod("solve", signature(a = "dtpMatrix", b = "dgeMatrix"), +setMethod("solve", signature(a = .cl, b = "dgeMatrix"), function(a, b, tol = .Machine$double.eps, ...) { .solve.checkCond(a, tol) - .Call(dtrMatrix_solve, a, b, TRUE) + .Call(dtrMatrix_solve, a, b) }) +} +rm(.cl) setMethod("solve", signature(a = "dtCMatrix", b = "missing"), function(a, b, sparse = TRUE, ...) { @@ -287,7 +264,7 @@ for(.cl in c("dtrMatrix", "dtpMatrix", "dtCMatrix")) setMethod("solve", signature(a = .cl, b = "triangularMatrix"), function(a, b, ...) { - r <- solve(a, as(b, "generalMatrix"), ...) + r <- solve(a, .M2gen(b), ...) if(a@uplo == b@uplo) { r <- if(a@uplo == "U") triu(r) else tril(r) if(a@diag != "N" && b@diag != "N") @@ -323,7 +300,7 @@ setMethod("solve", signature(a = "denseMatrix", b = "ANY"), function(a, b, ...) { - a <- .M2kind(a, "d") + a <- .M2kind(a, ",") if(missing(b)) solve(a, ...) else solve(a, b, ...) }) @@ -361,7 +338,7 @@ setMethod("solve", signature(a = "CsparseMatrix", b = "ANY"), function(a, b, ...) { - a <- .M2kind(a, "d") + a <- .M2kind(a, ",") if(missing(b)) solve(a, ...) else solve(a, b, ...) }) @@ -371,7 +348,7 @@ solve(trf, sparse = sparse, ...) }) -setMethod("solve", signature(a = "dgCMatrix", b = "numLike"), +setMethod("solve", signature(a = "dgCMatrix", b = "vector"), function(a, b, ...) { trf <- lu(a, errSing = TRUE) solve(trf, b, ...) @@ -381,7 +358,7 @@ function(a, b, sparse = FALSE, ...) { trf <- lu(a, errSing = TRUE) if(is.na(sparse) || sparse) - b <- .m2sparse(b, "dgC") + b <- .m2sparse(b, ",gC") solve(trf, b, ...) }) @@ -389,7 +366,7 @@ function(a, b, sparse = FALSE, ...) { trf <- lu(a, errSing = TRUE) if(is.na(sparse) || sparse) - b <- as(b, "CsparseMatrix") + b <- .M2C(b) solve(trf, b, ...) }) @@ -397,7 +374,7 @@ function(a, b, sparse = TRUE, ...) { trf <- lu(a, errSing = TRUE) if(!(is.na(sparse) || sparse)) - b <- as(b, "unpackedMatrix") + b <- .M2unpacked(b) solve(trf, b, ...) }) @@ -409,7 +386,7 @@ solve(trf, sparse = sparse, ...) }) -setMethod("solve", signature(a = "dsCMatrix", b = "numLike"), +setMethod("solve", signature(a = "dsCMatrix", b = "vector"), function(a, b, ...) { trf <- tryCatch( Cholesky(a, perm = TRUE, LDL = TRUE, super = FALSE), @@ -423,7 +400,7 @@ Cholesky(a, perm = TRUE, LDL = TRUE, super = FALSE), error = function(e) lu(a, errSing = TRUE)) if(is.na(sparse) || sparse) - b <- .m2sparse(b, "dgC") + b <- .m2sparse(b, ",gC") solve(trf, b, ...) }) @@ -433,7 +410,7 @@ Cholesky(a, perm = TRUE, LDL = TRUE, super = FALSE), error = function(e) lu(a, errSing = TRUE)) if(is.na(sparse) || sparse) - b <- as(b, "CsparseMatrix") + b <- .M2C(b) solve(trf, b, ...) }) @@ -443,7 +420,7 @@ Cholesky(a, perm = TRUE, LDL = TRUE, super = FALSE), error = function(e) lu(a, errSing = TRUE)) if(!(is.na(sparse) || sparse)) - b <- as(b, "unpackedMatrix") + b <- .M2unpacked(b) solve(trf, b, ...) }) @@ -461,7 +438,7 @@ setMethod("solve", signature(a = "RsparseMatrix", b = "ANY"), function(a, b, ...) { - a <- .M2kind(.M2C(a), "d") + a <- .M2kind(.M2C(a), ",") if(missing(b)) solve(a, ...) else solve(a, b, ...) }) @@ -472,7 +449,7 @@ setMethod("solve", signature(a = "TsparseMatrix", b = "ANY"), function(a, b, ...) { - a <- .M2kind(.M2C(a), "d") + a <- .M2kind(.M2C(a), ",") if(missing(b)) solve(a, ...) else solve(a, b, ...) }) @@ -483,7 +460,7 @@ setMethod("solve", signature(a = "diagonalMatrix", b = "ANY"), function(a, b, ...) { - a <- .M2kind(a, "d") + a <- .M2kind(a, ",") if(missing(b)) solve(a, ...) else solve(a, b, ...) }) @@ -498,7 +475,7 @@ a }) -setMethod("solve", signature(a = "ddiMatrix", b = "numLike"), +setMethod("solve", signature(a = "ddiMatrix", b = "vector"), function(a, b, ...) { m <- length(b) .solve.checkDim2(a@Dim[1L], m) @@ -569,7 +546,7 @@ a }) -setMethod("solve", signature(a = "pMatrix", b = "numLike"), +setMethod("solve", signature(a = "pMatrix", b = "vector"), function(a, b, ...) { m <- length(b) .solve.checkDim2(a@Dim[1L], m) @@ -609,11 +586,9 @@ ## for now ... fast for this special case ... .spV2dgC <- function(x) { - if(is.double(m <- x@length)) { - if(m >= .Machine$integer.max + 1) - stop("dimensions cannot exceed 2^31-1") - m <- as.integer(m) - } + if(is.double(m <- length(x))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) i <- as.integer(x@i) - 1L nnz <- length(i) r <- new("dgCMatrix") @@ -624,26 +599,25 @@ if(!.hasSlot(x, "x")) rep.int(1, nnz) else if(is.complex(y <- x@x)) - stop("cannot coerce zsparseVector to dgCMatrix") + stop(gettextf("cannot coerce from %s to %s", "zsparseVector", "dgCMatrix"), + domain = NA) else y r } ## for now ... fast for this special case ... .spV2dge <- function(x) { - m <- x@length - if(is.double(m)) { - if(m >= .Machine$integer.max + 1) - stop("dimensions cannot exceed 2^31-1") - m <- as.integer(m) - } + if(is.double(m <- length(x))) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) r <- new("dgeMatrix") r@Dim <- c(m, 1L) r@x <- replace(double(m), x@i, if(!.hasSlot(x, "x")) 1 else if(is.complex(y <- x@x)) - stop("cannot coerce zsparseVector to dgeMatrix") + stop(gettextf("cannot coerce from %s to %s", "zsparseVector", "dgCMatrix"), + domain = NA) else y) r } @@ -658,11 +632,11 @@ setMethod("solve", signature(a = "matrix", b = "Matrix"), function(a, b, ...) - solve(.m2dense(a, "dge"), b, ...)) + solve(.m2dense(a, ",ge"), b, ...)) setMethod("solve", signature(a = "matrix", b = "sparseVector"), function(a, b, ...) - solve(.m2dense(a, "dge"), .spV2dge(b), ...)) # FIXME? drop(.)? + solve(.m2dense(a, ",ge"), .spV2dge(b), ...)) # FIXME? drop(.)? ######################################################################## @@ -681,19 +655,18 @@ ## a=dgCMatrix ## b=vector or 1-column matrix -## x=list(L, coef, Xty, resid) -.solve.dgC.chol <- function(a, b, check = TRUE) { # -> MatrixModels +## x=double vector +.solve.dgC.qr <- function(a, b, order = 3L, check = TRUE) { # -> MatrixModels if(check && !is(a, "dgCMatrix")) a <- as(as(as(a, "CsparseMatrix"), "generalMatrix"), "dMatrix") - .Call(dgCMatrix_cholsol, a, b) + .Call(dgCMatrix_qrsol, a, b, order) # calls cs_qrsol } -## *The* interface to cs_qrsol() ## a=dgCMatrix -## b=vector or 1-column matrix {FIXME in ../src/dgCMatrix.c} -## x=double vector -.solve.dgC.qr <- function(a, b, order = 3L, check = TRUE) { # -> MatrixModels +## b=vector or 1-column matrix +## x=list(L, coef, Xty, resid) +.solve.dgC.chol <- function(a, b, check = TRUE) { # -> MatrixModels if(check && !is(a, "dgCMatrix")) a <- as(as(as(a, "CsparseMatrix"), "generalMatrix"), "dMatrix") - .Call(dgCMatrix_qrsol, a, b, order) + .Call(dgCMatrix_cholsol, a, b) } diff -Nru rmatrix-1.6-1.1/R/spModels.R rmatrix-1.6-5/R/spModels.R --- rmatrix-1.6-1.1/R/spModels.R 2023-07-30 20:12:54.000000000 +0000 +++ rmatrix-1.6-5/R/spModels.R 2023-08-21 15:41:59.000000000 +0000 @@ -553,8 +553,8 @@ 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)) + r <- if(transpose) rbind.Matrix(r, rj ) + else cbind.Matrix(r, t(rj)) ## if(verbose) cat(" [Ok]\n") vNms <- c(vNms, dimnames(rj)[[1]]) counts[j] <- nrow(rj) diff -Nru rmatrix-1.6-1.1/R/sparseMatrix.R rmatrix-1.6-5/R/sparseMatrix.R --- rmatrix-1.6-1.1/R/sparseMatrix.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/sparseMatrix.R 2023-09-20 22:08:02.000000000 +0000 @@ -1,713 +1,123 @@ -## METHODS FOR CLASS: sparseMatrix (virtual) -## sparse matrices +## METHODS FOR CLASS: sparseMatrix, [CRT]sparseMatrix (virtual) +## sparse matrices, in some cases restricted to CSC, CSR, triplet ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## ~~~~ CONSTRUCTORS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -spMatrix <- function(nrow, ncol, i = integer(), j = integer(), x = double()) - new(paste0(.M.kind(x), "gTMatrix"), # rely on new() to check validity - Dim = c(as.integer(nrow), as.integer(ncol)), - i = as.integer(i) - 1L, - j = as.integer(j) - 1L, - x = if(is.integer(x)) as.double(x) else x) - -sparseMatrix <- function(i, j, p, x, dims, dimnames, - symmetric = FALSE, triangular = FALSE, index1 = TRUE, - repr = c("C", "R", "T"), giveCsparse, - check = TRUE, use.last.ij = FALSE) -{ - if((m.i <- missing(i)) + (m.j <- missing(j)) + (m.p <- missing(p)) != 1L) - stop("exactly one of 'i', 'j', and 'p' must be missing from call") - if(symmetric && triangular) - stop("use Diagonal() to construct diagonal (symmetric && triangular) sparse matrices") - index1 <- as.logical(index1) # allowing {0,1} - - repr <- - ## NB: prior to 2020-05, we had 'giveCsparse' {T->"C" [default], F->"T"} - ## but no 'repr' ... the following is to remain backwards compatible - if(missing(giveCsparse)) - match.arg(repr) - else if(!missing(repr)) { - warning("'giveCsparse' is deprecated; using 'repr' instead") - match.arg(repr) - ## } else { - ## repr <- if(giveCsparse) "C" else "T" - ## warning(gettextf("'giveCsparse' is deprecated; setting repr=\"%s\" for you", repr), - ## domain = NA) - ## } - } else if(giveCsparse) { - ## NOT YET: - ## warning("'giveCsparse' is deprecated; setting repr=\"C\" for you") - "C" - } else { - warning("'giveCsparse' is deprecated; setting repr=\"T\" for you") - "T" - } - - if(!m.p) { - p <- as.integer(p) - if((n.p <- length(p)) == 0L || anyNA(p) || p[1L] != 0L || - any((dp <- p[-1L] - p[-n.p]) < 0L)) - stop("'p' must be a nondecreasing vector c(0, ...)") - if((n.dp <- length(dp)) > .Machine$integer.max) - stop("dimensions cannot exceed 2^31-1") - i. <- rep.int(seq.int(from = 0L, length.out = n.dp), dp) - if(m.i) i <- i. else j <- i. - } - - if(!m.i) - i <- if(index1) as.integer(i) - 1L else as.integer(i) # need 0-index - if(!m.j) - j <- if(index1) as.integer(j) - 1L else as.integer(j) # need 0-index - - rij <- cbind(if(n.i <- length(i)) range(i) else 0:-1, - if(n.j <- length(j)) range(j) else 0:-1, - deparse.level = 0L) - if(anyNA(rij)) - stop("'i' and 'j' must not contain NA") # and not overflow - if(any(rij[1L, ] < 0L)) - stop("'i' and 'j' must be ", if(index1) "positive" else "non-negative") - dims <- - if(!missing(dims)) { - if(length(dims) != 2L || - any(is.na(dims) | dims < 0L | dims >= .Machine$integer.max + 1)) - stop("invalid 'dims'") - if(any(dims - 1L < rij[2L, ])) - stop("'dims' must contain all (i,j) pairs") - as.integer(dims) - } else if(symmetric || triangular) - rep.int(max(rij), 2L) + 1L - else rij[2L, ] + 1L - - kind <- if(m.x <- missing(x)) "n" else .M.kind(x) - shape <- - if(symmetric) { - if(dims[1L] != dims[2L]) - stop("symmetric matrix must be square") - "s" - } else if(triangular) { - if(dims[1L] != dims[2L]) - stop("triangular matrix must be square") - "t" - } else "g" - - r <- new(paste0(kind, shape, "TMatrix")) - r@Dim <- dims - if(!missing(dimnames) && !is.null(dimnames)) - r@Dimnames <- - if(is.character(validDN(dimnames, dims))) - dimnames - else fixupDN(dimnames) # needs a valid argument - if((symmetric || triangular) && all(i >= j)) - r@uplo <- "L" # else "U", the prototype - if(!m.x) { - if(is.integer(x)) - x <- as.double(x) - if((n.x <- length(x)) > 0L && n.x != n.i) { - if(n.x < n.i) { - if(n.i %% n.x != 0L) - warning(if(m.i) "p[length(p)] " else "length(i) ", - "is not an integer multiple of length(x)") - x <- rep_len(x, n.i) # recycle - } else if(n.x == 1L) - x <- x[0L] # tolerate length(i) = 0, length(x) = 1 - else stop("length(x) must not exceed ", - if(m.i) "p[length(p)]" else "length(i)") - } - if(use.last.ij && n.i == n.j && - anyDuplicated.matrix(ij <- cbind(i, j, deparse.level = 0L), - fromLast = TRUE)) { - which.not.dup <- which(!duplicated(ij, fromLast = TRUE)) - i <- i[which.not.dup] - j <- j[which.not.dup] - x <- x[which.not.dup] - } - r@x <- x +.sparse.band <- function(x, k1, k2, ...) + .Call(R_sparse_band, x, k1, k2) +.sparse.triu <- function(x, k = 0L, ...) + .Call(R_sparse_band, x, k, NULL) +.sparse.tril <- function(x, k = 0L, ...) + .Call(R_sparse_band, x, NULL, k) +.sparse.diag.get <- function(x, nrow, ncol, names = TRUE) + .Call(R_sparse_diag_get, x, names) +.sparse.diag.set <- function(x, value) + .Call(R_sparse_diag_set, x, value) +.sparse.t <- function(x) + .Call(R_sparse_transpose, x, FALSE) +.sparse.fS1 <- function(x, uplo) + .Call(R_sparse_force_symmetric, x, NULL) +.sparse.fS2 <- function(x, uplo) + .Call(R_sparse_force_symmetric, x, uplo) +.sparse.symmpart <- function(x) + .Call(R_sparse_symmpart, x) +.sparse.skewpart <- function(x) + .Call(R_sparse_skewpart, x) +.sparse.is.di <- function(object) + .Call(R_sparse_is_diagonal, object) +.sparse.is.tr <- function(object, upper = NA, ...) + .Call(R_sparse_is_triangular, object, upper) +.sparse.is.sy <- function(object, checkDN = TRUE, ...) { + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) check.attributes + checkDN <- ca(...) } - r@i <- i - r@j <- j - - if(check) - validObject(r) - switch(repr, "C" = .M2C(r), "T" = r, "R" = .M2R(r), - ## should never happen: - stop("invalid 'repr'; must be \"C\", \"R\", or \"T\"")) + .Call(R_sparse_is_symmetric, object, checkDN) } - - -## ~~~~ METHODS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("mean", signature(x = "sparseMatrix"), - function(x, ...) mean(as(x, "sparseVector"), ...)) - -### "[<-" : ----------------- - -## 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", "lsparseMatrix")) || - # simple TRUE/FALSE - (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) - x <- .Call(R_sparse_diag_U2N, 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 +.sparse.is.sy.dz <- function(object, checkDN = TRUE, + tol = 100 * .Machine$double.eps, ...) { + ## backwards compatibility: don't check DN if check.attributes=FALSE + if(checkDN) { + ca <- function(check.attributes = TRUE, ...) check.attributes + checkDN <- ca(...) } - cx -}## formatSpMatrix() + ## be very fast when requiring exact symmetry + if(tol <= 0) + return(.Call(R_sparse_is_symmetric, object, checkDN)) + ## pretest: is it square? + d <- object@Dim + if((n <- d[2L]) != d[1L]) + return(FALSE) + ## pretest: are DN symmetric in the sense of validObject()? + if(checkDN && !isSymmetricDN(object@Dimnames)) + return(FALSE) + if(n == 0L) + return(TRUE) + ## now handling an n-by-n [dz]g[CRT]Matrix, n >= 1: -## 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) + Cj <- if(is.complex(object@x)) Conj else identity + ae <- function(check.attributes, ...) { + ## discarding possible user-supplied check.attributes + all.equal(..., check.attributes = FALSE) } -} ## 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) -} - -setMethod("dim<-", signature(x = "sparseMatrix"), - function(x, value) { - if(!is.numeric(value) || length(value) != 2L) - stop("dimensions must be numeric of length 2") - if(anyNA(value)) - stop("dimensions cannot contain NA") - if(any(value < 0)) - stop("dimensions cannot contain negative values") - if(!is.integer(value)) { - if(any(value > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") - value <- as.integer(value) + isTRUE(ae(target = .M2V( object ), + current = .M2V(Cj(t(object))), + tolerance = tol, ...)) +} + +setMethod("diff", signature(x = "sparseMatrix"), + ## Mostly cut and paste of base::diff.default : + function(x, lag = 1L, differences = 1L, ...) { + if(length(lag) != 1L || length(differences) != 1L || + lag < 1L || differences < 1L) + stop(gettextf("'%s' and '%s' must be positive integers", + "lag", "differences"), + domain = NA) + if(lag * differences >= x@Dim[1L]) + return(x[0L]) + i1 <- -seq_len(lag) + for(i in seq_len(differences)) { + m <- x@Dim[1L] + x <- x[i1, , drop = FALSE] - + x[-m:-(m - lag + 1L), , drop = FALSE] } - if(all(value == (d <- x@Dim))) - return(x) - if((pv <- prod(value)) != (pd <- prod(d))) - stop(gettextf("assigned dimensions [product %.0f] do not match object length [%.0f]", - pv, pd, domain = NA)) - r <- spV2M(as(x, "sparseVector"), - nrow = value[1L], ncol = value[2L]) - ## 'r' is a TsparseMatrix - if(extends(cd <- getClassDef(class(x)) , "CsparseMatrix")) - as(r, "CsparseMatrix") - else if(extends(cd, "RsparseMatrix")) - as(r, "RsparseMatrix") - else r + x }) -setMethod("rep", "sparseMatrix", - function(x, ...) rep(as(x, "sparseVector"), ...)) +setMethod("mean", signature(x = "sparseMatrix"), + function(x, ...) mean(as(x, "sparseVector"), ...)) -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)# , names = TRUE - r <- Is %*% V %*% Is - r[cbind(1:p,1:p)] <- 1 # exact in diagonal - as(`dimnames<-`(r, symmDN(dimnames(V))), "symmetricMatrix") - ## as(r, "symmetricMatrix") - }) +setMethod("rep", "sparseMatrix", + function(x, ...) rep(as(x, "sparseVector"), ...)) -## 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, ...)) - }) +for(.cl in paste0(c("C", "R", "T"), "sparseMatrix")) { +setMethod("band" , signature(x = .cl), .sparse.band) +setMethod("triu" , signature(x = .cl), .sparse.triu) +setMethod("tril" , signature(x = .cl), .sparse.tril) +setMethod("diag" , signature(x = .cl), .sparse.diag.get) +setMethod("diag<-", signature(x = .cl), .sparse.diag.set) +setMethod("t" , signature(x = .cl), .sparse.t) +setMethod("forceSymmetric", signature(x = .cl, uplo = "missing"), .sparse.fS1) +setMethod("forceSymmetric", signature(x = .cl, uplo = "character"), .sparse.fS2) +setMethod("symmpart", signature(x = .cl), .sparse.symmpart) +setMethod("skewpart", signature(x = .cl), .sparse.skewpart) +setMethod("isSymmetric" , signature(object = .cl), .sparse.is.sy) +setMethod("isTriangular", signature(object = .cl), .sparse.is.tr) +setMethod("isDiagonal" , signature(object = .cl), .sparse.is.di) +} +.sparse.subclasses <- names(getClassDef("sparseMatrix")@subclasses) +for(.cl in grep("^[dz][gt][CRT]Matrix$", .sparse.subclasses, value = TRUE)) +setMethod("isSymmetric" , signature(object = .cl), .sparse.is.sy.dz) +rm(.cl, .sparse.subclasses) -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, ...) -} +rm(list = c(grep("^[.]sparse[.](band|tri[ul]|diag[.](get|set)|t|fS[12]|symmpart|skewpart|is[.](sy|tr|di)([.]dz)?)$", + ls(all.names = TRUE), value = TRUE))) -## 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, - x = rand.x(nnz), - index1 = FALSE, - symmetric = symmetric, - 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 + ### ----- and then, base::scale() -> base::scale.default() would work "magically" already.. 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) @@ -742,125 +152,3 @@ if(is.numeric(scale)) attr(x, "scaled:scale") <- scale x } - -.sparse.diag.get <- function(x, nrow, ncol, names = TRUE) - .Call(R_sparse_diag_get, x, names) -.sparse.diag.set <- function(x, value) - .Call(R_sparse_diag_set, x, value) -.sparse.band <- function(x, k1, k2, ...) .Call(R_sparse_band, x, k1, k2) -.sparse.triu <- function(x, k = 0L, ...) .Call(R_sparse_band, x, k, NULL) -.sparse.tril <- function(x, k = 0L, ...) .Call(R_sparse_band, x, NULL, k) -.sparse.t <- function(x) .Call(R_sparse_transpose, x, FALSE) -.sparse.fS1 <- function(x, uplo) .Call(R_sparse_force_symmetric, x, NULL) -.sparse.fS2 <- function(x, uplo) .Call(R_sparse_force_symmetric, x, uplo) -.sparse.symmpart <- function(x) .Call(R_sparse_symmpart, x) -.sparse.skewpart <- function(x) .Call(R_sparse_skewpart, x) - -.C.is.di <- function(object) - .Call(Csparse_is_diagonal, object) -.R.is.di <- function(object) - .Call(Rsparse_is_diagonal, object) -.T.is.di <- function(object) - .Call(Tsparse_is_diagonal, object) - -.C.is.tr <- function(object, upper = NA, ...) - .Call(Csparse_is_triangular, object, upper) -.R.is.tr <- function(object, upper = NA, ...) - .Call(Rsparse_is_triangular, object, upper) -.T.is.tr <- function(object, upper = NA, ...) - .Call(Tsparse_is_triangular, object, upper) - -.C.is.sy <- function(object, checkDN = TRUE, ...) { - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - .Call(Csparse_is_symmetric, object, checkDN) -} -.R.is.sy <- function(object, checkDN = TRUE, ...) { - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - .Call(Rsparse_is_symmetric, object, checkDN) -} -.T.is.sy <- function(object, checkDN = TRUE, ...) { - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - .Call(Csparse_is_symmetric, as(object, "CsparseMatrix"), checkDN) -} -.sparse.is.sy.dz <- function(object, tol = 100 * .Machine$double.eps, - checkDN = TRUE, ...) { - ## backwards compatibility: don't check DN if check.attributes=FALSE - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - ## be very fast when requiring exact symmetry - if(tol <= 0) { - if(!.hasSlot(object, "p")) - return(.Call(Csparse_is_symmetric, as(object, "CsparseMatrix"), checkDN)) - else if(.hasSlot(object, "i")) - return(.Call(Csparse_is_symmetric, object, checkDN)) - else - return(.Call(Rsparse_is_symmetric, object, checkDN)) - } - ## pretest: is it square? - d <- object@Dim - if((n <- d[1L]) != d[2L]) - return(FALSE) - ## pretest: are DN symmetric in the sense of validObject()? - if(checkDN && !isSymmetricDN(object@Dimnames)) - return(FALSE) - if(n <= 1L) - return(TRUE) - ## now handling an n-by-n [CRT]sparseMatrix, n >= 2: - x <- as( object, "sparseVector") - tx <- as(t(object), "sparseVector") - if(is(tx, "zsparseVector")) - tx@x <- Conj(tx@x) - ae <- function(check.attributes, ...) { - ## discarding possible user-supplied check.attributes: - all.equal(..., check.attributes = FALSE) - } - isTRUE(ae(target = x, current = tx, tolerance = tol, ...)) -} - -.sparse.subclasses <- names(getClassDef("sparseMatrix")@subclasses) - -for (.cl in grep("^[CRT]sparseMatrix$", .sparse.subclasses, value = TRUE)) { - setMethod("diag", signature(x = .cl), .sparse.diag.get) - setMethod("diag<-", signature(x = .cl), .sparse.diag.set) - setMethod("band", signature(x = .cl), .sparse.band) - setMethod("triu", signature(x = .cl), .sparse.triu) - setMethod("tril", signature(x = .cl), .sparse.tril) - setMethod("t", signature(x = .cl), .sparse.t) - setMethod("forceSymmetric", signature(x = .cl, uplo = "missing"), - .sparse.fS1) - setMethod("forceSymmetric", signature(x = .cl, uplo = "character"), - .sparse.fS2) - setMethod("symmpart", signature(x = .cl), .sparse.symmpart) - setMethod("skewpart", signature(x = .cl), .sparse.skewpart) - setMethod("isDiagonal", signature(object = .cl), - get(paste0(".", substr(.cl, 1L, 1L), ".is.di"), - mode = "function", inherits = FALSE)) -} - -for (.cl in grep("^.g[CRT]Matrix$", .sparse.subclasses, value = TRUE)) - setMethod("isTriangular", signature(object = .cl), - get(paste0(".", substr(.cl, 3L, 3L), ".is.tr"), - mode = "function", inherits = FALSE)) -for (.cl in grep("^[lni]g[CRT]Matrix$", .sparse.subclasses, value = TRUE)) - setMethod("isSymmetric", signature(object = .cl), - get(paste0(".", substr(.cl, 3L, 3L), ".is.sy"), - mode = "function", inherits = FALSE)) -for (.cl in grep("^[dz][gt][CRT]Matrix$", .sparse.subclasses, value = TRUE)) - setMethod("isSymmetric", signature(object = .cl), .sparse.is.sy.dz) - -rm(.cl, .sparse.subclasses, .sparse.is.sy.dz, - list = c(grep("^[.]sparse[.](band|tri[ul]|t|fS[21]|symmpart|skewpart)$", - ls(all.names = TRUE), value = TRUE), - grep("^[.][CRT][.]is[.](di|tr|sy)$", - ls(all.names = TRUE), value = TRUE))) diff -Nru rmatrix-1.6-1.1/R/sparseVector.R rmatrix-1.6-5/R/sparseVector.R --- rmatrix-1.6-1.1/R/sparseVector.R 2023-07-30 17:30:50.000000000 +0000 +++ rmatrix-1.6-5/R/sparseVector.R 2023-12-06 18:46:20.000000000 +0000 @@ -1,854 +1,260 @@ ## METHODS FOR CLASS: sparseVector (virtual) +## sparse vectors ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -## ~~~~ COERCIONS FROM ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setAs("nsparseVector", "lsparseVector", - function(from) - new("lsparseVector", length = from@length, i = from@i, - x = rep.int(TRUE, length(from@i)))) -setAs("nsparseVector", "isparseVector", - function(from) - new("isparseVector", length = from@length, i = from@i, - x = rep.int(1L, length(from@i)))) -setAs("nsparseVector", "dsparseVector", - function(from) - new("dsparseVector", length = from@length, i = from@i, - x = rep.int(1, length(from@i)))) -setAs("nsparseVector", "zsparseVector", - function(from) - new("zsparseVector", length = from@length, i = from@i, - x = rep.int(1+0i, length(from@i)))) - -setAs("sparseVector", "nsparseVector", - function(from) - new("nsparseVector", length = from@length, i = from@i)) -setAs("sparseVector", "lsparseVector", - function(from) - new("lsparseVector", length = from@length, i = from@i, - x = as.logical(from@x))) -setAs("sparseVector", "isparseVector", - function(from) - new("isparseVector", length = from@length, i = from@i, - x = as.integer(from@x))) -setAs("sparseVector", "dsparseVector", - function(from) - new("dsparseVector", length = from@length, i = from@i, - x = as.double(from@x))) -setAs("sparseVector", "zsparseVector", - function(from) - new("zsparseVector", length = from@length, i = from@i, - x = as.complex(from@x))) - -spV2M <- function(x, nrow, ncol, byrow = FALSE, - check = TRUE, symmetric = FALSE) { - if(check && !is(x, "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') - ## ~~~~~~~~~~~~~~~~ - kind <- .M.kind(x) # "d", "n", "l", "i", "z", ... - has.x <- kind != "n" - clStem <- if(symmetric) "sTMatrix" else "gTMatrix" - ## "careful_new()" : - cNam <- paste0(kind, clStem) - chngCl <- is.null(newCl <- getClassDef(cNam)) - if(chngCl) { ## e.g. "igTMatrix" is not yet implemented - if(kind == "z") - stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), - domain = NA) - ## coerce to "double": - newCl <- getClassDef(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 -} - -.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) .M2C(.sparseV2Mat(from))) -setAs("sparseVector", "RsparseMatrix", function(from) .M2R(.sparseV2Mat(from))) - -sp2vec <- function(x, mode = .type.kind[.M.kind(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 -} - -## Need 'base' functions calling as.*() to dispatch to our S4 methods: -as.vector.sparseVector <- sp2vec -as.matrix.sparseVector <- function(x, ...) as.matrix.default(sp2vec(x)) - as.array.sparseVector <- function(x, ...) as.array.default(sp2vec(x)) - -setAs("sparseVector", "vector", function(from) sp2vec(from)) -setAs("sparseVector", "logical", function(from) sp2vec(from, mode = "logical")) -setAs("sparseVector", "integer", function(from) sp2vec(from, mode = "integer")) -setAs("sparseVector", "numeric", function(from) sp2vec(from, mode = "double")) - -setMethod("as.vector", "sparseVector", sp2vec) -setMethod("as.logical", "sparseVector", function(x) sp2vec(x, mode = "logical")) -setMethod("as.numeric", "sparseVector", function(x) sp2vec(x, mode = "double")) - - -## ~~~~ COERCIONS TO ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setAs("ANY", "sparseVector", - function(from) as(as.vector(from), "sparseVector")) - -setAs("ANY", "nsparseVector", - function(from) as(as(from, "sparseVector"), "nsparseVector")) - -setAs("atomicVector", "sparseVector", - function(from) { - r <- new(paste0(.V.kind(from), "sparseVector")) - r@length <- length(from) - r@i <- ii <- which(isN0(from)) - r@x <- from[ii] - r - }) - -setAs("atomicVector", "dsparseVector", - function(from) { - r <- new("dsparseVector") - r@length <- length(from) - r@i <- ii <- which(isN0(from)) - r@x <- as.double(from)[ii] - r - }) - -setAs("CsparseMatrix", "sparseVector", - function(from) .Call(CR2spV, from)) - -setAs("RsparseMatrix", "sparseVector", - function(from) .Call(CR2spV, from)) - -setAs("TsparseMatrix", "sparseVector", - function(from) .Call(CR2spV, .M2C(from))) - -setAs("diagonalMatrix", "sparseVector", - function(from) { - n <- (d <- from@Dim)[1L] - nn <- prod(d) - kind <- .M.kind(from) - to <- new(paste0(kind, "sparseVector")) - to@length <- - if(nn <= .Machine$integer.max) - as.integer(nn) - else nn - to@i <- indDiag(n) - to@x <- - if(from@diag == "N") - from@x - else rep.int(switch(kind, - "l" = TRUE, - "i" = 1L, - "d" = 1, - "z" = 1+0i), - n) - to - }) - -setAs("indMatrix", "sparseVector", - function(from) { - d <- from@Dim - m <- d[1L] - n <- d[2L] - mn <- prod(d) - perm <- from@perm - to <- new("nsparseVector") - if(mn <= .Machine$integer.max) { - to@length <- as.integer(mn) - to@i <- - if(from@margin == 1L) - seq.int(to = 0L, by = 1L, length.out = m) + perm * m - else seq.int(from = 0L, by = m, length.out = n) + perm - } else { - to@length <- mn - to@i <- - if(from@margin == 1L) - seq.int(to = 0, by = 1, length.out = m) + perm * as.double(m) - else seq.int(from = 0, by = as.double(m), length.out = n) + as.double(perm) - } - to - }) - - -## ~~~~ METHODS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -##' 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) -} - -setMethod("dim<-", signature(x = "sparseVector"), - function(x, value) { - if(!is.numeric(value) || length(value) != 2L) - stop("dimensions must be numeric of length 2") - if(anyNA(value)) - stop("dimensions cannot contain NA") - if(any(value < 0)) - stop("dimensions cannot contain negative values") - if(!is.integer(value)) { - if(any(value > .Machine$integer.max)) - stop("dimensions cannot exceed 2^31-1") - value <- as.integer(value) - } - if((p <- prod(value)) != (len <- length(x))) - stop(gettextf("assigned dimensions [product %.0f] do not match object length [%.0f]", - p, len, domain = NA)) - spV2M(x, nrow = value[1L], ncol = value[2L]) - }) - -setMethod("length", "sparseVector", function(x) x@length) - -setMethod("mean", signature(x = "sparseVector"), - function(x, trim = 0, na.rm = FALSE, ...) { - if(is.numeric(trim) && length(trim) == 1L && !is.na(trim) && - trim == 0) { - ## Be fast in this special case : - if(isTRUE(na.rm)) - ## FIXME: don't allocate !is.na(x) - x <- x[!is.na(x)] - sum(x) / length(x) - } else { - ## FIXME: don't allocate as.numeric(x); need 'sort' method - warning("suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'") - mean.default(as.numeric(x), trim = trim, na.rm = na.rm, ...) - } +setMethod("diff", signature(x = "sparseVector"), + ## Mostly cut and paste of base::diff.default : + function(x, lag = 1L, differences = 1L, ...) { + if(length(lag) != 1L || length(differences) != 1L || + lag < 1L || differences < 1L) + stop(gettextf("'%s' and '%s' must be positive integers", + "lag", "differences"), + domain = NA) + if(lag * differences >= length(x)) + return(x[0L]) + i1 <- -seq_len(lag) + for(i in seq_len(differences)) + x <- x[i1] - x[-length(x):-(length(x) - lag + 1L)] + x }) -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] +setMethod("mean", signature(x = "sparseVector"), + function(x, trim = 0, na.rm = FALSE, ...) { + kind <- .M.kind(x) + if(kind == "z" && trim > 0) + stop("trimmed means are not defined for complex data") + n <- length(x) + if(kind != "n" && n > 0L && anyNA(x@x)) { + if(!na.rm) + return(NA_real_) + n <- n - sum(is.na(x@x)) } - 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(n == 0L) + return(if(kind == "z") NaN * 0i else NaN) + if(kind == "n") { + nnz <- length(x@i) + if(trim <= 0) + return(nnz / n) + ntrim <- trunc(n * min(trim, 0.5)) + if(nnz < ntrim) + 0 + else if(nnz == ntrim) { + if(n - 2 * ntrim > 0) + 0 + else 0.5 + } else { + if(n - 2 * ntrim > 0) + (nnz - ntrim - max(ntrim - (n - nnz), 0)) / + (n - 2 * ntrim) + else 1 } - 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] + } else { + if(trim <= 0) + return(sum(x@x, na.rm = na.rm) / n) + ntrim <- trunc(n * min(trim, 0.5)) + x <- .V.sort(x, na.last = NA)[(ntrim + 1):(n - ntrim)] + sum(x@x) / length(x) } - 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.out = 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.out = 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] - } +.V.rep.each <- function(x, each) { + each <- as.double(each) + if(length(each) != 1L) { + warning(gettextf("first element used of '%s' argument", "each"), + domain = NA) + each <- each[1L] + } + if(!is.finite(each) || each <= -1) + stop(gettextf("invalid '%s' argument", "each"), domain = NA) + if(each < 1) + return(x[0L]) + if(each < 2) + return(x) + n <- length(x) + each <- trunc(each) + if(n * each > 0x1p+53) + stop(gettextf("%s length cannot exceed %s", "sparseVector", "2^53"), + domain = NA) + else if(n * each > .Machine$integer.max) { + a <- as.double + one <- 1 + } else { + each <- as.integer(each) + a <- as.integer + one <- 1L + } + x@length <- n * each + x@i <- rep(each * (a(x@i) - one), each = each) + seq_len(each) + if(.M.kind(x) != "n") + x@x <- rep(x@x, each = each) 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) -rm(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)) -} - -## MJ: unused -if(FALSE) { -## 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 +.V.rep.int <- function(x, times) { + times <- as.double(times) + if(length(times) != 1L) { + ## FIXME: support length(times) == length(x) + warning(gettextf("first element used of '%s' argument", "times"), + domain = NA) + times <- times[1L] + } + if(!is.finite(times) || times <= -1) + stop(gettextf("invalid '%s' argument", "times"), domain = NA) + if(times < 1) + return(x[0L]) + if(times < 2) + return(x) + n <- length(x) + times <- trunc(times) + if(n * times > 0x1p+53) + stop(gettextf("%s length cannot exceed %s", "sparseVector", "2^53"), + domain = NA) + else if(n * times > .Machine$integer.max) { + a <- as.double + zero <- 0 + } else { + times <- as.integer(times) + a <- as.integer + zero <- 0L } - ## 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@length <- n * times + x@i <- rep(a(seq.int(from = zero, by = n, length.out = times)), + each = length(x@i)) + x@i + if(.M.kind(x) != "n") + x@x <- rep.int(x@x, times) 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] +.V.rep.len <- function(x, length.out) { + length.out <- as.double(length.out) + if(length(length.out) != 1L) { + warning(gettextf("first element used of '%s' argument", "length.out"), + domain = NA) + length.out <- length.out[1L] + } + if(!is.finite(length.out) || length.out <= -1) + stop(gettextf("invalid '%s' argument", "length.out"), domain = NA) + if(length.out > 0x1p+53) + stop(gettextf("%s length cannot exceed %s", "sparseVector", "2^53"), + domain = NA) + n <- length(x) + length.out <- + if(length.out - 1 < .Machine$integer.max) + as.integer(length.out) + else trunc(length.out) + if(length.out > n && n > 0L) { + x <- .V.rep.int(x, ceiling(length.out / n)) + n <- length(x) + } + x@length <- length.out + if(length.out < n) { + head <- x@i <= length.out + x@i <- x@i[head] + if(.M.kind(x) != "n") + x@x <- x@x[head] + } else if(length.out > n && n == 0L) { + x@i <- seq_len(length.out) + if(.M.kind(x) != "n") + x@x <- rep.int(x@x[NA_integer_], length.out) } - ## TODO - .NotYetImplemented() -} - -##' 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 } -} ## MJ - -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)) - - if(is.logical(t.x)) - all.equal.raw(t.x, c.x, ...) - else - all.equal.numeric(t.x, c.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. +setMethod("rep", signature(x = "sparseVector"), + function(x, times, length.out, each, ...) { + if(!missing(each)) + x <- .V.rep.each(x, each) + if(!missing(length.out)) + x <- .V.rep.len (x, length.out) + else if(!missing(times)) + x <- .V.rep.int (x, times) + x + }) -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) - } +.V.sort <- function(x, decreasing = FALSE, na.last = NA, ...) { + nnz <- length(x@i) + if(nnz == 0L) + return(x) + n <- length(x) + kind <- .M.kind(x) + if(kind == "n") { + x@i <- if(decreasing) + seq_len(nnz) + else seq.int(to = n, length.out = nnz) 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@x <- y <- sort.int(x@x, na.last = na.last, + decreasing = decreasing, ...) + if(!is.na(na.last)) + nna <- if(anyNA(y)) sum(is.na(y)) else 0L + else { + x@length <- n <- n - (nnz - length(y)) + nna <- 0L + nnz <- length(y) + } + nnn <- switch(kind, + "l" = nnz - nna, + "i" = sum(y >= 0L, na.rm = TRUE), + "d" = sum(y >= 0 , na.rm = TRUE), + "z" = + { + arg <- Arg(y) + hpi <- 0.5 * pi + sum(arg > -hpi & arg <= hpi, na.rm = TRUE) + }, + stop("should never happen ...")) + if(nna > 0L && decreasing != na.last) + nnn <- nnn + nna + x@i <- + if(nnn < nnz) { + if(decreasing) + c(seq_len(nnn), seq.int(to = n, length.out = nnz - nnn)) + else + c(seq_len(nnz - nnn), seq.int(to = n, length.out = nnn)) + } else { + if(decreasing) + seq_len(nnn) + else + seq.int(to = n, length.out = nnn) + } 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 -## ------- - - -##' 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) - ## ^^^^^ returning TsparseMatrix - 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) - Matrix.msg("'giveCsparse' has been deprecated; will use 'repr' instead") - } - switch(match.arg(repr), "C" = .M2C(r), "T" = r, "R" = .M2R(r)) -} -setMethod("toeplitz", "sparseVector", .toeplitz.spV) -rm(.toeplitz.spV) +if(FALSE) { +## MJ: once 'sort' becomes implicit generic in package 'methods' : +setMethod("sort", signature(x = "sparseVector"), .V.sort) +## TODO: parallel method for internal generic 'xtfrm' +} + +setMethod("t", signature(x = "sparseVector"), + function(x) .tCRT(.V2C(x))) + +setMethod("toeplitz", signature(x = "sparseVector"), + function(x, symmetric = TRUE, repr = c("C", "R", "T"), + giveCsparse, ...) { + n <- length(x) + if(n > .Machine$integer.max) + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), + domain = NA) + nn <- c(n, n) + r <- spV2M(x[as.integer(abs(.col(nn) - .row(nn))) + 1L], + nrow = n, ncol = n, symmetric = symmetric, + check = FALSE) + repr <- # keep in sync with sparseMatrix + if(missing(giveCsparse)) + match.arg(repr) + else if(!missing(repr)) { + warning(gettextf("'%s' is deprecated; using '%s' instead", + "giveCsparse", "repr"), + domain = NA) + match.arg(repr) + } else if(giveCsparse) { + "C" + } else { + warning(gettextf("'%s' is deprecated; setting %s=\"%s\"", + "giveCsparse", "repr", "T"), + domain = NA) + "T" + } + switch(repr, "C" = .M2C(r), "R" = .M2R(r), "T" = r) + }) diff -Nru rmatrix-1.6-1.1/R/subassign.R rmatrix-1.6-5/R/subassign.R --- rmatrix-1.6-1.1/R/subassign.R 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/R/subassign.R 2023-12-27 04:50:39.000000000 +0000 @@ -0,0 +1,1679 @@ +## METHODS FOR GENERIC: [<- +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +## GOAL: automate method definitions and eventually replace the ones +## collected below ... +## +## need to write C-level functions +## +## *_subassign_1ary (x, i, value) +## *_subassign_1ary_mat(x, i, value) +## *_subassign_2ary (x, i, j, value) +## +## for * = unpackedMatrix,packedMatrix, +## CsparseMatrix,RsparseMatrix,TsparseMatrix, +## diagonalMatrix,indMatrix + +if(FALSE) { # TODO +.subassign.invalid <- function(value) { + if(is.object(i)) + gettextf("invalid subassignment value class \"%s\"", class(i)[1L]) + else gettextf("invalid subassignment value type \"%s\"", typeof(i)) +} + +.subassign.1ary <- function(x, i, value) { + +} + +..subassign.1ary <- function(x, i, value) { + +} + +.subassign.1ary.mat <- function(x, i, value) { + +} + +..subassign.1ary.mat <- function(x, i, value) { + +} + +.subassign.2ary <- function(x, i, j, value) { + +} + +..subassign.2ary <- function(x, i, j, value) { + +} + +setMethod("[<-", signature(x = "Matrix", i = "missing", j = "missing", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + na <- nargs() + if(na <= 4L) + ## x[], x[, ] <- value + .subassign.1ary(x, , value) + else + ## x[, , ], etc. <- value + stop("incorrect number of dimensions") + }) + +setMethod("[<-", signature(x = "Matrix", i = "index", j = "missing", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + na <- nargs() + if(na == 3L) + ## x[i=] <- value + .subassign.1ary(x, i, value) + else if(na == 4L) + ## x[i=, ], x[, i=] <- value + .subassign.2ary(x, i, , value) + else + ## x[i=, , ], etc. <- value + stop("incorrect number of dimensions") + }) + +setMethod("[<-", signature(x = "Matrix", i = "missing", j = "index", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + na <- nargs() + if(na == 3L) + ## x[j=] <- value + .subassign.1ary(x, j, value) + else if(na == 4L) + ## x[j=, ], x[, j=] <- value + .subassign.2ary(x, , j, value) + else + ## x[, j=, ], etc. <- value + stop("incorrect number of dimensions") + }) + +setMethod("[<-", signature(x = "Matrix", i = "index", j = "index", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + na <- nargs() + if(na == 4L) + ## x[i=, j=], x[j=, i=] <- value + .subassign.2ary(x, i, j, value) + else + ## x[i=, j=, ], etc. <- value + stop("incorrect number of dimensions") + }) + +for(.cl in c("matrix", "nMatrix", "lMatrix")) +setMethod("[<-", signature(x = "Matrix", i = .cl, j = "missing", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + na <- nargs() + if(na == 3L) + ## x[i=] <- value + .subassign.1ary.mat(x, i, value) + else if(na == 4L) + ## x[i=, ], x[, i=] <- value + .subassign.2ary(x, i, , value) + else + ## x[i=, , ], etc. <- value + stop("incorrect number of dimensions") + }) +rm(.cl) + +setMethod("[<-", signature(x = "Matrix", i = "NULL", j = "ANY", + value = "ANY"), + function(x, i, j, ..., value) { + i <- integer(0L) + callGeneric() + }) + +setMethod("[<-", signature(x = "Matrix", i = "ANY", j = "NULL", + value = "ANY"), + function(x, i, j, ..., value) { + j <- integer(0L) + callGeneric() + }) + +setMethod("[<-", signature(x = "Matrix", i = "NULL", j = "NULL", + value = "ANY"), + function(x, i, j, ..., value) { + i <- integer(0L) + j <- integer(0L) + callGeneric() + }) + +setMethod("[<-", signature(x = "sparseVector", i = "missing", j = "missing", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + if(nargs() > 3L) + stop("incorrect number of dimensions") + if(isS4(value)) { + if(!.isVector(value)) + stop(.subassign.invalid(value), domain = NA) + } else + value <- switch(typeof(value), + "logical" =, + "integer" =, + "double" =, + "complex" = .m2V(value), + stop(.subassign.invalid(value), domain = NA)) + n.x <- length(x) + n.value <- length(value) + if(n.x > 0L && n.value == 0L) + stop("replacement has length zero") + k.x <- .M2kind(x) + k.value <- .M2kind(value) + if(k.x != k.value) { + map <- `names<-`(1:5, c("n", "l", "i", "d", "z")) + if(map[[k.value]] < map[[k.x]]) + value <- .V2kind(value, k.x) + } + if(n.value == 0L) + return(value) + if(n.x %% n.value != 0L) + warning("number of items to replace is not a multiple of replacement length") + .V.rep.len(value, n.x) + }) + +setMethod("[<-", signature(x = "sparseVector", i = "index", j = "missing", + value = "ANY"), + function(x, i, j, ..., value) { + if(missing(value)) + stop("missing subassignment value") + if(nargs() > 3L) + stop("incorrect number of dimensions") + if(isS4(value)) { + if(!.isVector(value)) + stop(.subassign.invalid(value), domain = NA) + } else + value <- switch(typeof(value), + "logical" =, + "integer" =, + "double" =, + "complex" = .m2V(value), + stop(.subassign.invalid(value), domain = NA)) + switch(typeof(i), + "logical" = {}, + "integer" = {}, + "double" = {}, + stop(.subscript.invalid(value), domain = NA)) + k.x <- .M2kind(x) + k.value <- .M2kind(value) + if(k.x != k.value) { + map <- `names<-`(1:5, c("n", "l", "i", "d", "z")) + if(map[[k.x]] < map[[k.value]]) + x <- .V2kind(x, k.value) + } + ## TODO + }) + +setMethod("[<-", signature(x = "sparseVector", i = "nsparseVector", j = "missing", + value = "ANY"), + function(x, i, j, ..., drop = TRUE) { + if(missing(value)) + stop("missing subassignment value") + if(nargs() > 3L) + stop("incorrect number of dimensions") + x[.subscript.recycle(i, length(x), TRUE)] <- value + x + }) + +setMethod("[<-", signature(x = "sparseVector", i = "lsparseVector", j = "missing", + value = "ANY"), + function(x, i, j, ..., drop = TRUE) { + if(missing(value)) + stop("missing subassignment value") + if(nargs() > 3L) + stop("incorrect number of dimensions") + x[.subscript.recycle(i, length(x), FALSE)] <- value + x + }) + +setMethod("[<-", signature(x = "sparseVector", i = "NULL", j = "ANY", + value = "ANY"), + function(x, i, j, ..., value) { + i <- integer(0L) + callGeneric() + }) +} # TODO + +## ==== Matrix ========================================================= + +## 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) + `[<-`(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) +rm(.repl.i.lDMat) + +.repl.i.lSMat <- function (x, i, j, ..., value) + `[<-`(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) +rm(.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") + }) + + +## ==== denseMatrix ==================================================== + +## x[] <- value : +setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "missing", + value = "ANY"),## double/logical/... + function (x, value) { + x <- .M2gen(x) + 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) + .m2dense(r, paste0(.M.kind(x), "ge")) + }) + +setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "index", + value = "replValue"), + function (x, i, j, ..., value) { + r <- as(x, "matrix") + r[, j] <- value + .m2dense(r, paste0(.M.kind(x), "ge")) + }) + +setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "index", + value = "replValue"), + function (x, i, j, ..., value) { + r <- as(x, "matrix") + r[i, j] <- value + as_denseClass(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 + .m2dense(r, paste0(.M.kind(x), "ge")) + }) + + +## ==== sparseMatrix =================================================== + +## 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"))) + + +## ==== CsparseMatrix ================================================== + +## 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.message("replCmat[x,i,j,..,val] : nargs()=", na, "; ", + if(iMi || jMi) sprintf("missing (i,j) = (%d,%d)", iMi, jMi), + .M.level = 2) + if(na == 3L) { ## vector (or 2-col) indexing M[i] <- v : includes M[TRUE] <- v or M[] <- v ! + x <- .M2T(x) + x[i] <- value # may change class, e.g., from dtT* to dgT* + cl.C <- sub(".Matrix$", "CMatrix", class(x)) + if(.hasSlot(x, "x") && any0(x@x)) + ## drop all values that "happen to be 0" + drop0(x, is.Csparse = FALSE) + else as_CspClass(x, cl.C) + } else ## nargs() == 4 : + replCmat4(x, + i1 = if(iMi) + seq.int(from = 0L, length.out = di[1L]) + else .ind.prep2(i, 1L, di, dn), + i2 = if(jMi) + seq.int(from = 0L, length.out = di[2L]) + else .ind.prep2(j, 2L, 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 != 0L) + stop("nothing to replace with") + return(x) + } + ## else: lenV := length(value) is > 0 + if(lenRepl %% lenV != 0L) + 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[1L], dim[2L]) else array + x.sym <- + (dind[1L] == dind[2L] && all(i1 == i2) && + (lenRepl == 1L || lenV == 1L || + isSymmetric(mkArray(value, dim=dind)))) + ## x.sym : result is *still* symmetric + x <- .M2gen(x) ## but do *not* redefine clx! + } + else if(extends(clDx, "triangularMatrix")) { + xU <- x@uplo == "U" + r.tri <- ((any(dind == 1) || dind[1L] == dind[2L]) && + 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 (do not redefine clx!) and continue + x <- .M2gen(x) # was as(x, paste0(.M.kind(x), "gCMatrix")) + } + } + ## 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: + if(i1[1L] != 0L) + i1[1L] <- -i1[1L] + else 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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 .M2gen(x), # must get "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 cached ones + x@factors <- list() + if(has0) x <- .drop0(x) + + 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.message("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 cached 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) +rm(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")) + + +## ==== RsparseMatrix ================================================== + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", + value = "replValue"), + function (x, i, j, ..., value) + replTmat(.M2T(x), i=i, , value=value)) + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", + value = "replValue"), + function (x, i, j, ..., value)# extra " , ": want nargs() == 4 + replTmat(.M2T(x), , j=j, value=value)) + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", + value = "replValue"), + function (x, i, j, ..., value) + replTmat(.M2T(x), i=i, j=j, value=value)) + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "missing", + value = "sparseVector"), + function (x, i, j, ..., value) { + if(nargs() == 3L) + replTmat(.M2T(x), i=i, value=value) # x[i] <- v + else replTmat(.M2T(x), i=i, , value=value) # x[i, ] <- v + }) + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "missing", j = "index", + value = "sparseVector"), + function (x, i, j, ..., value)# extra " , ": want nargs() == 4 + replTmat(.M2T(x), , j=j, value=value)) + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "index", j = "index", + value = "sparseVector"), + function (x, i, j, ..., value) + replTmat(.M2T(x), i=i, j=j, value=value)) + + +setReplaceMethod("[", signature(x = "RsparseMatrix", i = "matrix", j = "missing", + value = "replValue"), + function (x, i, j, ..., value) { + if(nargs() == 3L) + .TM.repl.i.mat(.M2T(x), i=i, value=value) + else replTmat(.M2T(x), i=as.vector(i), , value=value) + }) + + +## ==== TsparseMatrix ================================================== + +##' 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) + +### 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.message("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 <- .M2gen(x) + Matrix.message("'sub-optimal sparse 'x[i] <- v' assignment: Coercing class ", + cl," to ",class(x)) + } + nr <- di[1] + x <- aggregateT(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 cached 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 cached ones + x@factors <- list() + return(x) + } ## {nargs = 3; x[ii] <- value } + + ## nargs() == 4 : x[i,j] <- value + ## -------------------------------------------------------------------------- + lenV <- length(value) + Matrix.message(".. 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: + x <- aggregateT(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 + Matrix.message("M[i,j] <- v : coercing symmetric M[] into non-symmetric") + x <- .M2gen(x) + 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 cached 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 cached 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(!isTRUE(getOption("Matrix.quiet"))) + message(gettextf("x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix"), + domain = NA) + return(replCmat4(.M2C(x), 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 cached 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.message(".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.message(".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: + x <- aggregateT(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 + Matrix.message("M[ij] <- v : coercing symmetric M[] into non-symmetric") + x <- .M2gen(x) + clDx <- getClassDef(clx <- class(x)) + } + + ii.v <- .Call(m_encodeInd, i, di, orig1=TRUE, checkBounds = TRUE) + if(id <- anyDuplicated(ii.v, fromLast=TRUE)) { + Matrix.message("M[ij] <- v : duplicate ij-entries; using last") + 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 <- is.logical(value) # will result remain "nMatrix" ? + if(!isN) + x <- .M2kind(x, "d") + } + 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 <- is0(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 cached 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) + + +## ==== diagonalMatrix ================================================= + +## 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 <- .diag2sparse(x, ".", "g", "C") # was ->TsparseMatrix 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 == 4L) + x[i, ] <- value + else if(na == 3L) + 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)) + forceDiagonal(x) + else if(isSymmetric(x)) + forceSymmetric(x) + else if(!(it <- isTriangular(x))) + x + else if(attr(it, "kind") == "U") + triu(x) + else tril(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() == 3L) + 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.kind(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) == 2L) { + if(all((ii <- i[,1L]) == i[,2L])) { + ## 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[1L]) + } 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 + x <- .diag2sparse(x, ".", "t", "C") # 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) + + +## ==== indMatrix ====================================================== + +.indMatrix.sub <- function(x, i, j, ..., value) { + x <- as(x, "TsparseMatrix") + callGeneric() +} +for (.i in c("missing", "index")) +for (.j in c("missing", "index")) +setReplaceMethod("[", signature(x = "indMatrix", i = .i, j = .j, value = "ANY"), + .indMatrix.sub) +rm(.indMatrix.sub, .i, .j) + + +## ==== sparseVector =================================================== + +## This is a simplified intI() -- for sparseVector indexing: +intIv <- function(i, n, cl.i = getClassDef(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() + +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.out = 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.out = 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) diff -Nru rmatrix-1.6-1.1/R/subscript.R rmatrix-1.6-5/R/subscript.R --- rmatrix-1.6-1.1/R/subscript.R 2023-06-23 16:21:15.000000000 +0000 +++ rmatrix-1.6-5/R/subscript.R 2023-12-27 04:50:39.000000000 +0000 @@ -1,82 +1,67 @@ ## METHODS FOR GENERIC: [ ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -## GOAL: automate method definitions and eventually replace ones in -## -## ./Csparse.R -## ./Matrix.R -## ./Tsparse.R -## ./denseMatrix.R -## ./diagMatrix.R -## ./indMatrix.R -## ./packedMatrix.R -## ./sparseMatrix.R -## -## need to write C-level functions -## -## *_subscript_1ary (x, i ) -## *_subscript_1ary_mat(x, i ) -## *_subscript_2ary (x, i, j, drop) -## -## for * = unpackedMatrix,packedMatrix, -## CsparseMatrix,RsparseMatrix,TsparseMatrix, -## diagonalMatrix,indMatrix - -.subscript.error.ist <- function(i) { - if(isS4(i)) - gettextf("invalid subscript class \"%s\"", class(i)) +.subscript.invalid <- function(i) { + if(is.object(i)) + gettextf("invalid subscript class \"%s\"", class(i)[1L]) else gettextf("invalid subscript type \"%s\"", typeof(i)) } +.subscript.recycle <- function(i, n, pattern) { + ## Return integer or double vector corresponding + ## to [nl]sparseVector 'i' recycled to length 'n' : + if(length(i.i <- i@i) == 0L) + integer(0L) + else if((i.length <- length(i)) >= n) { + if(i.length > n) { + if(n < 0x1p+53) { + if(i.i[length(i.i)] >= n + 1) + i.i[i.i >= n + 1] <- NA + } else { + if(i.i[length(i.i)] > n) + i.i[i.i > n] <- NA + } + } + if(pattern) i.i else i.i[i@x] + } else { + r <- ceiling(n / i.length) + n. <- r * i.length + i.i <- + if(n. <= .Machine$integer.max) + rep.int(as.integer(i.i), r) + + rep(seq.int(from = 0L, + by = as.integer(i.length), + length.out = r), + each = length(i.i)) + else if(i.i[length(i.i)] + (r - 1) * i.length <= 0x1p+53) + rep.int(as.double(i.i), r) + + rep(seq.int(from = 0, + by = as.double(i.length), + length.out = r), + each = length(i.i)) + else stop(gettextf("recycled %s would have maximal index exceeding %s", + "[nl]sparseVector", "2^53"), + domain = NA) + if(pattern) { + if(n. > n) i.i[ i.i <= n] else i.i + } else { + if(n. > n) i.i[i@x & i.i <= n] else i.i[i@x] + } + } +} + ## x[i] where 'i' is NULL or any vector or sparseVector .subscript.1ary <- function(x, i) { - mn <- prod(x@Dim) + x.length <- prod(x@Dim) if(is.null(i)) i <- integer(0L) else if(isS4(i)) { if(!.isVector(i)) - stop(.subscript.error.ist(i), domain = NA) - kind <- .V.kind(i) + stop(.subscript.invalid(i), domain = NA) + kind <- .M.kind(i) if((pattern <- kind == "n") || kind == "l") { ## [nl]sparseVector - i <- - if(length(i.i <- i@i) == 0L) - integer(0L) - else if((i.length <- i@length) >= mn) { - if(i.length > mn) { - if(mn < 0x1p+53) { - if(i.i[length(i.i)] >= mn + 1) - i.i[i.i >= mn + 1] <- NA - } else { - if(i.i[length(i.i)] > mn) - i.i[i.i > mn] <- NA - } - } - if(pattern) i.i else i.i[i@x] - } else { - r <- ceiling(mn / i.length) - mn. <- r * i.length - i.i <- - if(mn. <= .Machine$integer.max) - rep.int(as.integer(i.i), r) + - rep(seq.int(from = 0L, - by = as.integer(i.length), - length.out = r), - each = length(i.i)) - else if(i.i[length(i.i)] + (r - 1) * i.length <= - 0x1p+53) - rep.int(as.double(i.i), r) + - rep(seq.int(from = 0, - by = as.double(i.length), - length.out = r), - each = length(i.i)) - else stop("recycled [nl]sparseVector would have maximal index exceeding 2^53") - if(pattern) { - if(mn. > mn) i.i[ i.i <= mn] else i.i - } else { - if(mn. > mn) i.i[i@x & i.i <= mn] else i.i[i@x] - } - } + i <- .subscript.recycle(i, x.length, pattern) return(..subscript.1ary(x, i, unsorted = !pattern && anyNA(i))) } i <- i@x @@ -87,7 +72,7 @@ r <- min(1, i, na.rm = TRUE) if(r < 1) i <- if(r <= -1) - seq_len(mn)[i] # FIXME + seq_len(x.length)[i] # FIXME else i[i >= 1] ..subscript.1ary(x, i) }, @@ -96,25 +81,24 @@ r <- min(1L, i, na.rm = TRUE) if(r < 1L) i <- if(r <= -1L) - seq_len(mn)[i] # FIXME + seq_len(x.length)[i] # FIXME else i[i >= 1L] ..subscript.1ary(x, i) }, logical = { - if(length(i) && !is.na(a <- all(i)) && a) { - if((len <- length(i)) <= mn) - return(as.vector(x)) - else return(c(as.vector(x), rep.int(NA, len - mn))) - } - .subscript.1ary(x, as(i, "sparseVector")) # recursively + if((i.length <- length(i)) && !is.na(a <- all(i)) && a) { + if(i.length <= x.length) + as.vector(x) + else c(as.vector(x), rep.int(NA, i.length - x.length)) + } else .subscript.1ary(x, .m2V(i)) # recursively }, character = { rep.int(if(.hasSlot(x, "x")) x@x[NA_integer_] else NA, length(i)) }, - stop(.subscript.error.ist(i), domain = NA)) + stop(.subscript.invalid(i), domain = NA)) } ## x[i] where 'i' is vector of type "integer" or "double" @@ -128,17 +112,18 @@ if(shape == "t" && x@diag != "N") x <- ..diagU2N(x) if(shape == "s" || repr == "R") { - mn <- prod(d <- x@Dim) - if(mn < 0x1p+53) { - r <- max(mn, i, na.rm = TRUE) - if(r >= mn + 1) - i[i >= mn + 1] <- NA + x.length <- prod(d <- x@Dim) + if(x.length < 0x1p+53) { + r <- max(x.length, i, na.rm = TRUE) + if(r >= x.length + 1) + i[i >= x.length + 1] <- NA } else if(is.double(i)) { r <- max(0x1p+53, i, na.rm = TRUE) if(r > 0x1p+53) { - if(any(i > 0x1p+53 && i <= mn, na.rm = TRUE)) + if(any(i > 0x1p+53 && i <= x.length, na.rm = TRUE)) ## could be avoided in C, which has 64-bit integers : - warning("subscripts exceeding 2^53 replaced with NA") + warning(gettextf("subscripts exceeding %s replaced with NA", "2^53"), + domain = NA) i[i > 0x1p+53] <- NA } } @@ -153,7 +138,7 @@ j.. <- j.[w] if(repr == "R") i.[w] <- j.. - if(mn > .Machine$integer.max) + if(x.length > .Machine$integer.max) m <- as.double(m) i[w] <- m * i.. + j.. + 1L } @@ -176,16 +161,16 @@ .subscript.1ary.mat <- function(x, i) { if(isS4(i)) { if(!.isMatrix(i)) - stop(.subscript.error.ist(i), domain = NA) + stop(.subscript.invalid(i), domain = NA) if((logic <- any(.M.kind(i) == c("n", "l"))) || i@Dim[2L] != 2L) { if(logic && all(i@Dim) && !is.na(a <- all(i)) && a) { x <- as.vector(x) - if((len <- prod(i@Dim)) <= (mn <- length(x))) + if((i.length <- length(i)) <= (x.length <- length(x))) return(x) - else return(c(x, rep.int(NA, len - mn))) + else return(c(x, rep.int(NA, i.length - x.length))) } - v <- if(.isDense(i)) "vector" else "sparseVector" - return(.subscript.1ary(x, as(i, v))) + i <- if(.isDense(i)) .M2v(i) else .M2V(i) + return(.subscript.1ary(x, i)) } i <- as(i, "matrix") } else if(is.logical(i) || length(di <- dim(i)) != 2L || di[2L] != 2L) @@ -230,7 +215,7 @@ stop("subscript out of bounds") ..subscript.1ary.mat(x, m) }, - stop(.subscript.error.ist(i), domain = NA)) + stop(.subscript.invalid(i), domain = NA)) } ## x[i] where 'i' is a 2-column matrix of type "integer" @@ -314,11 +299,11 @@ stop("subscript out of bounds") else k }, - stop(.subscript.error.ist(k), domain = NA))) + stop(.subscript.invalid(k), domain = NA))) } } if(is.double(lengths(l, use.names = FALSE))) - stop("dimensions cannot exceed 2^31-1") + stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) ..subscript.2ary(x, l[[1L]], l[[2L]], drop = drop[1L]) } @@ -342,188 +327,362 @@ setMethod("[", signature(x = "Matrix", i = "missing", j = "missing", drop = "missing"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - ".", ".", ".", na), - .M.level = 2) - if(na == 2L) { + if(na == 2L) ## x[] x - } else if(na == 3L) { + else if(na == 3L) ## x[, ] drop(x) - } else { + else ## x[, , ], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "missing", j = "missing", drop = "logical"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - ".", ".", "l", na), - .M.level = 2) - if(na < 4L) { + if(na < 4L) ## x[drop=], x[, drop=], x[drop=, ] x - } else if(na == 4L) { + else if(na == 4L) ## x[, , drop=], x[, drop=, ], x[drop=, , ] if(is.na(drop <- drop[1L]) || drop) drop(x) else x - } else { + else ## x[, , , drop=], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "index", j = "missing", drop = "missing"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - "i", ".", ".", na), - .M.level = 2) - if(na == 2L) { + if(na == 2L) ## x[i=] .subscript.1ary(x, i) - } else if(na == 3L) { + else if(na == 3L) ## x[i=, ], x[, i=] .subscript.2ary(x, i, , drop = TRUE) - } else { + else ## x[i=, , ], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "index", j = "missing", drop = "logical"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - "i", ".", "l", na), - .M.level = 2) - if(na == 3L) { + if(na == 3L) ## x[i=, drop=] .subscript.1ary(x, i) - } else if(na == 4L) { + else if(na == 4L) ## x[i=, , drop=], x[, i=, drop=] .subscript.2ary(x, i, , drop = drop) - } else { + else ## x[i=, , , drop=], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "missing", j = "index", drop = "missing"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - ".", "i", ".", na), - .M.level = 2) - if(na == 2L) { + if(na == 2L) ## x[j=] .subscript.1ary(x, j) - } else if(na == 3L) { + else if(na == 3L) ## x[j=, ], x[, j=] .subscript.2ary(x, , j, drop = TRUE) - } else { + else ## x[, j=, ], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "missing", j = "index", drop = "logical"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - ".", "i", "l", na), - .M.level = 2) - if(na == 3L) { + if(na == 3L) ## x[j=, drop=] .subscript.1ary(x, j) - } else if(na == 4L) { + else if(na == 4L) ## x[j=, , drop=], x[, j=, drop=] .subscript.2ary(x, , j, drop = drop) - } else { + else ## x[, j=, , drop=], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "index", j = "index", drop = "missing"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - "i", "i", ".", na), - .M.level = 2) - if(na == 3L) { + if(na == 3L) ## x[i=, j=], x[j=, i=] .subscript.2ary(x, i, j, drop = TRUE) - } else { + else ## x[i=, j=, ], etc. stop("incorrect number of dimensions") - } }) setMethod("[", signature(x = "Matrix", i = "index", j = "index", drop = "logical"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - "i", "i", "l", na), - .M.level = 2) - if(na == 4L) { + if(na == 4L) ## x[i=, j=, drop=], x[j=, i=, drop=] .subscript.2ary(x, i, j, drop = drop) - } else { + else ## x[i=, j=, , drop=], etc. stop("incorrect number of dimensions") - } }) for(.cl in c("matrix", "nMatrix", "lMatrix")) setMethod("[", signature(x = "Matrix", i = .cl, j = "missing", drop = "missing"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { na <- nargs() - Matrix.msg(sprintf("M[%s%s%s] : nargs() = %d", - "m", ".", ".", na), - .M.level = 2) - if(na == 2L) { + if(na == 2L) ## x[i=] .subscript.1ary.mat(x, i) - } else if(na == 3L) { + else if(na == 3L) ## x[i=, ], x[, i=] .subscript.2ary(x, i, , drop = TRUE) - } else { + else ## x[i=, , ], etc. stop("incorrect number of dimensions") - } }) +rm(.cl) setMethod("[", signature(x = "Matrix", i = "NULL", j = "ANY", drop = "ANY"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { i <- integer(0L) callGeneric() }) setMethod("[", signature(x = "Matrix", i = "ANY", j = "NULL", drop = "ANY"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { j <- integer(0L) callGeneric() }) setMethod("[", signature(x = "Matrix", i = "NULL", j = "NULL", drop = "ANY"), - function(x, i, j, ..., drop) { + function(x, i, j, ..., drop = TRUE) { i <- integer(0L) j <- integer(0L) callGeneric() }) + +setMethod("[", signature(x = "sparseVector", i = "missing", j = "missing", + drop = "missing"), + function(x, i, j, ..., drop = TRUE) { + if(nargs() != 2L) + stop("incorrect number of dimensions") + x + }) + +setMethod("[", signature(x = "sparseVector", i = "index", j = "missing", + drop = "missing"), + function(x, i, j, ..., drop = TRUE) { + if(nargs() != 2L) + stop("incorrect number of dimensions") + x.length <- length(x) + pattern <- .M.kind(x) == "n" + switch(typeof(i), + double = + { + r <- min(1, i, na.rm = TRUE) + if(r <= -1) { + if(r <= -x.length - 1) + i <- i[i > -x.length - 1] + r <- max(-1, i) + if(is.na(r) || r >= 1) + stop("only zeros may be mixed with negative subscripts") + if(r > -1) + i <- i[i <= -1] + d <- unique.default(sort.int(-trunc(i))) + k <- match(x@i, d, 0L) == 0L + x@length <- length(x) - length(d) + x@i <- + { + tmp <- x@i[k] + tmp - findInterval(tmp, d) # !! + } + if(!pattern) + x@x <- x@x[k] + } else { + if(r < 1) + i <- i[i >= 1] + if(max(0, i, na.rm = TRUE) >= x.length + 1) + i[i >= x.length + 1] <- NA + if((a <- anyNA(i)) && pattern) { + x <- .V2kind(x, "l") + pattern <- FALSE + } + j <- match(trunc(i), x@i, 0L) + x@length <- length(i) + x@i <- + if(!a) + which(j != 0L) + else { + i. <- is.na(i) + j[i.] <- NA + which(j != 0L | i.) + } + if(!pattern) + x@x <- x@x[j] + } + x + }, + integer = + { + r <- min(1L, i, na.rm = TRUE) + if(r <= -1L) { + if(r < -x.length) + i <- i[i >= -x.length] + r <- max(-1L, i) + if(is.na(r) || r >= 1L) + stop("only zeros may be mixed with negative subscripts") + if(r > -1L) + i <- i[i <= -1L] + d <- unique.default(sort.int(-i)) + k <- is.na(match(x@i, d)) + x@length <- length(x) - length(d) + x@i <- + { + tmp <- x@i[k] + tmp - findInterval(tmp, d) # !! + } + if(!pattern) + x@x <- x@x[k] + } else { + if(r < 1L) + i <- i[i >= 1L] + if(max(0L, i, na.rm = TRUE) > x.length) + i[i > x.length] <- NA + if((a <- anyNA(i)) && pattern) { + x <- .V2kind(x, "l") + pattern <- FALSE + } + j <- match(i, x@i, 0L) + x@length <- length(i) + x@i <- + if(!a) + which(j != 0L) + else { + i. <- is.na(i) + j[i.] <- NA + which(j != 0L | i.) + } + if(!pattern) + x@x <- x@x[j] + } + x + }, + logical = + { + if((i.length <- length(i)) && !is.na(a <- all(i)) && a) { + if(i.length > x.length) { + if(pattern) + x <- .V2kind(x, "l") + x@length <- i.length + x@i <- c(x@i, (x.length + 1):i.length) + x@x <- c(x@x, rep.int(NA, i.length - x.length)) + } + x + } else x[.m2V(i)] # recursively + }, + stop(.subscript.invalid(i), domain = NA)) + }) + +setMethod("[", signature(x = "sparseVector", i = "nsparseVector", j = "missing", + drop = "missing"), + function(x, i, j, ..., drop = TRUE) { + if(nargs() != 2L) + stop("incorrect number of dimensions") + x[.subscript.recycle(i, length(x), TRUE)] + }) + +setMethod("[", signature(x = "sparseVector", i = "lsparseVector", j = "missing", + drop = "missing"), + function(x, i, j, ..., drop = TRUE) { + if(nargs() != 2L) + stop("incorrect number of dimensions") + x[.subscript.recycle(i, length(x), FALSE)] + }) + +setMethod("[", signature(x = "sparseVector", i = "NULL", j = "ANY", + drop = "ANY"), + function(x, i, j, ..., drop = TRUE) { + i <- integer(0L) + callGeneric() + }) + + +## METHODS FOR GENERIC: head +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("head", signature(x = "Matrix"), + head.matrix) + +setMethod("head", signature(x = "sparseVector"), + function(x, n = 6L, ...) { + stopifnot(is.numeric(n), length(n) == 1L, !is.na(n)) + len <- length(x) + n <- if(n < 0L) max(len + n, 0L) else min(n, len) + if(n >= len) + return(x) + nnz <- length(i <- x@i) + x@length <- n <- if(is.integer(i)) as.integer(n) else trunc(n) + if(nnz > 0L && i[nnz] > n) { + pattern <- .M.kind(x) == "n" + if(i[1L] > n) { + x@i <- integer(0L) + if(!pattern) + x@x <- x@x[0L] + } else { + ii <- 1L:(which.max(i > n) - 1L) + x@i <- i[ii] + if(!pattern) + x@x <- x@x[ii] + } + } + x + }) + + +## METHODS FOR GENERIC: tail +## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +setMethod("tail", signature(x = "Matrix"), + tail.matrix) + +setMethod("tail", signature(x = "sparseVector"), + function(x, n = 6L, ...) { + stopifnot(is.numeric(n), length(n) == 1L, !is.na(n)) + len <- length(x) + n <- if(n < 0L) max(len + n, 0L) else min(n, len) + if(n >= len) + return(x) + nnz <- length(i <- x@i) + x@length <- n <- if(is.integer(i)) as.integer(n) else trunc(n) + if(nnz > 0L && i[1L] <= (k <- len - n)) { + pattern <- .M.kind(x) == "n" + if(i[nnz] <= k) { + x@i <- integer(0L) + if(!pattern) + x@x <- x@x[0L] + } else { + ii <- which.min(i <= k):nnz + x@i <- i[ii] - k + if(!pattern) + x@x <- x@x[ii] + } + } + x + }) diff -Nru rmatrix-1.6-1.1/R/symmetricMatrix.R rmatrix-1.6-5/R/symmetricMatrix.R --- rmatrix-1.6-1.1/R/symmetricMatrix.R 2023-07-30 16:54:38.000000000 +0000 +++ rmatrix-1.6-5/R/symmetricMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -## METHODS FOR CLASS: symmetricMatrix (virtual) -## Hermitian {incl. real, symmetric} matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("dimnames", signature(x = "symmetricMatrix"), - function(x) symmDN(x@Dimnames)) - -setMethod("isSymmetric", signature(object = "symmetricMatrix"), - function(object, ...) TRUE) - -setMethod("isTriangular", signature(object = "symmetricMatrix"), - function(object, upper = NA, ...) { - if(!isDiagonal(object)) - FALSE - else if(is.na(upper)) - `attr<-`(TRUE, "kind", "U") - else TRUE - }) diff -Nru rmatrix-1.6-1.1/R/triangularMatrix.R rmatrix-1.6-5/R/triangularMatrix.R --- rmatrix-1.6-1.1/R/triangularMatrix.R 2023-07-30 16:54:38.000000000 +0000 +++ rmatrix-1.6-5/R/triangularMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -## METHODS FOR CLASS: triangularMatrix (virtual) -## triangular matrices -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -setMethod("isTriangular", signature(object = "triangularMatrix"), - function(object, upper = NA, ...) { - if(is.na(upper)) - `attr<-`(TRUE, "kind", object@uplo) - else - object@uplo == (if(upper) "U" else "L") || isDiagonal(object) - }) - -## NB: [dz]t.Matrix should _not_ use this method as it does not -## tolerate numerical fuzz -setMethod("isSymmetric", signature(object = "triangularMatrix"), - function(object, checkDN = TRUE, ...) { - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - if(ca(...) && !isSymmetricDN(object@Dimnames)) - return(FALSE) - } - isDiagonal(object) - }) diff -Nru rmatrix-1.6-1.1/R/unpackedMatrix.R rmatrix-1.6-5/R/unpackedMatrix.R --- rmatrix-1.6-1.1/R/unpackedMatrix.R 2023-07-30 20:04:58.000000000 +0000 +++ rmatrix-1.6-5/R/unpackedMatrix.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,191 +0,0 @@ -## METHODS FOR CLASS: unpackedMatrix (virtual) ... and many for base matrices -## dense matrices with unpacked storage -## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.upM.subclasses <- names(getClassDef("unpackedMatrix")@subclasses) - -.upM.pack <- function(x, ...) - .Call(R_dense_as_packed, x, NULL, NULL) - -.upM.pack.ge <- .m.pack <- function(x, symmetric = NA, upperTri = NA, ...) { - if(((sna <- is.na(symmetric)) || symmetric) && isSymmetric(x, ...)) - .Call(R_dense_as_packed, x, "U", "") - else if((sna || !symmetric) && - (it <- isTriangular(x, upper = upperTri))) { - uplo <- - if(is.na(upperTri)) - attr(it, "kind") - else if(upperTri) - "U" - else "L" - .Call(R_dense_as_packed, x, uplo, "N") - } else { - if(sna) - stop("matrix is not symmetric or triangular") - else if(symmetric) - stop("matrix is not symmetric") - else stop("matrix is not triangular") - } -} -body(.m.pack)[[2L]][[3L]] <- - quote(.Call(R_matrix_as_dense, x, ".sp", "U", NULL)) -body(.m.pack)[[2L]][[4L]][[3L]][[3L]] <- - quote(.Call(R_matrix_as_dense, x, ".tp", uplo, "N")) - -setMethod("unpack", signature(x = "unpackedMatrix"), - function(x, ...) x) -setMethod("unpack", signature(x = "matrix"), - function(x, ...) .m2dense.checking(x, ".")) - -setMethod("pack", signature(x = "unpackedMatrix"), .upM.pack) -for(.cl in grep("^.geMatrix$", .upM.subclasses, value = TRUE)) -setMethod("pack", signature(x = .cl), .upM.pack.ge) -setMethod("pack", signature(x = "matrix"), .m.pack) - -rm(.cl, .upM.pack, .upM.pack.ge, .m.pack) - -setMethod("forceSymmetric", signature(x = "unpackedMatrix", uplo = "missing"), - function(x, uplo) .Call(unpackedMatrix_force_symmetric, x, NULL)) -setMethod("forceSymmetric", signature(x = "unpackedMatrix", uplo = "character"), - function(x, uplo) .Call(unpackedMatrix_force_symmetric, x, uplo)) - -setMethod("forceSymmetric", signature(x = "matrix", uplo = "missing"), - function(x, uplo) .Call(R_matrix_as_dense, x, ".sy", "U", NULL)) -setMethod("forceSymmetric", signature(x = "matrix", uplo = "character"), - function(x, uplo) .Call(R_matrix_as_dense, x, ".sy", uplo, NULL)) - -.upM.is.sy <- function(object, checkDN = TRUE, ...) { - ## backwards compatibility: don't check DN if check.attributes=FALSE - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - ## requiring exact symmetry: - .Call(unpackedMatrix_is_symmetric, object, checkDN) -} - -.upM.is.sy.dz <- function(object, tol = 100 * .Machine$double.eps, - tol1 = 8 * tol, checkDN = TRUE, ...) { - ## backwards compatibility: don't check DN if check.attributes=FALSE - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - ## be very fast when requiring exact symmetry - if(tol <= 0) - return(.Call(unpackedMatrix_is_symmetric, object, checkDN)) - ## pretest: is it square? - d <- object@Dim - if((n <- d[1L]) != d[2L]) - return(FALSE) - ## pretest: are DN symmetric in the sense of validObject()? - if(checkDN && !isSymmetricDN(object@Dimnames)) - return(FALSE) - if(n <= 1L) - return(TRUE) - object <- .M2gen(object) - ## now handling n-by-n [dz]geMatrix, n >= 2: - - Cj <- if(is.complex(object@x)) Conj else identity - ae <- function(check.attributes, ...) { - ## discarding possible user-supplied check.attributes - all.equal(..., check.attributes = FALSE) - } - - ## pretest: outermost rows ~= outermost columns? (fast for large asymmetric) - ## FIXME: quite inefficient, though, if subsetting must go through "matrix" - if(length(tol1)) { - i. <- if (n <= 4L) 1:n else c(1L, 2L, n-1L, n) - for(i in i.) - if(!isTRUE(ae(target = object[i, ], current = Cj(object[, i]), - tolerance = tol1, ...))) - return(FALSE) - } - ## followed by slower test using 't' - isTRUE(ae(target = object@x, current = Cj(t(object))@x, - tolerance = tol, ...)) -} - -.upM.is.tr <- function(object, upper = NA, ...) - .Call(unpackedMatrix_is_triangular, object, upper) - -.upM.is.di <- function(object) - .Call(unpackedMatrix_is_diagonal, object) - -.m.is.sy <- function(object, tol = 100 * .Machine$double.eps, - tol1 = 8 * tol, checkDN = TRUE, ...) { - ## backwards compatibility: don't check DN if check.attributes=FALSE - if(checkDN) { - ca <- function(check.attributes = TRUE, ...) check.attributes - checkDN <- ca(...) - } - if(is.logical(object) || is.integer(object) || tol <= 0) - ## requiring exact symmetry: - return(.Call(matrix_is_symmetric, object, checkDN)) - if(checkDN && !is.null(dn <- dimnames(object)) && !isSymmetricDN(dn)) - return(FALSE) - ## discarding possible user-supplied check.attributes: - iS.m <- function(check.attributes, ...) { - isSymmetric.matrix(..., check.attributes = FALSE) - } - iS.m(object = object, tol = tol, tol1 = tol1, ...) -} - -.m.is.tr <- function(object, upper = NA, ...) - .Call(matrix_is_triangular, object, upper) - -.m.is.di <- function(object) - .Call(matrix_is_diagonal, object) - -## method for .syMatrix in ./symmetricMatrix.R -## method for [lni]trMatrix in ./triangularMatrix.R -for (.cl in grep("^[lni]geMatrix$", .upM.subclasses, value = TRUE)) - setMethod("isSymmetric", signature(object = .cl), .upM.is.sy) -for (.cl in grep("^[dz](ge|tr)Matrix$", .upM.subclasses, value = TRUE)) - setMethod("isSymmetric", signature(object = .cl), .upM.is.sy.dz) - -## method for .syMatrix in ./symmetricMatrix.R -## method for .trMatrix in ./triangularMatrix.R -for (.cl in grep("^.geMatrix$", .upM.subclasses, value = TRUE)) - setMethod("isTriangular", signature(object = .cl), .upM.is.tr) - -setMethod("isDiagonal", signature(object = "unpackedMatrix"), .upM.is.di) - -if(FALSE) { -## Would override isSymmetric.matrix and be faster in the logical and integer -## cases and in the tol<=0 case, but use a looser notion of symmetric 'dimnames' -## and so probably break too much ... -setMethod("isSymmetric", signature(object = "matrix"), .m.is.sy) -} -setMethod("isTriangular", signature(object = "matrix"), .m.is.tr) -setMethod("isDiagonal", signature(object = "matrix"), .m.is.di) - -rm(.upM.is.sy, .upM.is.sy.dz, .upM.is.tr, .upM.is.di, - .m.is.sy, .m.is.tr, .m.is.di, .cl) - -setMethod("t", signature(x = "unpackedMatrix"), - function(x) - .Call(unpackedMatrix_transpose, x)) -setMethod("diag", signature(x = "unpackedMatrix"), - function(x, nrow, ncol, names = TRUE) - .Call(unpackedMatrix_diag_get, x, names)) -setMethod("diag<-", signature(x = "unpackedMatrix"), - function(x, value) - .Call(unpackedMatrix_diag_set, x, value)) - -setMethod("symmpart", signature(x = "unpackedMatrix"), - function(x) .Call(unpackedMatrix_symmpart, x)) -setMethod("symmpart", signature(x = "matrix"), - ## function(x) .Call(matrix_symmpart, x)) # returning .syMatrix - function(x) 0.5 * symmetrizeDimnames(x + t(x))) # returning matrix - -setMethod("skewpart", signature(x = "unpackedMatrix"), - function(x) .Call(unpackedMatrix_skewpart, x)) -setMethod("skewpart", signature(x = "matrix"), - ## function(x) .Call(matrix_skewpart, x)) # returning .geMatrix - function(x) 0.5 * symmetrizeDimnames(x - t(x))) # returning matrix - -setMethod("cov2cor", signature(V = "unpackedMatrix"), - function(V) as(forceSymmetric(V), "corMatrix")) - -rm(.upM.subclasses) diff -Nru rmatrix-1.6-1.1/R/which.R rmatrix-1.6-5/R/which.R --- rmatrix-1.6-1.1/R/which.R 2023-07-30 17:42:36.000000000 +0000 +++ rmatrix-1.6-5/R/which.R 2023-09-14 00:01:56.000000000 +0000 @@ -1,47 +1,60 @@ ## METHODS FOR GENERIC: which ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -setMethod("which", "ndenseMatrix", +setMethod("which", signature(x = "ndenseMatrix"), function(x, arr.ind = FALSE, useNames = TRUE) { - wh <- which(.M2gen(x, "l")@x) # NA <=> TRUE + wh <- which(.M2v(x)) if(arr.ind) arrayInd(wh, x@Dim, dimnames(x), useNames = useNames) else wh }) -setMethod("which", "ldenseMatrix", +setMethod("which", signature(x = "ldenseMatrix"), function(x, arr.ind = FALSE, useNames = TRUE) { - wh <- which(.M2gen(x, "l")@x) + wh <- which(.M2v(x)) if(arr.ind) arrayInd(wh, x@Dim, dimnames(x), useNames = useNames) else wh }) -setMethod("which", "nsparseMatrix", +setMethod("which", signature(x = "nsparseMatrix"), function(x, arr.ind = FALSE, useNames = TRUE) { - wh <- which(as(x, "sparseVector")) + wh <- .M2V(x)@i if(arr.ind) arrayInd(wh, x@Dim, dimnames(x), useNames = useNames) else wh }) -setMethod("which", "lsparseMatrix", +setMethod("which", signature(x = "lsparseMatrix"), function(x, arr.ind = FALSE, useNames = TRUE) { - wh <- which(as(x, "sparseVector")) + wh <- { x. <- .M2V(x); x.@i[which(x.@x)] } if(arr.ind) arrayInd(wh, x@Dim, dimnames(x), useNames = useNames) else wh }) -setMethod("which", "ldiMatrix", + +setMethod("which", signature(x = "ndiMatrix"), + function(x, arr.ind = FALSE, useNames = TRUE) { + wh <- .M2V(x)@i + if(arr.ind) + arrayInd(wh, x@Dim, x@Dimnames, useNames = useNames) + else wh + }) +setMethod("which", signature(x = "ldiMatrix"), function(x, arr.ind = FALSE, useNames = TRUE) { - d <- x@Dim - wh <- indDiag(d[1L]) - if(x@diag == "N") - wh <- wh[which(x@x)] + wh <- { x. <- .M2V(x); x.@i[which(x.@x)] } if(arr.ind) - arrayInd(wh, d, x@Dimnames, useNames = useNames) + arrayInd(wh, x@Dim, x@Dimnames, useNames = useNames) else wh }) -setMethod("which", "nsparseVector", +setMethod("which", signature(x = "nsparseVector"), function(x, arr.ind = FALSE, useNames = TRUE) x@i) -setMethod("which", "lsparseVector", +setMethod("which", signature(x = "lsparseVector"), function(x, arr.ind = FALSE, useNames = TRUE) x@i[which(x@x)]) + +setMethod("which", signature(x = "indMatrix"), + function(x, arr.ind = FALSE, useNames = TRUE) { + wh <- .M2V(x)@i + if(arr.ind) + arrayInd(wh, x@Dim, x@Dimnames, useNames = useNames) + else wh + }) diff -Nru rmatrix-1.6-1.1/R/zzz.R rmatrix-1.6-5/R/zzz.R --- rmatrix-1.6-1.1/R/zzz.R 2023-08-10 15:04:44.000000000 +0000 +++ rmatrix-1.6-5/R/zzz.R 2023-12-05 19:58:20.000000000 +0000 @@ -1,10 +1,33 @@ +## ~~~~ VERSION ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Matrix.Version <- function() { + n <- .Call(R_Matrix_version) + v <- .mapply(function(n, p, b, class) { + r <- integer(p) + while (p > 0L) { + r[p] <- tmp <- n %% b + n <- (n - tmp) %/% b + p <- p - 1L + } + v <- list(r) + class(v) <- c(class, "numeric_version") + v + }, + list(n = n, p = c(3L, 1L, 3L), b = c(256L, 10L, 256L), + class = list("package_version", NULL, NULL)), + NULL) + names(v) <- names(n) + v +} + + ## ~~~~ PACKAGE ENVIRONMENTS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ## Recording default values of Matrix.* options .MatrixEnv <- new.env(parent = emptyenv(), hash = FALSE) ## Storing settings from 'cholmod_common' -.chm_common <- new.env(parent = emptyenv()) +.CholmodCommonEnv <- new.env(parent = emptyenv()) ## ~~~~ NAMESPACE HOOKS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -12,29 +35,43 @@ .onLoad <- function(libname, pkgname) { ## For backwards compatibility with earlier versions of R, ## at least until x.y.z if we have Depends: R (>= x.y.z) - if((Rv <- getRversion()) < "4.1.3" && - ## Namespace not locked yet, but being defensive here: - !environmentIsLocked(Mns <- parent.env(environment()))) { + Mns <- parent.env(environment()) + if(!environmentIsLocked(Mns)) { + ## Namespace not locked yet, but being defensive here + Rv <- getRversion() + if(Rv < "4.4.0") { + assign("%||%", envir = Mns, inherits = FALSE, + function(x, y) if(is.null(x)) y else x) + if(Rv < "4.1.3") { assign("...names", envir = Mns, inherits = FALSE, function() eval(quote(names(list(...))), sys.frame(-1L))) if(Rv < "4.0.0") { - assign("deparse1", envir = Mns, inherits = FALSE, - function(expr, collapse = " ", width.cutoff = 500L, ...) - paste(deparse(expr, width.cutoff, ...), - collapse = collapse)) - assign("sequence.default", envir = Mns, inherits = FALSE, - function(nvec, from = 1L, by = 1L, ...) - unlist(.mapply(seq.int, - list(from = as.integer(from), - by = as.integer(by), - length.out = as.integer(nvec)), - NULL), - recursive = FALSE, use.names = FALSE)) - assign("tryInvokeRestart", envir = Mns, inherits = FALSE, - function(r, ...) - tryCatch(invokeRestart(r, ...), - error = function(e) invisible(NULL))) - } + assign("deparse1", envir = Mns, inherits = FALSE, + function(expr, collapse = " ", width.cutoff = 500L, ...) + paste(deparse(expr, width.cutoff, ...), + collapse = collapse)) + assign("sequence.default", envir = Mns, inherits = FALSE, + function(nvec, from = 1L, by = 1L, ...) { + if(length(nvec) == 0L) + return(integer(0L)) + else if(length(from) == 0L || length(by) == 0L) + stop(gettextf("'%s' has length 0 but '%s' does not", + if(length(from) == 0L) "from" else "by", "nvec"), + domain = NA) + unlist(.mapply(seq.int, + list(from = as.integer(from), + by = as.integer(by), + length.out = as.integer(nvec)), + NULL), + recursive = FALSE, use.names = FALSE) + }) + assign("tryInvokeRestart", envir = Mns, inherits = FALSE, + function(r, ...) + tryCatch(invokeRestart(r, ...), + error = function(e) invisible(NULL))) + } # Rv < "4.0.0" + } # Rv < "4.1.3" + } # Rv < "4.4.0" } ## verbose: @@ -73,9 +110,9 @@ ## >=2 ... persistent error ## NA ... one-time warning wSD <- as.integer(Sys.getenv("R_MATRIX_WARN_SQRT_DEFAULT", NA)) - assign("warnSqrtDefault", wDC, envir = .MatrixEnv) + assign("warnSqrtDefault", wSD, envir = .MatrixEnv) - .Call(CHM_set_common_env, .chm_common) + .Call(R_cholmod_common_envini, .CholmodCommonEnv) NULL } @@ -90,7 +127,7 @@ ## ~~~~ DEPRECATED ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ..2dge <- function(from) { - .Deprecated(new = ".M2gen", package = "Matrix") + .Deprecated(new = ".M2gen(*, \"d\") or .m2dense(*, \"dge\")", package = "Matrix") if(isS4(from)) .M2gen(from, "d") else .m2dense(from, "dge") @@ -117,18 +154,14 @@ } .diag2sT <- function(from, uplo = "U", kind = ".", drop0 = TRUE) { .Deprecated(new = ".diag2sparse", package = "Matrix") - r <- .diag2sparse(from, "s", "T", uplo) - if(kind != ".") - r <- .M2kind(r, kind) + r <- .diag2sparse(from, kind, "s", "T", uplo) if(drop0) r <- .drop0(r) r } .diag2tT <- function(from, uplo = "U", kind = ".", drop0 = TRUE) { .Deprecated(new = ".diag2sparse", package = "Matrix") - to <- .diag2sparse(from, "t", "T", uplo) - if(kind != ".") - to <- .M2kind(to, kind) + to <- .diag2sparse(from, kind, "t", "T", uplo) if(drop0) to <- .drop0(to) to @@ -159,19 +192,22 @@ .m2ngC <- function(from) { .Deprecated(new = ".m2sparse", package = "Matrix") if(anyNA(from)) - stop("attempt to coerce matrix with NA to ngCMatrix") + stop(gettextf("attempt to coerce matrix with NA to %s", "ngCMatrix"), + domain = NA) .m2sparse(from, "ngC") } .m2ngCn <- function(from, na.is.not.0 = FALSE) { .Deprecated(new = ".m2sparse", package = "Matrix") if(!na.is.not.0 && anyNA(from)) - stop("attempt to coerce matrix with NA to ngCMatrix") + stop(gettextf("attempt to coerce matrix with NA to %s", "ngCMatrix"), + domain = NA) .m2sparse(from, "ngC") } .m2ngTn <- function(from, na.is.not.0 = FALSE) { .Deprecated(new = ".m2sparse", package = "Matrix") if(!na.is.not.0 && anyNA(from)) - stop("attempt to coerce matrix with NA to ngCMatrix") + stop(gettextf("attempt to coerce matrix with NA to %s", "ngTMatrix"), + domain = NA) .m2sparse(from, "ngT") } .n2dgT <- function(from) { @@ -264,6 +300,20 @@ .tCRT(from) } +uniqTsparse <- function(x, class.x = class(x)) { + if(FALSE) { + .Deprecated(new = "asUniqueT", package = "Matrix") + } + asUniqueT(x, isT = extends(class.x, "TsparseMatrix")) +} + +.SuiteSparse_version <- function() { + if(FALSE) { + .Deprecated(new = "Matrix.Version", package = "Matrix") + } + Matrix.Version()[["suitesparse"]] +} + ## Utility for Matrix.DeprecatedCoerce(); see below .as.via.virtual <- function(Class1, Class2, from = quote(from)) { if(!isClassDef(Class1)) @@ -560,11 +610,3 @@ .Defunct(new = "cbind", package = "Matrix") rBind <- function(..., deparse.level = 1) .Defunct(msg = "rbind", package = "Matrix") - - -## ~~~~ "MISCELLANEOUS" ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.SuiteSparse_version <- function() { - v <- .Call(get_SuiteSparse_version) - package_version(list(major = v[1L], minor = paste(v[2:3], collapse = "."))) -} diff -Nru rmatrix-1.6-1.1/TODO rmatrix-1.6-5/TODO --- rmatrix-1.6-1.1/TODO 2023-06-24 19:59:54.000000000 +0000 +++ rmatrix-1.6-5/TODO 1970-01-01 00:00:00.000000000 +0000 @@ -1,449 +0,0 @@ -## -*- mode: org -*- - -* Class definitions: -** TODO validObject() should enforce symmetric Dimnames -** TODO ddiMatrix should inherit from dsparseMatrix, etc. - MJ: methods for dsparseMatrix, etc. must be adjusted to account - for diagonal cases -** TODO There should be an ndiMatrix (with NA <=> TRUE) ... - MJ: would make sense for is.na() and is.infinite() - and similar, where the result is diagonal and never NA -** TODO Aspirationally: iMatrix and zMatrix - MJ: most of our C code is "ready" but most of our R code is not - MJ: furthermore, we'd have to support complex _factorizations_ - MJ: my C code for is isSymmetric() and - forceSymmetric() does not test for - or force a real diagonal, would need adjustment -** TODO The class definition of nCHMsimpl is dubious - MJ: a simplicial symbolic factorization is specified entirely - by slots 'colcount' and 'perm' (and 'Dim' and 'Dimnames'); - 'p', 'i', 'prv', and 'nxt' are unused !! -** TODO indMatrix with length-0 perm <==> unit diagonal - MJ: then pMatrix with length-0 perm <==> identity matrix, efficiently - MJ: would be analogous to diagonalMatrix with diag="U" - MJ: would need to think about { m > n, margin = 1 } - and { m < n, margin = 2 } cases ... invalid ? -** TODO Length-0 'perm', 'p', and 'q' slots should be valid "everywhere" - MJ: our classes should represent "general" factorizations and - not assume pivoting even if our methods do always pivot - MJ: more general classes are more likely to be useful to others -** TODO denseQR? - MJ: the slots would match names(qr.default(.)) {plus Dim, Dimnames} - and could be formally validated - MJ: our methods could provide optional arguments that 'base' - does not provide and could return proper Matrix classes - MJ: we could define useful methods like expand[12] naturally, - i.e., without setOldClass("qr") - MJ: we could define a simple coercion to S3 "qr" if necessary -** TODO Schur is too general: Q, T should be dgeMatrix, not Matrix - MJ: it is difficult to write useful methods in C when the classes - can really be "anything" ... - MJ: tangentially: Schur() should give S4, not list -** TODO validObject() should forbid i > 2^.Machine$double.digits - MJ: most users will not know that, e.g., 0x1p+53 + 1 = 0x1p+53 - is TRUE where .Machine$double.digits = 53 - MJ: of course, 64-bit integers would be nice ... -** TODO compMatrix: do we really need it? - MJ: caching of factorizations seems to be an easy source of headache - and bugs; it is not idiomatic - MJ: we should encourage users to compute factorizations, assign them - to variables, and operate on them directly; we should *not* - encourage users to rely on invisible side effects, as we do now - MJ: we now have solve, determinant, etc., methods for subclasses - of MatrixFactorization - MJ: rcond(A) may need A and its factorization ... but in that case - we could have usage like rcond(A, norm, trf = BunchKaufman(A)) - allowing the user to supply 'trf' or rely on lazy evaluation - -* 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() -* *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 -** DONE 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 Look at Paul Bailey's problem -- CHOLMOD error (even seg.fault for him) - --> ~/R/MM/Pkg-ex/Matrix/sparseOrderedLogit.R -** DONE Schur() should also get a "matrix" method, - so people like RP may stop whining about its non-availability in "base R" (2015-07-09) -** DONE 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. - -** DONE 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 polish 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" -** DONE "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. -*** DONE "almost surely" -- is this *tested ?* -** 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 R/Ops.R: "Logic" & "Compare" should *keep* "nsparseMatrix" (not go to "lsparse*") -*** unfinished: "nTsparseMatrix" .. eg. "ngT" o "ngT" could work via (i,j) only -** DONE "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} ? - MJ: we've gone in a (better) different direction since 1.5-0 ish - -** DONE Think of constructing setAs(...) calls automatically in order to - basically enable all ``sensible'' as(fromMatrix, toMatrix) calls, - possibly using canCoerce(.) - MJ: we've gone in a (better) different direction since 1.5-0 ish - -** DONE 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" ! - -** DONE 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. - -** DONE ! 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''. - -** DONE 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 --------------------------------------------------- -** DONE chol() should ``work'': proper result or "good" error message. - (mostly done ?) - -** 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 - -** DONE 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) - -** DONE 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(, ) - -** DONE 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 - MJ: done more generally via R_sparse_diag_get() - -** chol() gives "temporarily disabled" - but should give the *symbolic* factorization; - similarly Cholesky(.) is not enabled - MJ: One can get a symbolic factorization also from dsCMatrix ... - better to just have Cholesky gain an argument ... - -* "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" -------------------------------------- -** DONE 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" - MJ: well, we very clearly document the behaviour -*** DONE 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 tests/dpo-test.R - tests/factorizing.R - tests/indexing.R - tests/matprod.R - tests/validObj.R : have RNGversion("3.5.0") - ... rerun with RNGversion("4.2.0") { == ("3.6.0") } and fix tolerances! etc -** DONE 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 .. - -** DONE 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. - MJ: we've gone in a (better) different direction since 1.5-0 ish -** 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. - -** DONE (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) - -** DONE {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 !] - Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/build/Matrix.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/build/Matrix.pdf differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/build/partial.rdb and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/build/partial.rdb differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/build/stage23.rdb and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/build/stage23.rdb differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/build/vignette.rds and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/build/vignette.rds differ diff -Nru rmatrix-1.6-1.1/cleanup rmatrix-1.6-5/cleanup --- rmatrix-1.6-1.1/cleanup 2023-09-08 10:37:27.000000000 +0000 +++ rmatrix-1.6-5/cleanup 2024-01-11 08:36:29.000000000 +0000 @@ -1,22 +1,9 @@ #!/bin/sh -# Cleans up after the auxiliary files that were created when installing -# the Matrix package (shamelessly taken from the XML source pkg) -# -echo " Cleaning up after installing the Matrix package" +## INSTALL does not clean up after ./configure or in subdirectories of src/; +## we do not have a ./configure, hence we only need the following: -## No configure currently --> empty for now: not yet really needed -for f in config.log config.status config.cache ; do - if test -w $f ; then - rm -f $f - fi +sslib="SuiteSparse_config AMD COLAMD CHOLMOD" +for d in ${sslib}; do + (cd src/${d} && make clean) done - -for D in `sed -n '/^SUBDIRS *= */s///p' src/Makevars` -do - if test -d src/$D - then (cd src/$D ; make clean ) - fi -done - - diff -Nru rmatrix-1.6-1.1/debian/changelog rmatrix-1.6-5/debian/changelog --- rmatrix-1.6-1.1/debian/changelog 2023-10-05 01:01:05.000000000 +0000 +++ rmatrix-1.6-5/debian/changelog 2024-03-19 02:54:34.000000000 +0000 @@ -1,8 +1,36 @@ -rmatrix (1.6-1.1-1.2204.0) jammy; urgency=medium +rmatrix (1.6-5-1.2204.0) jammy; urgency=medium - * Compilation for Ubuntu 22.04.3 LTS + * Compilation for Ubuntu 22.04.4 LTS + * debian/control, debian/rules, debian/compat: revert to a version of + debheler < 10 - -- Michael Rutter Thu, 05 Oct 2023 01:01:05 +0000 + -- Michael Rutter Tue, 19 Mar 2024 02:54:34 +0000 + +rmatrix (1.6-5-1) unstable; urgency=medium + + * New upstream release + + -- Dirk Eddelbuettel Thu, 11 Jan 2024 21:33:49 -0600 + +rmatrix (1.6-4-1) unstable; urgency=medium + + * New upstream release + + -- Dirk Eddelbuettel Fri, 01 Dec 2023 06:43:33 -0600 + +rmatrix (1.6-3-1) unstable; urgency=medium + + * New upstream release + + -- Dirk Eddelbuettel Tue, 14 Nov 2023 07:32:54 -0600 + +rmatrix (1.6-2-1) unstable; urgency=medium + + * New upstream release + + * debian/control: Set (Build-)Depends: to current R version + + -- Dirk Eddelbuettel Tue, 07 Nov 2023 19:49:31 -0600 rmatrix (1.6-1.1-1) unstable; urgency=medium diff -Nru rmatrix-1.6-1.1/debian/control rmatrix-1.6-5/debian/control --- rmatrix-1.6-1.1/debian/control 2023-10-05 01:01:05.000000000 +0000 +++ rmatrix-1.6-5/debian/control 2024-03-19 02:54:34.000000000 +0000 @@ -2,7 +2,7 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper, dh-r, r-base-dev (>= 4.3.1), r-cran-lattice (>= 0.12-11.1) +Build-Depends: debhelper, dh-r, r-base-dev (>= 4.3.2), r-cran-lattice (>= 0.12-11.1) Standards-Version: 4.6.2 Vcs-Browser: https://salsa.debian.org/edd/r-cran-matrix Vcs-Git: https://salsa.debian.org/edd/r-cran-matrix.git diff -Nru rmatrix-1.6-1.1/inst/NEWS.Rd rmatrix-1.6-5/inst/NEWS.Rd --- rmatrix-1.6-1.1/inst/NEWS.Rd 2023-09-08 10:30:03.000000000 +0000 +++ rmatrix-1.6-5/inst/NEWS.Rd 2024-01-06 06:59:15.000000000 +0000 @@ -4,6 +4,293 @@ \title{News for \R{} Package \pkg{Matrix}} \encoding{UTF-8} %% NB: The date (yyyy-mm-dd) is the "Packaged: " date in ../DESCRIPTION +\section{Changes in version 1.6-5 (2024-01-06 r4560)}{ + \subsection{Bug Fixes}{ + \itemize{ + \item \code{x[]} works for \code{x} inheriting from virtual class + \code{sparseVector}. + + \item \code{length(x)} is always an integer for \code{x} + inheriting from virtual class \code{sparseVector}. Truncation + did not occur for \code{x@length} of type \code{"double"} + equal to or greater than \code{.Machine[["integer.max"]] + 1}. + + \item \code{tril(, -n)} now works again. + + \item \code{tri[ul](, k)} now works correctly for + \code{k != 0}. + + \item \proglang{C} API function \code{cholmod_triplet_as_sexp} + transposes entries \dQuote{opposite} the \code{stype} when that + is nonzero, following CHOLMOD. + + \item \code{R_init_Matrix} did not register \code{cholmod_defaults}, + so calls to the corresponding stub did not work. + } + } + \subsection{Misc}{ + \itemize{ + \item \code{\%||\%} is defined in the \pkg{Matrix} namespace + only for \R{} versions less than 4.4.0. + } + } +} + +\section{Changes in version 1.6-4 (2023-11-29 r4523)}{ + \subsection{Bug Fixes}{ + \itemize{ + \item \code{printf} format mismatches detected by R-devel + are fixed in 3 \file{src/*.c}. + \item better deprecation message for \code{..2dge()}. + } + } + \subsection{Misc}{ + \itemize{ + \item Entry point \code{M_chm_triplet_to_SEXP}, removed + in \pkg{Matrix} version 1.6-2, is restored (as a macro). + It was \dQuote{covertly} used by package \pkg{Rmosek}. + } + } +} + +\section{Changes in version 1.6-3 (2023-11-13 r4513)}{ + \subsection{Misc}{ + \itemize{ + \item With an \R built with \command{configure} option + \option{--disable-long-double}, \code{prod(M)} now very slightly + differs for two differently classed versions of \code{M}. + + \item \code{checkMatrix()} from \file{test-tools-Matrix.R} gets + optional \code{MSG} argument for suppressing \code{prod()} differences. + } + } +} + +\section{Changes in version 1.6-2 (2023-11-05 r4503)}{ + \subsection{Significant User-Visible Changes}{ + \itemize{ + \item Methods for generic functions \code{rbind2}, \code{cbind2}, + \code{\%*\%}, \code{\%&\%}, \code{crossprod}, and \code{tcrossprod} + determine the class of the result using more strict rules, + designed to avoid \dQuote{surprising} coercions where possible. + Notably, operations involving \code{RsparseMatrix} now return + an \code{RsparseMatrix} in more cases. \code{TsparseMatrix} and + \code{diagonalMatrix} may be handled as \code{CsparseMatrix} or as + \code{RsparseMatrix}, depending on context. + } + } + \subsection{New Features}{ + \itemize{ + \item New \R{} function \code{Matrix.Version}, taking no arguments + and returning \code{list(package, abi, suitesparse)}, a list + containing the numeric versions of the package, its ABI, and the + internal SuiteSparse library. ABI versioning is new: the version + is 1 in this release and will be incremented by 1 in each future + release that changes the ABI. Versions and their components are + defined in a header for use by packages with \code{LinkingTo: Matrix} + in \file{DESCRIPTION}. See \file{inst/include/Matrix/version.h}. + + %% TODO {for 1.6-3}: Ops using (x@x | is.na(x@x)) for ndiMatrix 'x' + \item New nonvirtual class \code{ndiMatrix}, extending virtual + classes \code{diagonalMatrix} and \code{nMatrix}, for nonzero + pattern diagonal matrices. It is used to represent the result + of \code{is.na}, \code{is.nan}, \code{is.infinite} applied to + \code{diagonalMatrix}, as well as diagonal boolean products. + Coercions \code{as(, "nMatrix")} now give + \code{ndiMatrix} instead of \code{ntCMatrix}. The latter can + for now still be obtained by coercing to \code{nsparseMatrix} + instead of \code{nMatrix}. + + \item New C-level validity methods for \code{sparseVector} and + \code{[nlidz]sparseVector}, now requiring \code{length} not + exceeding \code{2^53}, which on most platforms is the maximum + integer representable exactly as \code{double}. + + \item \code{mean(, trim=)} now works efficiently + for nonzero values of \code{trim}. + + \item \code{rep(, each=)} now works efficiently, + avoiding \code{rep(., times = rep(each, times = length(.)))}. + + \item \code{.m2dense} and \code{.m2sparse} gain an argument + \code{trans} indicating if vectors that are not matrices should + be coerced to 1-row matrices rather than 1-column matrices. + + \item \code{.m2dense} and \code{.m2sparse} can be called + with one argument. Their \code{class} arguments admit new + default values \code{".ge"} and \code{".gC"}. + + \item \code{.diag2dense} and \code{.diag2sparse} gain an + argument \code{kind} indicating the \dQuote{kind} of the + result. + + \item New exports \code{.M2V} and \code{.m2V}, for coercing + \code{Matrix} and \code{matrix} (and in fact \code{vector}) + to \code{sparseVector}. + + \item New exports \code{isUniqueT} and \code{asUniqueT}, with + optional argument \code{byrow} allowing for row-major ordering + of entries. \code{asUniqueT} supercedes \code{uniqTsparse}, + which is no longer documented. + + \item New export \code{aggregateT}, for aggregating + \code{TsparseMatrix} \emph{without} sorting. + + \item Methods for \code{all.equal} now report the packages + where S4 classes are defined. + + \item \code{sum(x)} and \code{prod(x)} no longer require a + coercion from \code{symmetricMatrix} to \code{generalMatrix}. + Results where coercions are now avoided may differ numerically + due to reordering of adds and multiplies, most commonly on + systems where \code{sizeof(long double) == sizeof(double)}. + } + } + \subsection{Bug Fixes}{ + \itemize{ + \item Methods for \code{cbind2} and \code{rbind2} did not in all + cases handle vectors as 1-column and 1-row matrices, respectively. + + \item Methods for \code{cbind2} and \code{rbind2} did not handle + 0-length vectors (including \code{NULL}) correctly where the result + would have 0 rows and columns, respectively. + + \item Methods for \code{cbind2} and \code{rbind2} did not handle + \code{NA} in the \code{x} slot of \code{ndenseMatrix} correctly + (i.e., as \code{TRUE}). + + \item \code{cbind2(, )} gave + \code{ngeMatrix} instead of \code{lgeMatrix}. + \code{cbind2(, )} gave + \code{dgCMatrix} instead of \code{lgCMatrix}. + Methods for \code{rbind2} had similar problems. + + \item \code{rcond(<0-by-0>)} now returns \code{Inf}; see \PR{18543}. + + \item \code{round()} and \code{signif()} + now return \code{ds[yp]Matrix} rather than \code{dp[op]Matrix} and + now discard \code{factors}. + + \item Methods for \code{length} now return \code{integer} rather + than \code{double} if the result does not exceed \code{INT_MAX}. + + \item \code{dsparseVector} with \code{x} slot of type + \code{integer} are now formally invalid, as always intended. + + \item Methods for subscripting \code{sparseVector} did not behave + compatibly with \pkg{base} when supplied with fractional, \code{NA}, + or out-of-bounds subscripts. + + \item \code{symmpart(x)}, \code{skewpart(x)}, + \code{band(x, k1, k2)}, \code{triu(x, k)}, and + \code{tril(x, k)} now always return a \code{.diMatrix} + for \code{x} inheriting from \code{diagonalMatrix}. + + \item \code{colSums(<(n|l|ind)Matrix>)} and + \code{rowSums(<(n|l|ind)Matrix>)} now always give a result + of type \code{"integer"}. Methods differed previously, + some giving \code{"double"} (as \pkg{base} does, suboptimally, + traditional matrices of type \code{"logical"}). + + \item Some methods for generic function \code{lu} did not transmit + \code{Dimnames} to the result. + + \item Some methods for group generic function \code{Summary} + ignored arguments matching \code{\dots}. Other methods did + not ignore the \dQuote{garbage} elements of the \code{x} slot + of dense, triangular matrices. + + \item \code{kronecker(, )} threw + an error for attempting to access the nonexistent \code{x} slot + of its first argument. + + \item Matrix products now behave exactly as \pkg{base} when + testing for conformable arguments. + + \item Numeric products (\code{\%*\%}) did not always return a + \code{dMatrix}. + + \item Methods for \code{all.equal} now \dQuote{see} attributes + of S4 objects that are not slots. This can be disabled + by setting argument \code{check.attributes} to \code{NA}, + which is otherwise equivalent to \code{TRUE}. + + \item \code{prod(x)} is computed more diligently for \code{x} + inheriting from \code{sparseMatrix}, \code{sparseVector}, or + \code{.t[rp]Matrix}, i.e., those \code{x} that can be understood + to have \dQuote{structural} zeros. Now, multiplication by zero + occurs at the position of the first structural zero in the matrix + or vector (when traversed by row in the case of \code{RsparseMatrix}). + An exception is \code{TsparseMatrix}, for which multiplication + by zero occurs before multiplication by any stored entry, + regardless of the position of the first structural zero in the + corresponding sorted matrix (to avoid the cost of sorting). + + \item \code{tri[ul](<.t[rp]Matrix>, k)} was often wrong for + nonzero \code{k}, setting too many bands to zero. + + \item C-level \code{tCsparse_diag} (formerly \code{diag_tC}) + now handles structural zeros and \code{NaN} on the main diagonal + correctly. Option \code{"diagBack"} now works correctly. + + \item The prototype of API function \code{M_cholmod_band_inplace} + was wrongly copied from \code{cholmod_band}, + instead of from \code{cholmod_band_inplace}. + + \item Many API function prototypes wrongly used \code{const} + qualifiers where the registered routines do not. + + \item \code{expm(x)} failed for \code{x} of class \code{dtpMatrix} + or \code{dspMatrix}, since \pkg{Matrix} version 1.6-1. + + \item \code{.m2dense(x, ".ge")} allocated unnecessarily + for \code{x} without attributes. + } + } + \subsection{Misc}{ + \itemize{ + \item C code now refers to the symbol \code{factors} as + \code{Matrix_factorsSym}, rather than \code{Matrix_factorSym}. + + \item Certain never or seldom used class unions are removed. + + \item The content of \file{src/Mutils.[ch]} has been migrated + to more transparently named files: \file{src/attrib.[ch]}, + \file{src/objects.[ch]}, etc. + Similarly, much of \file{src/factorizations.[ch]} have been + migrated to \file{src/solve.[ch]} and \file{src/determinant.[ch]}. + + \item All matrix product code has been migrated to + \file{products.[Rch]}. + + \item Files in \file{po/} and \file{inst/po/} have been updated + due to more frequent use of \code{gettextf} in \file{R/*.R}. + + \item C code is prepared to handle complex matrices and their + factorizations. Notably, new machinery in \file{src/cs-etc.[ch]} + will enable linking the CXSparse library instead of the CSparse + library, the latter supporting numeric types but not complex ones. + + \item Some API declarations and macros not used by \emph{any} + reverse \code{LinkingTo} are removed or remapped. + + \item API headers are now nested under \file{inst/include/Matrix/} + for better namespacing. Where possible, packages should start to + use \code{LinkingTo: Matrix (>= 1.6-2)} and include files from the + new subdirectory, e.g., with \code{#include }. + + \item Users including API headers can define macro + \code{R_MATRIX_INLINE}, + typically with \code{#define R_MATRIX_INLINE inline}, + to allow the compiler to inline stubs for registered routines. + + \item \pkg{Matrix} did not pass its checks under \R{} 3.5.0, + implicitly violating \code{Depends: R (>= 3.5.0)}. This release + restores compatibility. + } + } +} + \section{Changes in version 1.6-1.1 (2023-09-08)}{ \subsection{Misc}{ \itemize{ @@ -85,7 +372,7 @@ (not counting deprecated ones), partly as a result of efforts to do more fine-grained dispatch in C code. - \item Files in \file{po/} and \code{inst/po/} have been updated + \item Files in \file{po/} and \file{inst/po/} have been updated (again), as many more C level messages now use format strings as a result of \code{vsnprintf} usage in \file{src/validity.c}. } @@ -1010,7 +1297,7 @@ \item \code{!} and \code{which()} now correctly handle \code{NA} as \code{TRUE}. - \item{anyNA()} had incorrectly returned + \item \code{anyNA()} had incorrectly returned \code{anyNA(.@x)} in many cases, giving false positives for some \code{.(tr|sy)Matrix} and \code{ndenseMatrix}. Now methods respect the \dQuote{rules} of these classes. @@ -1635,8 +1922,8 @@ \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`. + \item give information about #\{rows\} and #\{columns\} that are + suppressed in print()ing if the matrix is larger than \code{max.print}. } } \subsection{Bug Fixes}{ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/doc/Comparisons.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/doc/Comparisons.pdf differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/doc/Design-issues.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/doc/Design-issues.pdf differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/doc/Intro2Matrix.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/doc/Intro2Matrix.pdf differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/doc/Introduction.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/doc/Introduction.pdf differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/doc/sparseModels.pdf and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/doc/sparseModels.pdf differ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/Matrix.h rmatrix-1.6-5/inst/include/Matrix/Matrix.h --- rmatrix-1.6-1.1/inst/include/Matrix/Matrix.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/Matrix.h 2023-10-24 05:17:13.000000000 +0000 @@ -0,0 +1,19 @@ +#ifndef R_MATRIX_MATRIX_H +#define R_MATRIX_MATRIX_H + +#include "version.h" +#include "cholmod.h" + +#ifndef R_MATRIX_NO_CHOLMOD_UTILS +# include "cholmod-utils.h" +#endif + +#ifndef R_MATRIX_NO_ALLOCA +# include "alloca.h" +#endif + +#ifndef R_MATRIX_NO_REMAP +# include "remap.h" +#endif + +#endif /* R_MATRIX_MATRIX_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/alloca.h rmatrix-1.6-5/inst/include/Matrix/alloca.h --- rmatrix-1.6-1.1/inst/include/Matrix/alloca.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/alloca.h 2023-10-09 01:11:49.000000000 +0000 @@ -0,0 +1,41 @@ +#ifndef R_MATRIX_ALLOCA_H +#define R_MATRIX_ALLOCA_H + +/* MJ: alloca-using macros (currently opt-out, eventually opt-in) */ + +/* Copy and paste from Defn.h : */ +/* 'alloca' is neither C99 nor POSIX */ +#ifdef __GNUC__ +/* This covers GNU, Clang and Intel compilers */ +/* #undef needed in case some other header, e.g. malloc.h, already did this */ +# undef alloca +# define alloca(x) __builtin_alloca((x)) +#else +# ifdef HAVE_ALLOCA_H +/* This covers native compilers on Solaris and AIX */ +# include +# endif +/* It might have been defined via some other standard header, e.g. stdlib.h */ +# if !HAVE_DECL_ALLOCA +extern void *alloca(size_t); +# endif +#endif + +#define AS_CHM_FR(x) \ + M_sexp_as_cholmod_factor((CHM_FR) alloca(sizeof(cholmod_factor)), x) + +#define AS_CHM_SP(x) \ + M_sexp_as_cholmod_sparse((CHM_SP) alloca(sizeof(cholmod_sparse)), x, \ + (Rboolean) 1, (Rboolean) 0) + +#define AS_CHM_SP__(x) \ + M_sexp_as_cholmod_sparse((CHM_SP) alloca(sizeof(cholmod_sparse)), x, \ + (Rboolean) 0, (Rboolean) 0) + +#define AS_CHM_DN(x) \ + M_sexp_as_cholmod_dense ((CHM_DN) alloca(sizeof(cholmod_dense )), x) + +#define N_AS_CHM_DN(x, m, n) \ + M_numeric_as_cholmod_dense((CHM_DN) alloca(sizeof(cholmod_dense)), x, m, n) + +#endif /* R_MATRIX_ALLOCA_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/cholmod-utils.h rmatrix-1.6-5/inst/include/Matrix/cholmod-utils.h --- rmatrix-1.6-1.1/inst/include/Matrix/cholmod-utils.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/cholmod-utils.h 2023-11-27 20:27:27.000000000 +0000 @@ -0,0 +1,44 @@ +#ifndef R_MATRIX_CHOLMOD_UTILS_H +#define R_MATRIX_CHOLMOD_UTILS_H + +#include +#include "cholmod.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef R_MATRIX_INLINE +# define R_MATRIX_INLINE +#endif + +R_MATRIX_INLINE CHM_FR M_sexp_as_cholmod_factor( + CHM_FR, SEXP); +R_MATRIX_INLINE CHM_SP M_sexp_as_cholmod_sparse( + CHM_SP, SEXP, Rboolean, Rboolean); +R_MATRIX_INLINE CHM_TR M_sexp_as_cholmod_triplet( + CHM_TR, SEXP, Rboolean); +R_MATRIX_INLINE CHM_DN M_sexp_as_cholmod_dense( + CHM_DN, SEXP); +R_MATRIX_INLINE CHM_DN M_numeric_as_cholmod_dense( + CHM_DN, double *, int, int); + +R_MATRIX_INLINE SEXP M_cholmod_factor_as_sexp( + CHM_FR, int); +R_MATRIX_INLINE SEXP M_cholmod_sparse_as_sexp( + CHM_SP, int, int, int, const char *, SEXP); +R_MATRIX_INLINE SEXP M_cholmod_triplet_as_sexp( + CHM_TR, int, int, int, const char *, SEXP); +R_MATRIX_INLINE SEXP M_cholmod_dense_as_sexp( + CHM_DN, int); + +R_MATRIX_INLINE double M_cholmod_factor_ldetA( + CHM_FR); +R_MATRIX_INLINE CHM_FR M_cholmod_factor_update( + CHM_FR, CHM_SP, double); + +#ifdef __cplusplus +} +#endif + +#endif /* R_MATRIX_CHOLMOD_UTILS_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/cholmod.h rmatrix-1.6-5/inst/include/Matrix/cholmod.h --- rmatrix-1.6-1.1/inst/include/Matrix/cholmod.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/cholmod.h 2023-10-09 01:11:49.000000000 +0000 @@ -0,0 +1,1152 @@ +#ifndef R_MATRIX_CHOLMOD_H +#define R_MATRIX_CHOLMOD_H + +#include /* size_t */ +#include /* LONG_MAX */ +#include /* PRI */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* <<<< from ../../src/SuiteSparse_config/SuiteSparse_config.h <<<<<< */ +#ifndef SuiteSparse_long + +# if !defined(_WIN64) || defined(_UCRT) + +# define SuiteSparse_long long +# define SuiteSparse_long_max LONG_MAX +# define SuiteSparse_long_idd "ld" + +# else // defined(_WIN64) && !defined(_UCRT) + +# define SuiteSparse_long __int64 +# define SuiteSparse_long_max _I64_MAX +# define SuiteSparse_long_idd PRId64 + +# endif + +/* #define SuiteSparse_long int64_t */ +/* // typically long (but on WIN64) */ +/* #define SuiteSparse_long_max 9223372036854775801 */ +/* // typically LONG_MAX (but ..) */ +/* #define SuiteSparse_long_idd PRId64 */ +/* // typically "ld" */ + +# define SuiteSparse_long_id "%" SuiteSparse_long_idd +#endif + +/* <<<< from ../../src/CHOLMOD/Include/cholmod_core.h:244 <<<<<<<<<<< */ +#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) + +/* <<<< from ../../src/CHOLMOD/Include/cholmod_cholesky.h: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 */ + +/* from ../../src/CHOLMOD/Include/cholmod_matrixops.h:104 <<<<<<<<<<< */ +#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) */ + + +/* ========================================================================== */ +/* === 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 ; + + +/* <<<< Matrix <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */ + +typedef cholmod_common * CHM_CM; +typedef cholmod_factor * CHM_FR; +typedef cholmod_sparse * CHM_SP; +typedef cholmod_triplet * CHM_TR; +typedef cholmod_dense * CHM_DN; + +#define R_MATRIX_CHOLMOD(_NAME_) M_cholmod_ ## _NAME_ + +#ifndef R_MATRIX_INLINE +# define R_MATRIX_INLINE +#endif + +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(aat)( + CHM_SP, int *, size_t, int, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(add)( + CHM_SP, CHM_SP, double[2], double[2], int, int, CHM_CM); +R_MATRIX_INLINE CHM_DN R_MATRIX_CHOLMOD(allocate_dense)( + size_t, size_t, size_t, int, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(allocate_sparse)( + size_t, size_t, size_t, int, int, int, int, CHM_CM); +R_MATRIX_INLINE CHM_TR R_MATRIX_CHOLMOD(allocate_triplet)( + size_t, size_t, size_t, int, int, CHM_CM); +R_MATRIX_INLINE CHM_FR R_MATRIX_CHOLMOD(analyze)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE CHM_FR R_MATRIX_CHOLMOD(analyze_p)( + CHM_SP, int *, int *, size_t, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(band_inplace)( + int, int, int, CHM_SP, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(change_factor)( + int, int, int, int, int, CHM_FR, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(copy)( + CHM_SP, int, int, CHM_CM); +R_MATRIX_INLINE CHM_DN R_MATRIX_CHOLMOD(copy_dense)( + CHM_DN, CHM_CM); +R_MATRIX_INLINE CHM_FR R_MATRIX_CHOLMOD(copy_factor)( + CHM_FR, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(copy_sparse)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(defaults)( + CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(dense_to_sparse)( + CHM_DN, int, CHM_CM); +R_MATRIX_INLINE void R_MATRIX_CHOLMOD(error_handler)( + int, const char *, int, const char *); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(factor_to_sparse )( + CHM_FR, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(factorize)( + CHM_SP, CHM_FR, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(factorize_p)( + CHM_SP, double[2], int *, size_t, CHM_FR, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(finish)( + CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(free_dense)( + CHM_DN *, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(free_factor)( + CHM_FR *, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(free_sparse)( + CHM_SP *, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(free_triplet)( + CHM_TR *, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(nnz)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(scale)( + CHM_DN, int, CHM_SP, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(sdmult)( + CHM_SP, int, double[2], double[2], CHM_DN, CHM_DN, CHM_CM); +R_MATRIX_INLINE CHM_DN R_MATRIX_CHOLMOD(solve)( + int, CHM_FR, CHM_DN, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(solve2)( + int, CHM_FR, CHM_DN, CHM_DN *, CHM_DN *, CHM_DN *, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(sort)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE CHM_DN R_MATRIX_CHOLMOD(sparse_to_dense)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE CHM_TR R_MATRIX_CHOLMOD(sparse_to_triplet)( + CHM_SP, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(speye)( + size_t, size_t, int, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(spsolve)( + int, CHM_FR, CHM_SP, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(ssmult)( + CHM_SP, CHM_SP, int, int, int, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(start)( + CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(submatrix)( + CHM_SP, int *, int, int *, int, int, int, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(transpose)( + CHM_SP, int, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(triplet_to_sparse)( + CHM_TR, int, CHM_CM); +R_MATRIX_INLINE int R_MATRIX_CHOLMOD(updown)( + int, CHM_SP, CHM_FR, CHM_CM); +R_MATRIX_INLINE CHM_SP R_MATRIX_CHOLMOD(vertcat)( + CHM_SP, CHM_SP, int, CHM_CM); + +/* <<<< Matrix <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */ + +#ifdef __cplusplus +} +#endif + +#endif /* R_MATRIX_CHOLMOD_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/remap.h rmatrix-1.6-5/inst/include/Matrix/remap.h --- rmatrix-1.6-1.1/inst/include/Matrix/remap.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/remap.h 2023-11-27 20:27:27.000000000 +0000 @@ -0,0 +1,16 @@ +#ifndef R_MATRIX_REMAP_H +#define R_MATRIX_REMAP_H + +/* MJ: backwards compatibility with Matrix < 1.6-2 */ + +#define M_as_cholmod_sparse M_sexp_as_cholmod_sparse +#define M_as_cholmod_dense M_sexp_as_cholmod_dense +#define M_chm_factor_to_SEXP M_cholmod_factor_as_sexp +#define M_chm_sparse_to_SEXP M_cholmod_sparse_as_sexp +#define M_chm_triplet_to_SEXP M_cholmod_triplet_as_sexp +#define M_chm_factor_ldetL2 M_cholmod_factor_ldetA +#define M_chm_factor_update M_cholmod_factor_update +#define M_R_cholmod_error M_cholmod_error_handler +#define M_R_cholmod_start M_cholmod_start + +#endif /* R_MATRIX_REMAP_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/stubs.c rmatrix-1.6-5/inst/include/Matrix/stubs.c --- rmatrix-1.6-1.1/inst/include/Matrix/stubs.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/stubs.c 2023-12-04 07:08:01.000000000 +0000 @@ -0,0 +1,603 @@ +#include +#include +#include +#include + +#ifndef R_MATRIX_INLINE +# define R_MATRIX_INLINE +#endif + +/* ==== cholmod.h =================================================== */ + +#include "cholmod.h" + +#ifdef __cplusplus +extern "C" { +#endif + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(aat)(CHM_SP A, int *fset, size_t fsize, int mode, + CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, int *, size_t, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, int *, size_t, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_aat"); + return fn(A, fset, fsize, mode, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(add)(CHM_SP A, CHM_SP B, double alpha[2], double beta[2], + int values, int sorted, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, CHM_SP, double[2], double[2], + int, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, CHM_SP, double[2], double[2], + int, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_add"); + return fn(A, B, alpha, beta, values, sorted, Common); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +R_MATRIX_CHOLMOD(allocate_dense)(size_t nrow, size_t ncol, size_t d, int xtype, + CHM_CM Common) +{ + static CHM_DN (*fn)(size_t, size_t, size_t, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_DN (*)(size_t, size_t, size_t, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_allocate_dense"); + return fn(nrow, ncol, d, xtype, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_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 (*fn)(size_t, size_t, size_t, int, int, int, int, + CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(size_t, size_t, size_t, int, int, int, int, + CHM_CM)) + R_GetCCallable("Matrix", "cholmod_allocate_sparse"); + return fn(nrow, ncol, nzmax, sorted, packed, stype, xtype, Common); +} + +R_MATRIX_INLINE CHM_TR attribute_hidden +R_MATRIX_CHOLMOD(allocate_triplet)(size_t nrow, size_t ncol, size_t nzmax, + int stype, int xtype, CHM_CM Common) +{ + static CHM_TR (*fn)(size_t, size_t, size_t, int, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_TR (*)(size_t, size_t, size_t, int, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_allocate_triplet"); + return fn(nrow, ncol, nzmax, stype, xtype, Common); +} + +R_MATRIX_INLINE CHM_FR attribute_hidden +R_MATRIX_CHOLMOD(analyze)(CHM_SP A, CHM_CM Common) +{ + static CHM_FR (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_SP,CHM_CM)) + R_GetCCallable("Matrix", "cholmod_analyze"); + return fn(A, Common); +} + +R_MATRIX_INLINE CHM_FR attribute_hidden +R_MATRIX_CHOLMOD(analyze_p)(CHM_SP A, int *Perm, int *fset, size_t fsize, + CHM_CM Common) +{ + static CHM_FR (*fn)(CHM_SP, int *, int *, size_t, CHM_CM) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_SP, int *, int *, size_t, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_analyze_p"); + return fn(A, Perm, fset, fsize, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(band_inplace)(int k1, int k2, int mode, CHM_SP A, + CHM_CM Common) +{ + static int (*fn)(int, int, int, CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(int, int, int, CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_band_inplace"); + return fn(k1, k2, mode, A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_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 (*fn)(int, int, int, int, int, CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(int, int, int, int, int, CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_change_factor"); + return fn(to_xtype, to_ll, to_super, to_packed, to_monotonic, L, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(copy)(CHM_SP A, int stype, int mode, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, int, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, int, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_copy"); + return fn(A, stype, mode, Common); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +R_MATRIX_CHOLMOD(copy_dense)(CHM_DN A, CHM_CM Common) +{ + static CHM_DN (*fn)(CHM_DN, CHM_CM) = NULL; + if (!fn) + fn = (CHM_DN (*)(CHM_DN, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_copy_dense"); + return fn(A, Common); +} + +R_MATRIX_INLINE CHM_FR attribute_hidden +R_MATRIX_CHOLMOD(copy_factor)(CHM_FR L, CHM_CM Common) +{ + static CHM_FR (*fn)(CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_copy_factor"); + return fn(L, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(copy_sparse)(CHM_SP A, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_copy_sparse"); + return fn(A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(defaults)(CHM_CM Common) +{ + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) + R_GetCCallable("Matrix", "cholmod_defaults"); + return fn(Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(dense_to_sparse)(CHM_DN X, int values, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_DN, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_DN, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_dense_to_sparse"); + return fn(X, values, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(factor_to_sparse)(CHM_FR L, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_factor_to_sparse"); + return fn(L, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(factorize)(CHM_SP A, CHM_FR L, CHM_CM Common) +{ + static int (*fn)(CHM_SP, CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_factorize"); + return fn(A, L, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(factorize_p)(CHM_SP A, double beta[2], int *fset, + size_t fsize, CHM_FR L, CHM_CM Common) +{ + static int (*fn)(CHM_SP, double[2], int *, size_t, CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, double[2], int *, size_t, CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_factorize_p"); + return fn(A, beta, fset, fsize, L, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(finish)(CHM_CM Common) +{ + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) + R_GetCCallable("Matrix", "cholmod_finish"); + return fn(Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(free_dense)(CHM_DN *A, CHM_CM Common) +{ + static int (*fn)(CHM_DN *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_DN *,CHM_CM)) + R_GetCCallable("Matrix", "cholmod_free_dense"); + return fn(A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(free_factor)(CHM_FR *L, CHM_CM Common) +{ + static int (*fn)(CHM_FR *,CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_FR *, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_free_factor"); + return fn(L, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(free_sparse)(CHM_SP *A, CHM_CM Common) +{ + static int (*fn)(CHM_SP *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP *, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_free_sparse"); + return fn(A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(free_triplet)(CHM_TR *T, CHM_CM Common) +{ + static int (*fn)(CHM_TR *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_TR *,CHM_CM)) + R_GetCCallable("Matrix", "cholmod_free_triplet"); + return fn(T, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(nnz)(CHM_SP A, CHM_CM Common) +{ + static int (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_nnz"); + return fn(A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(scale)(CHM_DN S, int scale, CHM_SP A, CHM_CM Common) +{ + static int (*fn)(CHM_DN, int, CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_DN, int, CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_scale"); + return fn(S, scale, A, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(sdmult)(CHM_SP A, int transpose, + double alpha[2], double beta[2], + CHM_DN X, CHM_DN Y, CHM_CM Common) +{ + static int (*fn)(CHM_SP, int, double[2], double[2], + CHM_DN, CHM_DN, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, int, double[2], double[2], + CHM_DN, CHM_DN, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_sdmult"); + return fn(A, transpose, alpha, beta, X, Y, Common); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +R_MATRIX_CHOLMOD(solve)(int sys, CHM_FR L, CHM_DN B, CHM_CM Common) +{ + static CHM_DN (*fn)(int, CHM_FR, CHM_DN, CHM_CM) = NULL; + if (!fn) + fn = (CHM_DN (*)(int, CHM_FR, CHM_DN, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_solve"); + return fn(sys, L, B, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(solve2)(int sys, CHM_FR L, CHM_DN B, + CHM_DN *X_Handle, CHM_DN *Y_Handle, CHM_DN *E_Handle, + CHM_CM Common) +{ + static int (*fn)(int, CHM_FR, CHM_DN, CHM_SP, + CHM_DN *, CHM_SP *, CHM_DN *, CHM_DN *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(int, CHM_FR, CHM_DN, CHM_SP, + CHM_DN *, CHM_SP *, CHM_DN *, CHM_DN *, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_solve2"); + return fn(sys, L, B, NULL, X_Handle, NULL, Y_Handle, E_Handle, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(sort)(CHM_SP A, CHM_CM Common) +{ + static int (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_sort"); + return fn(A, Common); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +R_MATRIX_CHOLMOD(sparse_to_dense)(CHM_SP A, CHM_CM Common) +{ + static CHM_DN (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_DN (*)(CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_sparse_to_dense"); + return fn(A, Common); +} + +R_MATRIX_INLINE CHM_TR attribute_hidden +R_MATRIX_CHOLMOD(sparse_to_triplet)(CHM_SP A, CHM_CM Common) +{ + static CHM_TR (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_TR (*)(CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_sparse_to_triplet"); + return fn(A, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(speye)(size_t nrow, size_t ncol, int xtype, CHM_CM Common) +{ + static CHM_SP (*fn)(size_t, size_t, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(size_t, size_t, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_speye"); + return fn(nrow, ncol, xtype, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(spsolve)(int sys, CHM_FR L, CHM_SP B, CHM_CM Common) +{ + static CHM_SP (*fn)(int, CHM_FR, CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(int,CHM_FR, CHM_SP, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_spsolve"); + return fn(sys, L, B, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(ssmult)(CHM_SP A, CHM_SP B, + int stype, int values, int sorted, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, CHM_SP, int, int, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, CHM_SP, int, int, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_ssmult"); + return fn(A, B, stype, values, sorted, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(submatrix)(CHM_SP A, int *rset, int rsize, int *cset, + int csize, int values, int sorted, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, int *, int, int *, + int, int, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, int *, int, int *, + int, int, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_submatrix"); + return fn(A, rset, rsize, cset, csize, values, sorted, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(transpose)(CHM_SP A, int values, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_transpose"); + return fn(A, values, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(triplet_to_sparse)(CHM_TR T, int nzmax, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_TR, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_TR, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_triplet_to_sparse"); + return fn(T, nzmax, Common); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(updown)(int update, CHM_SP C, CHM_FR L, CHM_CM Common) +{ + static int (*fn)(int, CHM_SP, CHM_FR, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(int, CHM_SP, CHM_FR, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_updown"); + return fn(update, C, L, Common); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +R_MATRIX_CHOLMOD(vertcat)(CHM_SP A, CHM_SP B, int values, CHM_CM Common) +{ + static CHM_SP (*fn)(CHM_SP, CHM_SP, int, CHM_CM) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, CHM_SP, int, CHM_CM)) + R_GetCCallable("Matrix", "cholmod_vertcat"); + return fn(A, B, values, Common); +} + + +/* ---- cholmod_start ----------------------------------------------- */ +/* NB: keep synchronized with analogues in ../../src/chm_common.c */ + +R_MATRIX_INLINE void attribute_hidden +R_MATRIX_CHOLMOD(error_handler)(int status, const char *file, int line, + const char *message) +{ + /* NB: Matrix itself uses cholmod_common_env(ini|set|get) to preserve + settings through error calls. Consider defining *your* own error + handler and restoring the instance of cholmod_common that *you* use. + */ + + if (status < 0) + Rf_error("CHOLMOD error '%s' at file '%s', line %d", + message, file, line); + else + Rf_warning("CHOLMOD warning '%s' at file '%s', line %d", + message, file, line); +} + +R_MATRIX_INLINE int attribute_hidden +R_MATRIX_CHOLMOD(start)(CHM_CM Common) +{ + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) + R_GetCCallable("Matrix", "cholmod_start"); + int ans = fn(Common); + Common->error_handler = R_MATRIX_CHOLMOD(error_handler); + return ans; +} + +#ifdef __cplusplus +} +#endif + + +/* ==== cholmod-utils.h ============================================= */ + +#ifndef R_MATRIX_NO_CHOLMOD_UTILS + +#include "cholmod-utils.h" + +#ifdef __cplusplus +extern "C" { +#endif + +R_MATRIX_INLINE CHM_FR attribute_hidden +M_sexp_as_cholmod_factor(CHM_FR L, SEXP from) +{ + static CHM_FR (*fn)(CHM_FR, SEXP) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_FR, SEXP)) + R_GetCCallable("Matrix", "sexp_as_cholmod_factor"); + return fn(L, from); +} + +R_MATRIX_INLINE CHM_SP attribute_hidden +M_sexp_as_cholmod_sparse(CHM_SP A, SEXP from, + Rboolean checkUnit, Rboolean sortInPlace) +{ + static CHM_SP (*fn)(CHM_SP, SEXP, Rboolean, Rboolean) = NULL; + if (!fn) + fn = (CHM_SP (*)(CHM_SP, SEXP, Rboolean, Rboolean)) + R_GetCCallable("Matrix", "sexp_as_cholmod_sparse"); + return fn(A, from, checkUnit, sortInPlace); +} + +R_MATRIX_INLINE CHM_TR attribute_hidden +M_sexp_as_cholmod_triplet(CHM_TR A, SEXP from, + Rboolean checkUnit) +{ + static CHM_TR (*fn)(CHM_TR, SEXP, Rboolean) = NULL; + if (!fn) + fn = (CHM_TR (*)(CHM_TR, SEXP, Rboolean)) + R_GetCCallable("Matrix", "sexp_as_cholmod_triplet"); + return fn(A, from, checkUnit); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +M_sexp_as_cholmod_dense(CHM_DN A, SEXP from) +{ + static CHM_DN (*fn)(CHM_DN, SEXP) = NULL; + if (!fn) + fn = (CHM_DN (*)(CHM_DN, SEXP)) + R_GetCCallable("Matrix", "sexp_as_cholmod_dense"); + return fn(A, from); +} + +R_MATRIX_INLINE CHM_DN attribute_hidden +M_numeric_as_cholmod_dense(CHM_DN A, double *data, int nrow, int ncol) +{ + static CHM_DN (*fn)(CHM_DN, double *, int, int) = NULL; + if (!fn) + fn = (CHM_DN (*)(CHM_DN, double *, int, int)) + R_GetCCallable("Matrix", "numeric_as_cholmod_dense"); + return fn(A, data, nrow, ncol); +} + +R_MATRIX_INLINE SEXP attribute_hidden +M_cholmod_factor_as_sexp(CHM_FR L, int doFree) +{ + static SEXP (*fn)(CHM_FR, int) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_FR, int)) + R_GetCCallable("Matrix", "cholmod_factor_as_sexp"); + return fn(L, doFree); +} + +R_MATRIX_INLINE SEXP attribute_hidden +M_cholmod_sparse_as_sexp(CHM_SP A, int doFree, + int ttype, int doLogic, const char *diagString, + SEXP dimnames) +{ + static SEXP (*fn)(CHM_SP, int, int, int, const char *, SEXP) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_SP, int, int, int, const char *, SEXP)) + R_GetCCallable("Matrix", "cholmod_sparse_as_sexp"); + return fn(A, doFree, ttype, doLogic, diagString, dimnames); +} + +R_MATRIX_INLINE SEXP attribute_hidden +M_cholmod_triplet_as_sexp(CHM_TR A, int doFree, + int ttype, int doLogic, const char *diagString, + SEXP dimnames) +{ + static SEXP (*fn)(CHM_TR, int, int, int, const char *, SEXP) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_TR, int, int, int, const char *, SEXP)) + R_GetCCallable("Matrix", "cholmod_triplet_as_sexp"); + return fn(A, doFree, ttype, doLogic, diagString, dimnames); +} + +R_MATRIX_INLINE SEXP attribute_hidden +M_cholmod_dense_as_sexp(CHM_DN A, int doFree) +{ + static SEXP (*fn)(CHM_DN, int) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_DN, int)) + R_GetCCallable("Matrix", "cholmod_dense_as_sexp"); + return fn(A, doFree); +} + +R_MATRIX_INLINE double attribute_hidden +M_cholmod_factor_ldetA(CHM_FR L) +{ + static double (*fn)(CHM_FR) = NULL; + if (!fn) + fn = (double (*)(CHM_FR)) + R_GetCCallable("Matrix", "cholmod_factor_ldetA"); + return fn(L); +} + +R_MATRIX_INLINE CHM_FR attribute_hidden +M_cholmod_factor_update(CHM_FR L, CHM_SP A, double beta) +{ + static CHM_FR (*fn)(CHM_FR, CHM_SP, double) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_FR, CHM_SP, double)) + R_GetCCallable("Matrix", "cholmod_factor_update"); + return fn(L, A, beta); +} + +#ifdef __cplusplus +} +#endif + +#endif /* !defined(R_MATRIX_NO_CHOLMOD_UTILS) */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix/version.h rmatrix-1.6-5/inst/include/Matrix/version.h --- rmatrix-1.6-1.1/inst/include/Matrix/version.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/version.h 2023-11-30 18:40:54.000000000 +0000 @@ -0,0 +1,21 @@ +#ifndef R_MATRIX_VERSION_H +#define R_MATRIX_VERSION_H + +/* Users wanting to do version comparison will include Rversion.h then do, */ +/* e.g., R_MATRIX_PACKAGE_VERSION R_version(major, minor, patch) : */ + +/* (version)_{10} = (major minor patch)_{256} */ +#define R_MATRIX_PACKAGE_VERSION 67077 +#define R_MATRIX_PACKAGE_MAJOR 1 +#define R_MATRIX_PACKAGE_MINOR 6 +#define R_MATRIX_PACKAGE_PATCH 5 + +#define R_MATRIX_ABI_VERSION 1 + +/* (version)_{10} = (major minor patch)_{256} */ +#define R_MATRIX_SUITESPARSE_VERSION 330241 +#define R_MATRIX_SUITESPARSE_MAJOR 5 +#define R_MATRIX_SUITESPARSE_MINOR 10 +#define R_MATRIX_SUITESPARSE_PATCH 1 + +#endif /* R_MATRIX_VERSION_H */ diff -Nru rmatrix-1.6-1.1/inst/include/Matrix.h rmatrix-1.6-5/inst/include/Matrix.h --- rmatrix-1.6-1.1/inst/include/Matrix.h 2022-12-17 10:52:53.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix.h 2023-10-18 03:36:48.000000000 +0000 @@ -1,139 +1,4 @@ -#ifndef MATRIX_H -#define MATRIX_H - -#include -#include - -#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 "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 */ +/* For backwards compatibility only. Packages should start using */ +/* LinkingTo: Matrix (>= 1.6-2) and #include . */ +#include +#include "Matrix/Matrix.h" diff -Nru rmatrix-1.6-1.1/inst/include/Matrix_stubs.c rmatrix-1.6-5/inst/include/Matrix_stubs.c --- rmatrix-1.6-1.1/inst/include/Matrix_stubs.c 2021-06-10 10:03:34.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix_stubs.c 2023-10-11 13:48:40.000000000 +0000 @@ -1,724 +1,5 @@ -#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 - +/* For backwards compatibility only. Packages should start using */ +/* LinkingTo: Matrix (>= 1.6-2) and #include . */ +#include "Matrix/alloca.h" +#include "Matrix/remap.h" +#include "Matrix/stubs.c" diff -Nru rmatrix-1.6-1.1/inst/include/cholmod.h rmatrix-1.6-5/inst/include/cholmod.h --- rmatrix-1.6-1.1/inst/include/cholmod.h 2022-03-09 09:53:39.000000000 +0000 +++ rmatrix-1.6-5/inst/include/cholmod.h 2023-10-10 17:54:21.000000000 +0000 @@ -1,1134 +1,3 @@ -#ifndef MATRIX_CHOLMOD_H -#define MATRIX_CHOLMOD_H - -#include -#include - -#ifdef __cplusplus -extern "C" { -#endif - -// synced from >>>> ../../src/SuiteSparse_config/SuiteSparse_config.h : - -// Rather use C99 -- which we require in R anyway -#include - -#ifndef SuiteSparse_long - -#if !defined(_WIN64) || defined(_UCRT) - -#define SuiteSparse_long long -#define SuiteSparse_long_max LONG_MAX -#define SuiteSparse_long_idd "ld" - -#else // _WIN64 but not _UCRT - -#define SuiteSparse_long __int64 -#define SuiteSparse_long_max _I64_MAX -#define SuiteSparse_long_idd PRId64 - -#endif - -/* #define SuiteSparse_long int64_t */ -/* // typically long (but on WIN64) */ -/* #define SuiteSparse_long_max 9223372036854775801 */ -/* // typically LONG_MAX (but ..) */ -/* #define SuiteSparse_long_idd PRId64 */ - // typically "ld" - -#define SuiteSparse_long_id "%" SuiteSparse_long_idd -#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 */ +/* For backwards compatibility only. Packages should start using */ +/* LinkingTo: Matrix (>= 1.6-2) and #include . */ +#include "Matrix/cholmod.h" Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/de/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/de/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/de/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/de/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/en@quot/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/en@quot/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/en@quot/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/en@quot/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/fr/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/fr/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/fr/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/fr/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/it/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/it/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/it/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/it/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/ko/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/ko/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/ko/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/ko/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/lt/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/lt/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/lt/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/lt/LC_MESSAGES/R-Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/pl/LC_MESSAGES/Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/pl/LC_MESSAGES/Matrix.mo differ Binary files /tmp/tmpmy1mrj9r/aAzm6iVPpu/rmatrix-1.6-1.1/inst/po/pl/LC_MESSAGES/R-Matrix.mo and /tmp/tmpmy1mrj9r/58deWFokAq/rmatrix-1.6-5/inst/po/pl/LC_MESSAGES/R-Matrix.mo differ diff -Nru rmatrix-1.6-1.1/inst/test-tools-1.R rmatrix-1.6-5/inst/test-tools-1.R --- rmatrix-1.6-1.1/inst/test-tools-1.R 2023-08-09 10:02:34.000000000 +0000 +++ rmatrix-1.6-5/inst/test-tools-1.R 2023-12-09 22:30:22.000000000 +0000 @@ -247,12 +247,12 @@ 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) + 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) + 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() } diff -Nru rmatrix-1.6-1.1/inst/test-tools-Matrix.R rmatrix-1.6-5/inst/test-tools-Matrix.R --- rmatrix-1.6-1.1/inst/test-tools-Matrix.R 2023-06-03 13:51:32.000000000 +0000 +++ rmatrix-1.6-5/inst/test-tools-Matrix.R 2023-12-27 05:10:03.000000000 +0000 @@ -447,7 +447,10 @@ doSummary = TRUE, doCoerce = TRUE, doCoerce2 = doCoerce && !isRsp, doDet = do.matrix, do.prod = do.t && do.matrix && !isRsp, - verbose = TRUE, catFUN = cat) + verbose = TRUE, catFUN = cat, + MSG = if(interactive() || capabilities("long.double") || + isTRUE(get0("doExtras"))) message else function(...) {} + ) { ## is also called from dotestMat() in ../tests/Class+Meth.R @@ -519,8 +522,8 @@ ## crossprod() %*% etc if(do.prod) { - c.m <- crossprod(m) - tcm <- tcrossprod(m) + c.m <- crossprod(m, boolArith = FALSE) + tcm <- tcrossprod(m, boolArith = FALSE) tolQ <- if(isSparse) NA else eps16 stopifnot(dim(c.m) == rep.int(ncol(m), 2), dim(tcm) == rep.int(nrow(m), 2), @@ -550,12 +553,12 @@ 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)) { + r <- suppressWarnings(identical(f(m), f(m.m))) + if(!isTRUE(r)) { ## typically for prod() f.nam <- sub("..$", '', sub("^\\.Primitive..", '', format(f))) - ## prod() is delicate: NA or NaN can both happen - (if(f.nam == "prod") message else stop)( + ## sum() and prod() are sensitive to order of f. p. operations + ## particularly on systems where sizeof(long double) == sizeof(double) + (if(any(f.nam == c("sum", "prod"))) MSG else stop)( sprintf("%s(m) [= %g] differs from %s(m.m) [= %g]", f.nam, f(m), f.nam, f(m.m))) } @@ -633,7 +636,7 @@ stopifnot(Qidentical(as(m11, "generalMatrix"), as(m12, "generalMatrix"))) } - if(isSparse && !is.n) { + if(isSparse && !isDiag && !is.n) { ## ensure that as(., "nMatrix") gives nz-pattern CatF("as(., \"nMatrix\") giving full nonzero-pattern: ") n1 <- as(m, "nMatrix") @@ -642,7 +645,7 @@ ## only testing [CR]sparseMatrix and indMatrix here ... ## sum() excludes duplicated (i,j) pairs whereas ## length(diagU2N(<[^n].T>)) includes them ... - isDiag || isTsp || + isTsp || (if(isSym) length(if(.hasSlot(n1, "i")) n1@i else n1@j) else sum(n1)) == length(if(isInd) m@perm else diagU2N(m)@x)) Cat("ok\n") @@ -712,7 +715,7 @@ else if(extends(cld, "lMatrix")) { ## should fulfill even with NA: stopifnot(all(m | !m | ina), !any(!m & m & !ina)) if(isTsp) # allow modify, since at end here - m <- uniqTsparse(m, clNam) + m <- asUniqueT(m, isT = TRUE) stopifnot(identical(m, m & TRUE), identical(m, FALSE | m)) ## also check the coercions to [dln]Matrix @@ -817,3 +820,18 @@ invisible(list(qA=qA, qa=qa)) } +non0.ij <- function(M) Matrix:::non0.i(as(M, "sparseMatrix")) + +triuChk <- function(x, k) { + ans <- triu(x, k) + ij <- non0.ij(ans) + stopifnot(identical(dim(x), dim(ans)), (ij %*% c(-1,1)) >= k) + ans +} + +trilChk <- function(x, k) { + ans <- tril(x, k) + ij <- non0.ij(ans) + stopifnot(identical(dim(x), dim(ans)), (ij %*% c(-1,1)) <= k) + ans +} diff -Nru rmatrix-1.6-1.1/man/CHMfactor-class.Rd rmatrix-1.6-5/man/CHMfactor-class.Rd --- rmatrix-1.6-1.1/man/CHMfactor-class.Rd 2023-07-03 13:19:07.000000000 +0000 +++ rmatrix-1.6-5/man/CHMfactor-class.Rd 2023-11-01 21:39:04.000000000 +0000 @@ -28,9 +28,9 @@ \code{CHMfactor} is the virtual class of sparse Cholesky factorizations of \eqn{n \times n}{n-by-n} real, symmetric matrices \eqn{A}, having the general form - \deqn{P_1 A P_1' = L_1 D L_1' \overset{D_{jj} \ge 0}{=} L L'}{P1 * A * P1' = L1 * D * L1' [ = L * L' ]} + \Sdeqn{P_1 A P_1' = L_1 D L_1' \\\\\\\\overset{D_{jj} \\\\\\\\ge 0}{=} L L'}{P1 * A * P1' = L1 * D * L1' [ = L * L' ]} or (equivalently) - \deqn{A = P_1' L_1 D L_1' P_1 \overset{D_{jj} \ge 0}{=} P_1' L L' P_1}{A = P1' L1 * D * L1' * P1 [ = P1' * L * L' * P1 ]} + \Sdeqn{A = P_1' L_1 D L_1' P_1 \\\\\\\\overset{D_{jj} \\\\\\\\ge 0}{=} P_1' L L' P_1}{A = P1' L1 * D * L1' * P1 [ = P1' * L * L' * P1 ]} where \eqn{P_1}{P1} is a permutation matrix, \eqn{L_1}{L1} is a unit lower triangular matrix, diff -Nru rmatrix-1.6-1.1/man/Cholesky.Rd rmatrix-1.6-5/man/Cholesky.Rd --- rmatrix-1.6-1.1/man/Cholesky.Rd 2023-07-03 13:19:07.000000000 +0000 +++ rmatrix-1.6-5/man/Cholesky.Rd 2023-11-01 21:39:04.000000000 +0000 @@ -22,15 +22,13 @@ \alias{Cholesky,symmetricMatrix-method} \alias{Cholesky,triangularMatrix-method} % -\alias{.SuiteSparse_version} -% \description{ Computes the pivoted Cholesky factorization of an \eqn{n \times n}{n-by-n} real, symmetric matrix \eqn{A}, which has the general form - \deqn{P_1 A P_1' = L_1 D L_1' \overset{D_{jj} \ge 0}{=} L L'}{P1 * A * P1' = L1 * D * L1' [ = L * L' ]} + \Sdeqn{P_1 A P_1' = L_1 D L_1' \\\\\\\\overset{D_{jj} \\\\\\\\ge 0}{=} L L'}{P1 * A * P1' = L1 * D * L1' [ = L * L' ]} or (equivalently) - \deqn{A = P_1' L_1 D L_1' P_1 \overset{D_{jj} \ge 0}{=} P_1' L L' P_1}{A = P1' L1 * D * L1' * P1 [ = P1' * L * L' * P1 ]} + \Sdeqn{A = P_1' L_1 D L_1' P_1 \\\\\\\\overset{D_{jj} \\\\\\\\ge 0}{=} P_1' L L' P_1}{A = P1' L1 * D * L1' * P1 [ = P1' * L * L' * P1 ]} where \eqn{P_1}{P1} is a permutation matrix, \eqn{L_1}{L1} is a unit lower triangular matrix, @@ -39,7 +37,7 @@ The second equalities hold only for positive semidefinite \eqn{A}, for which the diagonal entries of \eqn{D} are non-negative and \eqn{\sqrt{D}}{sqrt(D)} is well-defined. - + Methods for \code{\linkS4class{denseMatrix}} are built on LAPACK routines \code{dpstrf}, \code{dpotrf}, and \code{dpptrf}. The latter two do not permute rows or columns, @@ -154,8 +152,7 @@ semidefinite even if \eqn{A} is not. It follows that one way to test for positive semidefiniteness of \eqn{A} in the event of a warning is to analyze the error - \deqn{\frac{\lVert A - P' L L' P \rVert}{\lVert A \rVert}\,.}{ - norm(A - P' * L * L' * P) / norm(A).} + \Sdeqn{\\\\\\\\frac{\\\\\\\\lVert A - P' L L' P \\\\\\\\rVert}{\\\\\\\\lVert A \\\\\\\\rVert}\\\\\\\\,.}{norm(A - P' * L * L' * P) / norm(A).} See the examples and LAPACK Working Note (\dQuote{LAWN}) 161 for details. } @@ -193,7 +190,7 @@ \emph{LAPACK-style codes for level 2 and 3 pivoted Cholesky factorizations}. LAPACK Working Note, Number 161. \url{https://www.netlib.org/lapack/lawnspdf/lawn161.pdf} - + Chen, Y., Davis, T. A., Hager, W. W., & Rajamanickam, S. (2008). Algorithm 887: CHOLMOD, supernodal sparse Cholesky factorization and update/downdate. @@ -305,9 +302,9 @@ inm <- c("pivoted", "unpivoted") jnm <- c("simpl1", "simpl0", "super0") for(i in 1:2) -for(j in 1:3) -print(image(m.ch.A4[[c(i, j)]], main = paste(inm[i], jnm[j])), - split = c(j, i, 3L, 2L), more = i * j < 6L) + for(j in 1:3) + print(image(m.ch.A4[[c(i, j)]], main = paste(inm[i], jnm[j])), + split = c(j, i, 3L, 2L), more = i * j < 6L) simpl1 <- ch.A4[[c("pivoted", "simpl1")]] stopifnot(exprs = { @@ -380,5 +377,6 @@ stopifnot(all.equal(A5, as(Reduce(`\%*\%`, e.ch.A5), "symmetricMatrix"))) ## Version of the SuiteSparse library, which includes CHOLMOD -.SuiteSparse_version() +Mv <- Matrix.Version() +Mv[["SuiteSparse"]] } diff -Nru rmatrix-1.6-1.1/man/CsparseMatrix-class.Rd rmatrix-1.6-5/man/CsparseMatrix-class.Rd --- rmatrix-1.6-1.1/man/CsparseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/CsparseMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -12,13 +12,10 @@ \alias{Arith,numeric,CsparseMatrix-method} \alias{Compare,CsparseMatrix,CsparseMatrix-method} \alias{Logic,CsparseMatrix,CsparseMatrix-method} -\alias{Math,CsparseMatrix-method} -\alias{coerce,CsparseMatrix,sparseVector-method} \alias{coerce,matrix,CsparseMatrix-method} \alias{coerce,vector,CsparseMatrix-method} \alias{diag,CsparseMatrix-method} \alias{diag<-,CsparseMatrix-method} -\alias{log,CsparseMatrix-method} \alias{t,CsparseMatrix-method} % \alias{.validateCsparse} diff -Nru rmatrix-1.6-1.1/man/LU-class.Rd rmatrix-1.6-5/man/LU-class.Rd --- rmatrix-1.6-1.1/man/LU-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/LU-class.Rd 2023-11-02 17:07:44.000000000 +0000 @@ -20,9 +20,9 @@ \deqn{A = P_{1}' L U}{A = P1' * L * U} where \eqn{P_{1}}{P1} is an \eqn{m \times m}{m-by-m} permutation matrix, - \eqn{L} is an \eqn{m \times \text{min}(m,n)}{m-by-min(m,n)} + \eqn{L} is an \eqn{m \times \min(m,n)}{m-by-min(m,n)} unit lower trapezoidal matrix, and - \eqn{U} is a \eqn{\text{min}(m,n) \times n}{min(m,n)-by-n} + \eqn{U} is a \eqn{\min(m,n) \times n}{min(m,n)-by-n} upper trapezoidal matrix. If \eqn{m = n}, then the factors \eqn{L} and \eqn{U} are triangular. } diff -Nru rmatrix-1.6-1.1/man/Matrix-class.Rd rmatrix-1.6-5/man/Matrix-class.Rd --- rmatrix-1.6-1.1/man/Matrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/Matrix-class.Rd 2023-10-18 20:44:10.000000000 +0000 @@ -10,8 +10,10 @@ \alias{!,Matrix-method} \alias{&,Matrix,ddiMatrix-method} \alias{&,Matrix,ldiMatrix-method} +\alias{&,Matrix,ndiMatrix-method} \alias{*,Matrix,ddiMatrix-method} \alias{*,Matrix,ldiMatrix-method} +\alias{*,Matrix,ndiMatrix-method} \alias{+,Matrix,missing-method} \alias{-,Matrix,missing-method} \alias{Arith,Matrix,Matrix-method} @@ -30,9 +32,9 @@ \alias{Ops,Matrix,sparseVector-method} \alias{Ops,NULL,Matrix-method} \alias{Ops,matrix,Matrix-method} -\alias{Summary,Matrix-method} \alias{^,Matrix,ddiMatrix-method} \alias{^,Matrix,ldiMatrix-method} +\alias{^,Matrix,ndiMatrix-method} \alias{as.array,Matrix-method} \alias{as.complex,Matrix-method} \alias{as.integer,Matrix-method} @@ -44,42 +46,35 @@ \alias{coerce,Matrix,CsparseMatrix-method} \alias{coerce,Matrix,RsparseMatrix-method} \alias{coerce,Matrix,TsparseMatrix-method} -\alias{coerce,Matrix,array-method} -\alias{coerce,Matrix,complex-method} \alias{coerce,Matrix,corMatrix-method} \alias{coerce,Matrix,dMatrix-method} \alias{coerce,Matrix,ddenseMatrix-method} \alias{coerce,Matrix,denseMatrix-method} \alias{coerce,Matrix,diagonalMatrix-method} -\alias{coerce,Matrix,double-method} \alias{coerce,Matrix,dpoMatrix-method} \alias{coerce,Matrix,dppMatrix-method} \alias{coerce,Matrix,dsparseMatrix-method} \alias{coerce,Matrix,generalMatrix-method} \alias{coerce,Matrix,indMatrix-method} -\alias{coerce,Matrix,integer-method} \alias{coerce,Matrix,lMatrix-method} \alias{coerce,Matrix,ldenseMatrix-method} -\alias{coerce,Matrix,logical-method} \alias{coerce,Matrix,lsparseMatrix-method} \alias{coerce,Matrix,matrix-method} \alias{coerce,Matrix,nMatrix-method} \alias{coerce,Matrix,ndenseMatrix-method} \alias{coerce,Matrix,nsparseMatrix-method} -\alias{coerce,Matrix,numeric-method} \alias{coerce,Matrix,pMatrix-method} \alias{coerce,Matrix,packedMatrix-method} \alias{coerce,Matrix,pcorMatrix-method} \alias{coerce,Matrix,sparseMatrix-method} +\alias{coerce,Matrix,sparseVector-method} \alias{coerce,Matrix,symmetricMatrix-method} \alias{coerce,Matrix,triangularMatrix-method} \alias{coerce,Matrix,unpackedMatrix-method} -\alias{coerce,Matrix,vector-method} \alias{coerce,matrix,Matrix-method} \alias{coerce,vector,Matrix-method} \alias{determinant,Matrix,missing-method} \alias{determinant,Matrix,logical-method} -\alias{diff,Matrix-method} \alias{dim,Matrix-method} \alias{dimnames,Matrix-method} \alias{dimnames<-,Matrix,NULL-method} @@ -90,8 +85,12 @@ \alias{length,Matrix-method} \alias{tail,Matrix-method} \alias{unname,Matrix-method} +\alias{zapsmall,Matrix-method} % -\alias{det} % for our copy of base::det +\alias{c.Matrix} +% +\alias{Matrix.Version} % FIXME: belongs in non-existent Matrix-package.Rd +\alias{det} % FIXME: ditto % \description{ The \code{Matrix} class is a class contained by all actual diff -Nru rmatrix-1.6-1.1/man/Matrix-deprecated.Rd rmatrix-1.6-5/man/Matrix-deprecated.Rd --- rmatrix-1.6-1.1/man/Matrix-deprecated.Rd 2023-06-19 16:52:43.000000000 +0000 +++ rmatrix-1.6-5/man/Matrix-deprecated.Rd 2023-10-18 20:44:10.000000000 +0000 @@ -8,6 +8,7 @@ % \alias{..2dge} \alias{.C2nC} +\alias{.SuiteSparse_version} \alias{.T2Cmat} \alias{.asmatrix} \alias{.dense2sy} diff -Nru rmatrix-1.6-1.1/man/RsparseMatrix-class.Rd rmatrix-1.6-5/man/RsparseMatrix-class.Rd --- rmatrix-1.6-1.1/man/RsparseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/RsparseMatrix-class.Rd 2023-08-16 19:50:52.000000000 +0000 @@ -7,7 +7,6 @@ % \alias{RsparseMatrix-class} % -\alias{coerce,RsparseMatrix,sparseVector-method} \alias{coerce,matrix,RsparseMatrix-method} \alias{coerce,vector,RsparseMatrix-method} \alias{diag,RsparseMatrix-method} diff -Nru rmatrix-1.6-1.1/man/TsparseMatrix-class.Rd rmatrix-1.6-5/man/TsparseMatrix-class.Rd --- rmatrix-1.6-1.1/man/TsparseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/TsparseMatrix-class.Rd 2023-08-16 19:50:52.000000000 +0000 @@ -7,7 +7,6 @@ % \alias{TsparseMatrix-class} % -\alias{coerce,TsparseMatrix,sparseVector-method} \alias{coerce,matrix,TsparseMatrix-method} \alias{coerce,vector,TsparseMatrix-method} \alias{diag,TsparseMatrix-method} diff -Nru rmatrix-1.6-1.1/man/Xtrct-methods.Rd rmatrix-1.6-5/man/Xtrct-methods.Rd --- rmatrix-1.6-1.1/man/Xtrct-methods.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/Xtrct-methods.Rd 2023-12-05 23:11:56.000000000 +0000 @@ -24,9 +24,11 @@ \alias{[,Matrix,missing,missing,missing-method} \alias{[,Matrix,nMatrix,missing,missing-method} \alias{[,abIndex,index,ANY,ANY-method} -\alias{[,sparseVector,index,ANY,ANY-method} -\alias{[,sparseVector,lsparseVector,ANY,ANY-method} -\alias{[,sparseVector,nsparseVector,ANY,ANY-method} +\alias{[,sparseVector,NULL,ANY,ANY-method} +\alias{[,sparseVector,index,missing,missing-method} +\alias{[,sparseVector,lsparseVector,missing,missing-method} +\alias{[,sparseVector,missing,missing,missing-method} +\alias{[,sparseVector,nsparseVector,missing,missing-method} % \description{ Methods for \code{"["}, i.e., extraction or subsetting mostly of diff -Nru rmatrix-1.6-1.1/man/all-methods.Rd rmatrix-1.6-5/man/all-methods.Rd --- rmatrix-1.6-1.1/man/all-methods.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/all-methods.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,62 +0,0 @@ -\name{all-methods} -\title{"Matrix" Methods for Functions all() and any()} -% -\docType{methods} -\keyword{logic} -\keyword{methods} -% -\alias{all} -\alias{all-methods} -\alias{any} -\alias{any-methods} -% -\alias{all,Matrix-method} -\alias{all,ddiMatrix-method} -\alias{all,ldiMatrix-method} -\alias{all,lsparseMatrix-method} -\alias{all,nsparseMatrix-method} -% -\alias{any,Matrix-method} -\alias{any,ddiMatrix-method} -\alias{any,lMatrix-method} -\alias{any,ldiMatrix-method} -\alias{any,nsparseMatrix-method} -% -\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)}: ...} - } -} -\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) - ) -} -} diff -Nru rmatrix-1.6-1.1/man/all.equal-methods.Rd rmatrix-1.6-5/man/all.equal-methods.Rd --- rmatrix-1.6-1.1/man/all.equal-methods.Rd 2023-05-08 16:16:30.000000000 +0000 +++ rmatrix-1.6-5/man/all.equal-methods.Rd 2023-08-16 05:39:47.000000000 +0000 @@ -10,20 +10,17 @@ \alias{all.equal} \alias{all.equal-methods} % -\alias{all.equal,ANY,Matrix-method} -\alias{all.equal,ANY,sparseMatrix-method} -\alias{all.equal,ANY,sparseVector-method} -\alias{all.equal,Matrix,ANY-method} \alias{all.equal,Matrix,Matrix-method} +\alias{all.equal,Matrix,sparseVector-method} +\alias{all.equal,Matrix,vector-method} \alias{all.equal,abIndex,abIndex-method} \alias{all.equal,abIndex,numLike-method} \alias{all.equal,numLike,abIndex-method} -\alias{all.equal,sparseMatrix,ANY-method} -\alias{all.equal,sparseMatrix,sparseMatrix-method} -\alias{all.equal,sparseMatrix,sparseVector-method} -\alias{all.equal,sparseVector,ANY-method} -\alias{all.equal,sparseVector,sparseMatrix-method} +\alias{all.equal,sparseVector,Matrix-method} \alias{all.equal,sparseVector,sparseVector-method} +\alias{all.equal,sparseVector,vector-method} +\alias{all.equal,vector,Matrix-method} +\alias{all.equal,vector,sparseVector-method} % \description{ Methods for function \code{\link{all.equal}()} (from \R package diff -Nru rmatrix-1.6-1.1/man/band.Rd rmatrix-1.6-5/man/band.Rd --- rmatrix-1.6-1.1/man/band.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/band.Rd 2024-01-02 19:37:41.000000000 +0000 @@ -47,11 +47,12 @@ \arguments{ \item{x}{a matrix-like object} \item{k,k1,k2}{integers specifying the diagonals that are not set to - zero. These are interpreted relative to the main diagonal, which - is \code{k=0}. Positive and negative values of \code{k} indicate + zero, \code{k1 <= k2}. These are interpreted relative to the main + diagonal, which is \code{k = 0}. + Positive and negative values of \code{k} indicate diagonals above and below the main diagonal, respectively.} - \item{\dots}{optional arguments passed methods (currently unused - by package \pkg{Matrix})} + \item{\dots}{optional arguments passed to methods, currently unused + by package \pkg{Matrix}.} } \details{ \code{triu(x, k)} is equivalent to \code{band(x, k, dim(x)[2])}. diff -Nru rmatrix-1.6-1.1/man/boolean-matprod.Rd rmatrix-1.6-5/man/boolean-matprod.Rd --- rmatrix-1.6-1.1/man/boolean-matprod.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/boolean-matprod.Rd 2023-09-11 06:28:46.000000000 +0000 @@ -14,63 +14,84 @@ \alias{\%&\%,ANY,ANY-method} \alias{\%&\%,ANY,Matrix-method} \alias{\%&\%,ANY,matrix-method} +\alias{\%&\%,ANY,sparseVector-method} +\alias{\%&\%,ANY,vector-method} +\alias{\%&\%,CsparseMatrix,CsparseMatrix-method} \alias{\%&\%,CsparseMatrix,RsparseMatrix-method} \alias{\%&\%,CsparseMatrix,TsparseMatrix-method} +\alias{\%&\%,CsparseMatrix,denseMatrix-method} \alias{\%&\%,CsparseMatrix,diagonalMatrix-method} -\alias{\%&\%,CsparseMatrix,mMatrix-method} +\alias{\%&\%,CsparseMatrix,matrix-method} +\alias{\%&\%,CsparseMatrix,vector-method} \alias{\%&\%,Matrix,ANY-method} -\alias{\%&\%,Matrix,Matrix-method} \alias{\%&\%,Matrix,indMatrix-method} \alias{\%&\%,Matrix,pMatrix-method} +\alias{\%&\%,Matrix,sparseVector-method} \alias{\%&\%,RsparseMatrix,CsparseMatrix-method} \alias{\%&\%,RsparseMatrix,RsparseMatrix-method} \alias{\%&\%,RsparseMatrix,TsparseMatrix-method} +\alias{\%&\%,RsparseMatrix,denseMatrix-method} \alias{\%&\%,RsparseMatrix,diagonalMatrix-method} -\alias{\%&\%,RsparseMatrix,mMatrix-method} +\alias{\%&\%,RsparseMatrix,matrix-method} +\alias{\%&\%,RsparseMatrix,vector-method} \alias{\%&\%,TsparseMatrix,CsparseMatrix-method} \alias{\%&\%,TsparseMatrix,RsparseMatrix-method} \alias{\%&\%,TsparseMatrix,TsparseMatrix-method} +\alias{\%&\%,TsparseMatrix,denseMatrix-method} \alias{\%&\%,TsparseMatrix,diagonalMatrix-method} -\alias{\%&\%,TsparseMatrix,mMatrix-method} +\alias{\%&\%,TsparseMatrix,matrix-method} +\alias{\%&\%,TsparseMatrix,vector-method} +\alias{\%&\%,denseMatrix,CsparseMatrix-method} +\alias{\%&\%,denseMatrix,RsparseMatrix-method} +\alias{\%&\%,denseMatrix,TsparseMatrix-method} \alias{\%&\%,denseMatrix,denseMatrix-method} \alias{\%&\%,denseMatrix,diagonalMatrix-method} +\alias{\%&\%,denseMatrix,matrix-method} +\alias{\%&\%,denseMatrix,vector-method} \alias{\%&\%,diagonalMatrix,CsparseMatrix-method} \alias{\%&\%,diagonalMatrix,RsparseMatrix-method} \alias{\%&\%,diagonalMatrix,TsparseMatrix-method} \alias{\%&\%,diagonalMatrix,denseMatrix-method} \alias{\%&\%,diagonalMatrix,diagonalMatrix-method} \alias{\%&\%,diagonalMatrix,matrix-method} +\alias{\%&\%,diagonalMatrix,vector-method} \alias{\%&\%,indMatrix,Matrix-method} \alias{\%&\%,indMatrix,indMatrix-method} \alias{\%&\%,indMatrix,matrix-method} \alias{\%&\%,indMatrix,pMatrix-method} -\alias{\%&\%,mMatrix,CsparseMatrix-method} -\alias{\%&\%,mMatrix,RsparseMatrix-method} -\alias{\%&\%,mMatrix,TsparseMatrix-method} -\alias{\%&\%,mMatrix,sparseMatrix-method} -\alias{\%&\%,mMatrix,sparseVector-method} +\alias{\%&\%,indMatrix,vector-method} \alias{\%&\%,matrix,ANY-method} +\alias{\%&\%,matrix,CsparseMatrix-method} +\alias{\%&\%,matrix,RsparseMatrix-method} +\alias{\%&\%,matrix,TsparseMatrix-method} +\alias{\%&\%,matrix,denseMatrix-method} \alias{\%&\%,matrix,diagonalMatrix-method} \alias{\%&\%,matrix,indMatrix-method} \alias{\%&\%,matrix,matrix-method} \alias{\%&\%,matrix,pMatrix-method} -\alias{\%&\%,nCsparseMatrix,nCsparseMatrix-method} -\alias{\%&\%,nCsparseMatrix,nsparseMatrix-method} -\alias{\%&\%,nMatrix,nMatrix-method} -\alias{\%&\%,nMatrix,nsparseMatrix-method} -\alias{\%&\%,nsparseMatrix,nCsparseMatrix-method} -\alias{\%&\%,nsparseMatrix,nMatrix-method} -\alias{\%&\%,nsparseMatrix,nsparseMatrix-method} -\alias{\%&\%,numLike,sparseVector-method} +\alias{\%&\%,matrix,sparseVector-method} +\alias{\%&\%,matrix,vector-method} \alias{\%&\%,pMatrix,Matrix-method} \alias{\%&\%,pMatrix,indMatrix-method} \alias{\%&\%,pMatrix,matrix-method} \alias{\%&\%,pMatrix,pMatrix-method} -\alias{\%&\%,sparseMatrix,mMatrix-method} -\alias{\%&\%,sparseMatrix,sparseMatrix-method} -\alias{\%&\%,sparseVector,mMatrix-method} -\alias{\%&\%,sparseVector,numLike-method} +\alias{\%&\%,pMatrix,vector-method} +\alias{\%&\%,sparseVector,ANY-method} +\alias{\%&\%,sparseVector,Matrix-method} +\alias{\%&\%,sparseVector,matrix-method} \alias{\%&\%,sparseVector,sparseVector-method} +\alias{\%&\%,sparseVector,vector-method} +\alias{\%&\%,vector,ANY-method} +\alias{\%&\%,vector,CsparseMatrix-method} +\alias{\%&\%,vector,RsparseMatrix-method} +\alias{\%&\%,vector,TsparseMatrix-method} +\alias{\%&\%,vector,denseMatrix-method} +\alias{\%&\%,vector,diagonalMatrix-method} +\alias{\%&\%,vector,indMatrix-method} +\alias{\%&\%,vector,matrix-method} +\alias{\%&\%,vector,pMatrix-method} +\alias{\%&\%,vector,sparseVector-method} +\alias{\%&\%,vector,vector-method} % \description{ For boolean or \dQuote{patter\bold{n}} matrices, i.e., \R objects of @@ -89,13 +110,10 @@ \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} diff -Nru rmatrix-1.6-1.1/man/cBind.Rd rmatrix-1.6-5/man/cBind.Rd --- rmatrix-1.6-1.1/man/cBind.Rd 2023-07-13 21:49:59.000000000 +0000 +++ rmatrix-1.6-5/man/cBind.Rd 2023-08-21 15:41:59.000000000 +0000 @@ -13,59 +13,21 @@ % \alias{cbind2,Matrix,Matrix-method} \alias{cbind2,Matrix,NULL-method} +\alias{cbind2,Matrix,matrix-method} \alias{cbind2,Matrix,missing-method} \alias{cbind2,Matrix,vector-method} \alias{cbind2,NULL,Matrix-method} -\alias{cbind2,ddiMatrix,matrix-method} -\alias{cbind2,ddiMatrix,vector-method} -\alias{cbind2,denseMatrix,denseMatrix-method} -\alias{cbind2,denseMatrix,matrix-method} -\alias{cbind2,denseMatrix,numeric-method} -\alias{cbind2,denseMatrix,sparseMatrix-method} -\alias{cbind2,diagonalMatrix,sparseMatrix-method} -\alias{cbind2,indMatrix,indMatrix-method} -\alias{cbind2,ldiMatrix,matrix-method} -\alias{cbind2,ldiMatrix,vector-method} -\alias{cbind2,matrix,ddiMatrix-method} -\alias{cbind2,matrix,denseMatrix-method} -\alias{cbind2,matrix,ldiMatrix-method} -\alias{cbind2,matrix,sparseMatrix-method} -\alias{cbind2,numeric,denseMatrix-method} -\alias{cbind2,sparseMatrix,denseMatrix-method} -\alias{cbind2,sparseMatrix,diagonalMatrix-method} -\alias{cbind2,sparseMatrix,matrix-method} -\alias{cbind2,sparseMatrix,sparseMatrix-method} +\alias{cbind2,matrix,Matrix-method} \alias{cbind2,vector,Matrix-method} -\alias{cbind2,vector,ddiMatrix-method} -\alias{cbind2,vector,ldiMatrix-method} % \alias{rbind2,Matrix,Matrix-method} \alias{rbind2,Matrix,NULL-method} +\alias{rbind2,Matrix,matrix-method} \alias{rbind2,Matrix,missing-method} \alias{rbind2,Matrix,vector-method} \alias{rbind2,NULL,Matrix-method} -\alias{rbind2,ddiMatrix,matrix-method} -\alias{rbind2,ddiMatrix,vector-method} -\alias{rbind2,denseMatrix,denseMatrix-method} -\alias{rbind2,denseMatrix,matrix-method} -\alias{rbind2,denseMatrix,numeric-method} -\alias{rbind2,denseMatrix,sparseMatrix-method} -\alias{rbind2,diagonalMatrix,sparseMatrix-method} -\alias{rbind2,indMatrix,indMatrix-method} -\alias{rbind2,ldiMatrix,matrix-method} -\alias{rbind2,ldiMatrix,vector-method} -\alias{rbind2,matrix,ddiMatrix-method} -\alias{rbind2,matrix,denseMatrix-method} -\alias{rbind2,matrix,ldiMatrix-method} -\alias{rbind2,matrix,sparseMatrix-method} -\alias{rbind2,numeric,denseMatrix-method} -\alias{rbind2,sparseMatrix,denseMatrix-method} -\alias{rbind2,sparseMatrix,diagonalMatrix-method} -\alias{rbind2,sparseMatrix,matrix-method} -\alias{rbind2,sparseMatrix,sparseMatrix-method} +\alias{rbind2,matrix,Matrix-method} \alias{rbind2,vector,Matrix-method} -\alias{rbind2,vector,ddiMatrix-method} -\alias{rbind2,vector,ldiMatrix-method} % \description{ The base functions \code{\link{cbind}} and \code{\link{rbind}} are @@ -85,10 +47,8 @@ ## cbind(..., deparse.level = 1) ## rbind(..., deparse.level = 1) -\S4method{cbind2}{denseMatrix,sparseMatrix}(x, y, sparse = NA, \dots) -\S4method{cbind2}{sparseMatrix,denseMatrix}(x, y, sparse = NA, \dots) -\S4method{rbind2}{denseMatrix,sparseMatrix}(x, y, sparse = NA, \dots) -\S4method{rbind2}{sparseMatrix,denseMatrix}(x, y, sparse = NA, \dots) +\S4method{cbind2}{Matrix,Matrix}(x, y, \dots) +\S4method{rbind2}{Matrix,Matrix}(x, y, \dots) } \arguments{ \item{\dots}{for \code{[cr]bind}, vector- or matrix-like \R objects @@ -98,11 +58,6 @@ \item{deparse.level}{integer controlling the construction of labels in the case of non-matrix-like arguments; see \code{\link{cbind}}.} \item{x, y}{vector- or matrix-like \R objects to be bound together.} - \item{sparse}{\code{\link{logical}} indicating if the result should - be formally sparse, i.e., if it should inherit from virtual class - \code{\linkS4class{sparseMatrix}}. \code{\link{NA}}, the default, - decides based on the \dQuote{sparsity} of \code{x} and \code{y}; - see, e.g., \code{selectMethod(cbind2, c("sparseMatrix", "denseMatrix"))}.} } \value{ typically a \sQuote{matrix-like} object of a similar diff -Nru rmatrix-1.6-1.1/man/chol2inv-methods.Rd rmatrix-1.6-5/man/chol2inv-methods.Rd --- rmatrix-1.6-1.1/man/chol2inv-methods.Rd 2023-06-27 23:22:10.000000000 +0000 +++ rmatrix-1.6-5/man/chol2inv-methods.Rd 2023-10-25 15:50:21.000000000 +0000 @@ -29,8 +29,9 @@ This function can be seen as way to compute the inverse of a symmetric positive definite matrix given its Cholesky factor. Equivalently, it can be seen as a way to compute - \eqn{(X' X)^{-1}}{(X' X)^(-1)} given the \eqn{R} part - of the QR factorization of \eqn{X}. + \eqn{(X' X)^{-1}}{(X' X)^(-1)} given the \eqn{R} part of the + QR factorization of \eqn{X}, if \eqn{R} is constrained to have + positive diagonal entries. } \usage{ chol2inv(x, \dots) diff -Nru rmatrix-1.6-1.1/man/condest.Rd rmatrix-1.6-5/man/condest.Rd --- rmatrix-1.6-1.1/man/condest.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/condest.Rd 2023-11-03 14:32:44.000000000 +0000 @@ -103,7 +103,7 @@ 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 +all.equal(rc, 1/ce$est) # TRUE -- the approximation was good one <- onenormest(mtm) str(one) ## est = 12.3 diff -Nru rmatrix-1.6-1.1/man/dMatrix-class.Rd rmatrix-1.6-5/man/dMatrix-class.Rd --- rmatrix-1.6-1.1/man/dMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/dMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -17,7 +17,6 @@ \alias{Logic,dMatrix,sparseVector-method} \alias{Logic,logical,dMatrix-method} \alias{Logic,numeric,dMatrix-method} -\alias{Math2,dMatrix-method} \alias{Ops,dMatrix,dMatrix-method} \alias{Ops,dMatrix,ddiMatrix-method} \alias{Ops,dMatrix,lMatrix-method} @@ -25,7 +24,6 @@ \alias{Ops,dMatrix,nMatrix-method} \alias{coerce,matrix,dMatrix-method} \alias{coerce,vector,dMatrix-method} -\alias{zapsmall,dMatrix-method} % \alias{Arith,lMatrix,numeric-method} \alias{Arith,lMatrix,logical-method} @@ -45,7 +43,6 @@ \alias{Ops,lMatrix,nMatrix-method} \alias{Ops,lMatrix,numeric-method} \alias{Ops,numeric,lMatrix-method} -\alias{Summary,lMatrix-method} \alias{coerce,matrix,lMatrix-method} \alias{coerce,vector,lMatrix-method} % diff -Nru rmatrix-1.6-1.1/man/ddenseMatrix-class.Rd rmatrix-1.6-5/man/ddenseMatrix-class.Rd --- rmatrix-1.6-1.1/man/ddenseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ddenseMatrix-class.Rd 2023-09-14 17:58:48.000000000 +0000 @@ -9,20 +9,20 @@ % \alias{&,ddenseMatrix,ddiMatrix-method} \alias{&,ddenseMatrix,ldiMatrix-method} +\alias{&,ddenseMatrix,ndiMatrix-method} \alias{*,ddenseMatrix,ddiMatrix-method} \alias{*,ddenseMatrix,ldiMatrix-method} +\alias{*,ddenseMatrix,ndiMatrix-method} \alias{Arith,ddenseMatrix,logical-method} \alias{Arith,ddenseMatrix,numeric-method} \alias{Arith,ddenseMatrix,sparseVector-method} \alias{Arith,logical,ddenseMatrix-method} \alias{Arith,numeric,ddenseMatrix-method} -\alias{Math,ddenseMatrix-method} -\alias{Summary,ddenseMatrix-method} \alias{^,ddenseMatrix,ddiMatrix-method} \alias{^,ddenseMatrix,ldiMatrix-method} +\alias{^,ddenseMatrix,ndiMatrix-method} \alias{coerce,matrix,ddenseMatrix-method} \alias{coerce,vector,ddenseMatrix-method} -\alias{log,ddenseMatrix-method} % \description{This is the virtual class of all dense numeric (i.e., \bold{d}ouble, hence \emph{\dQuote{ddense}}) S4 matrices. diff -Nru rmatrix-1.6-1.1/man/ddiMatrix-class.Rd rmatrix-1.6-5/man/ddiMatrix-class.Rd --- rmatrix-1.6-1.1/man/ddiMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ddiMatrix-class.Rd 2023-09-14 17:58:48.000000000 +0000 @@ -23,7 +23,6 @@ \alias{*,ddiMatrix,ddenseMatrix-method} \alias{*,ddiMatrix,ldenseMatrix-method} \alias{*,ddiMatrix,ndenseMatrix-method} -\alias{-,ddiMatrix,missing-method} \alias{/,ddiMatrix,Matrix-method} \alias{/,ddiMatrix,ddenseMatrix-method} \alias{/,ddiMatrix,ldenseMatrix-method} @@ -38,12 +37,10 @@ \alias{Ops,ddiMatrix,dMatrix-method} \alias{Ops,ddiMatrix,ddiMatrix-method} \alias{Ops,ddiMatrix,ldiMatrix-method} +\alias{Ops,ddiMatrix,ndiMatrix-method} \alias{Ops,ddiMatrix,logical-method} \alias{Ops,ddiMatrix,numeric-method} \alias{Ops,ddiMatrix,sparseMatrix-method} -\alias{Summary,ddiMatrix-method} -\alias{prod,ddiMatrix-method} -\alias{sum,ddiMatrix-method} % \description{The class \code{"ddiMatrix"} of numerical diagonal matrices. %% FIXME add more diff -Nru rmatrix-1.6-1.1/man/denseMatrix-class.Rd rmatrix-1.6-5/man/denseMatrix-class.Rd --- rmatrix-1.6-1.1/man/denseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/denseMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -9,14 +9,19 @@ % \alias{-,denseMatrix,missing-method} \alias{Math,denseMatrix-method} +\alias{Summary,denseMatrix-method} \alias{coerce,ANY,denseMatrix-method} \alias{coerce,matrix,denseMatrix-method} \alias{coerce,vector,denseMatrix-method} +\alias{diag,denseMatrix-method} +\alias{diag<-,denseMatrix-method} +\alias{diff,denseMatrix-method} \alias{dim<-,denseMatrix-method} \alias{log,denseMatrix-method} \alias{mean,denseMatrix-method} \alias{rep,denseMatrix-method} \alias{show,denseMatrix-method} +\alias{t,denseMatrix-method} % \description{This is the virtual class of all dense (S4) matrices. It partitions into two subclasses diff -Nru rmatrix-1.6-1.1/man/dgTMatrix-class.Rd rmatrix-1.6-5/man/dgTMatrix-class.Rd --- rmatrix-1.6-1.1/man/dgTMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/dgTMatrix-class.Rd 2023-08-30 06:03:42.000000000 +0000 @@ -57,13 +57,13 @@ 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 + Use \code{\link{asUniqueT}()} 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}}. + \code{\linkS4class{TsparseMatrix}}; \code{\link{asUniqueT}}. } \examples{ \dontshow{ % for R_DEFAULT_PACKAGES=NULL diff -Nru rmatrix-1.6-1.1/man/dgeMatrix-class.Rd rmatrix-1.6-5/man/dgeMatrix-class.Rd --- rmatrix-1.6-1.1/man/dgeMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/dgeMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -13,9 +13,7 @@ \alias{Arith,dgeMatrix,sparseVector-method} \alias{Arith,logical,dgeMatrix-method} \alias{Arith,numeric,dgeMatrix-method} -\alias{Math,dgeMatrix-method} \alias{determinant,dgeMatrix,logical-method} -\alias{log,dgeMatrix-method} % \description{A general numeric dense matrix in the S4 Matrix representation. \code{dgeMatrix} is the \emph{\dQuote{standard}} diff -Nru rmatrix-1.6-1.1/man/diagonalMatrix-class.Rd rmatrix-1.6-5/man/diagonalMatrix-class.Rd --- rmatrix-1.6-1.1/man/diagonalMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/diagonalMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -7,9 +7,10 @@ % \alias{diagonalMatrix-class} % +\alias{-,diagonalMatrix,missing-method} \alias{Math,diagonalMatrix-method} \alias{Ops,diagonalMatrix,triangularMatrix-method} -\alias{coerce,diagonalMatrix,sparseVector-method} +\alias{Summary,diagonalMatrix-method} \alias{coerce,diagonalMatrix,symmetricMatrix-method} \alias{coerce,diagonalMatrix,triangularMatrix-method} \alias{coerce,matrix,diagonalMatrix-method} diff -Nru rmatrix-1.6-1.1/man/dpoMatrix-class.Rd rmatrix-1.6-5/man/dpoMatrix-class.Rd --- rmatrix-1.6-1.1/man/dpoMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/dpoMatrix-class.Rd 2023-10-03 16:40:21.000000000 +0000 @@ -36,21 +36,23 @@ \alias{coerce,matrix,dppMatrix-method} \alias{determinant,dppMatrix,logical-method} % +\alias{coerce,corMatrix,pcorMatrix-method} \alias{coerce,matrix,corMatrix-method} % +\alias{coerce,pcorMatrix,corMatrix-method} \alias{coerce,matrix,pcorMatrix-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 + \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"} and \code{"pcorMatrix"} classes + required to be available. + \item The \code{"corMatrix"} and \code{"pcorMatrix"} classes represent correlation matrices. They extend \code{"dpoMatrix"} and \code{"dppMatrix"}, respectively, with an additional slot - \code{sd} allowing restoration of the original covariance matrix.} + \code{sd} allowing restoration of the original covariance matrix. } } \section{Objects from the Class}{Objects can be created by calls of the @@ -93,8 +95,8 @@ \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 + \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} @@ -136,12 +138,14 @@ str(h6) h6 * 27720 # is ``integer'' solve(h6) -str(hp6 <- as(h6, "dppMatrix")) +str(hp6 <- pack(h6)) ### 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)) +stopifnot(all.equal(as(h6 * 27720, "dsyMatrix"), round(27720 * h6), + tolerance = 1e-14), + all.equal(ch6@sd^(-2), 2*(1:6)-1, + tolerance = 1e-12)) chch <- Cholesky(ch6, perm = FALSE) stopifnot(identical(chch, ch6@factors$Cholesky), all(abs(crossprod(as(chch, "dtrMatrix")) - ch6) < 1e-10)) diff -Nru rmatrix-1.6-1.1/man/dsparseMatrix-class.Rd rmatrix-1.6-5/man/dsparseMatrix-class.Rd --- rmatrix-1.6-1.1/man/dsparseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/dsparseMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -12,7 +12,6 @@ \alias{Arith,logical,dsparseMatrix-method} \alias{Arith,numeric,dsparseMatrix-method} \alias{Ops,dsparseMatrix,nsparseMatrix-method} -\alias{Summary,dsparseMatrix-method} \alias{coerce,matrix,dsparseMatrix-method} \alias{coerce,vector,dsparseMatrix-method} % diff -Nru rmatrix-1.6-1.1/man/dsyMatrix-class.Rd rmatrix-1.6-5/man/dsyMatrix-class.Rd --- rmatrix-1.6-1.1/man/dsyMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/dsyMatrix-class.Rd 2023-10-03 16:40:21.000000000 +0000 @@ -10,21 +10,19 @@ % \alias{coerce,dsyMatrix,corMatrix-method} \alias{coerce,dsyMatrix,dpoMatrix-method} -\alias{coerce,dsyMatrix,dppMatrix-method} \alias{determinant,dsyMatrix,logical-method} % -\alias{coerce,dspMatrix,dpoMatrix-method} \alias{coerce,dspMatrix,dppMatrix-method} \alias{coerce,dspMatrix,pcorMatrix-method} \alias{determinant,dspMatrix,logical-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 + \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.} + triangle or the lower triangle is stored. } } \section{Objects from the Class}{ diff -Nru rmatrix-1.6-1.1/man/dtrMatrix-class.Rd rmatrix-1.6-5/man/dtrMatrix-class.Rd --- rmatrix-1.6-1.1/man/dtrMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/dtrMatrix-class.Rd 2023-10-03 16:40:21.000000000 +0000 @@ -37,13 +37,13 @@ \section{Methods}{ Among others (such as matrix products, e.g. \code{?\link{crossprod-methods}}), \describe{ - \item{norm}{\code{signature(x = "dtrMatrix", type = "character")}} - \item{rcond}{\code{signature(x = "dtrMatrix", norm = "character")}} - \item{solve}{\code{signature(a = "dtrMatrix", b = "....")}}{efficientely + \item{norm}{\code{signature(x = "dtrMatrix", type = "character")}: ..} + \item{rcond}{\code{signature(x = "dtrMatrix", norm = "character")}: ..} + \item{solve}{\code{signature(a = "dtrMatrix", b = "....")}: efficiently 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 + \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.} } diff -Nru rmatrix-1.6-1.1/man/fastMisc.Rd rmatrix-1.6-5/man/fastMisc.Rd --- rmatrix-1.6-1.1/man/fastMisc.Rd 2023-07-30 19:03:55.000000000 +0000 +++ rmatrix-1.6-5/man/fastMisc.Rd 2023-09-22 16:57:15.000000000 +0000 @@ -17,6 +17,8 @@ \alias{.M2C} \alias{.M2R} \alias{.M2T} +\alias{.M2V} +\alias{.m2V} \alias{.sparse2dense} \alias{.diag2dense} \alias{.ind2dense} @@ -26,7 +28,7 @@ \alias{.ind2sparse} \alias{.m2sparse} \alias{.tCRT} -% coercions, predating API finalization, hence no longer documented +% coercions, predating API finalization, hence no longer documented: \alias{.CR2RC} \alias{.CR2T} \alias{.T2CR} @@ -70,15 +72,18 @@ .M2R(from) .M2T(from) +.M2V(from) +.m2V(from, kind = ".") + .sparse2dense(from, packed = FALSE) -.diag2dense(from, shape = "t", packed = FALSE, uplo = "U") +.diag2dense(from, kind = ".", shape = "t", packed = FALSE, uplo = "U") .ind2dense(from, kind = "n") -.m2dense(from, class, uplo = "U", diag = "N") +.m2dense(from, class = ".ge", uplo = "U", diag = "N", trans = FALSE) .dense2sparse(from, repr = "C") -.diag2sparse(from, shape = "t", repr = "C", uplo = "U") +.diag2sparse(from, kind = ".", shape = "t", repr = "C", uplo = "U") .ind2sparse(from, kind = "n", repr = ".") -.m2sparse(from, class, uplo = "U", diag = "N") +.m2sparse(from, class = ".gC", uplo = "U", diag = "N", trans = FALSE) .tCRT(x, lazy = TRUE) @@ -92,11 +97,14 @@ } \arguments{ \item{from, x, a, b}{a \code{\linkS4class{Matrix}}, matrix, or vector.} - \item{kind}{a string (\code{"."}, \code{"n"}, \code{"l"}, or - \code{"d"}) specifying the \dQuote{kind} of the result. \code{"."} - indicates that the kind of \code{from} should be preserved. + \item{kind}{a string (\code{"."}, \code{","}, \code{"n"}, \code{"l"}, + or \code{"d"}) specifying the \dQuote{kind} of the result. + \code{"."} indicates that the kind of \code{from} should be preserved. + \code{","} is equivalent to \code{"z"} if \code{from} is complex + and to \code{"d"} otherwise. \code{"n"} indicates that the result should inherit from - \code{\linkS4class{nMatrix}} (and so on).} + \code{\linkS4class{nMatrix}} or \code{\linkS4class{nsparseVector}} + (and so on).} \item{shape}{a string (\code{"."}, \code{"g"}, \code{"s"}, or \code{"t"}) specifying the \dQuote{shape} of the result. \code{"."} indicates that the shape of \code{from} should be preserved. @@ -104,28 +112,31 @@ \code{\linkS4class{generalMatrix}} (and so on).} \item{repr}{a string (\code{"."}, \code{"C"}, \code{"R"}, or \code{"T"}) specifying the sparse representation of the result. - \code{"."} is accepted only by \code{.ind2sparse} and indicates - the most efficient representation, - which is \code{"C"} (\code{"R"}) for \code{margin = 2} (\code{1}). - \code{"C"} indicates that the result should inherit from - \code{\linkS4class{CsparseMatrix}} (and so on).} + \code{"."} is accepted only by \code{.ind2sparse} and indicates + the most efficient representation, + which is \code{"C"} (\code{"R"}) for \code{margin = 2} (\code{1}). + \code{"C"} indicates that the result should inherit from + \code{\linkS4class{CsparseMatrix}} (and so on).} \item{packed}{a logical indicating if the result should - inherit from \code{\linkS4class{packedMatrix}} - rather than from \code{\linkS4class{unpackedMatrix}}. - It is ignored for \code{from} inheriting from - \code{\linkS4class{generalMatrix}}.} + inherit from \code{\linkS4class{packedMatrix}} + rather than from \code{\linkS4class{unpackedMatrix}}. + It is ignored for \code{from} inheriting from + \code{\linkS4class{generalMatrix}}.} \item{sparse}{a logical indicating if the result should inherit - from \code{\linkS4class{sparseMatrix}} rather than from - \code{\linkS4class{denseMatrix}}. If \code{NA}, then the result - will be formally sparse if and only if \code{from} is.} + from \code{\linkS4class{sparseMatrix}} rather than from + \code{\linkS4class{denseMatrix}}. If \code{NA}, then the result + will be formally sparse if and only if \code{from} is.} \item{uplo}{a string (\code{"U"} or \code{"L"}) indicating whether - the result (if symmetric or triangular) should store the upper or - lower triangle of \code{from}. The elements of \code{from} in the - opposite triangle are ignored.} + the result (if symmetric or triangular) should store the upper or + lower triangle of \code{from}. The elements of \code{from} in the + opposite triangle are ignored.} \item{diag}{a string (\code{"N"} or \code{"U"}) indicating whether - the result (if triangular) should be formally nonunit or unit + the result (if triangular) should be formally nonunit or unit triangular. In the unit triangular case, the diagonal elements - of \code{from} are ignored.} + of \code{from} are ignored.} + \item{trans}{a logical indicating if the result should be a 1-row + matrix rather than a 1-column matrix where \code{from} is a vector + but not a matrix.} \item{class}{a string whose first three characters specify the class of the result. It should match the pattern \code{"^[.nld](ge|sy|tr|sp|tp)"} for \code{.m2dense} and @@ -136,20 +147,20 @@ or \code{\link{isTriangular}}.} %% .tCRT : \item{lazy}{a logical indicating if the transpose should be - constructed with minimal allocation, but possibly \emph{without} - preserving representation.} + constructed with minimal allocation, but possibly \emph{without} + preserving representation.} %% .diag.dsC : \item{Chx}{optionally, the \code{\link{Cholesky}(x, \dots)} - factorization of \code{x}. If supplied, then \code{x} is unused.} + factorization of \code{x}. If supplied, then \code{x} is unused.} \item{res.kind}{a string in \code{c("trace", "sumLog", "prod", "min", "max", "range", "diag", "diagBack")}.} %% .solve.dgC.* : \item{tol}{see \code{\link{lu-methods}}.} \item{order}{see \code{\link{qr-methods}}.} \item{check}{a logical indicating if the first argument should be - tested for inheritance from \code{\linkS4class{dgCMatrix}} and - coerced if necessary. Set to \code{FALSE} for speed only if it - is known to already inherit from \code{\linkS4class{dgCMatrix}}.} + tested for inheritance from \code{\linkS4class{dgCMatrix}} and + coerced if necessary. Set to \code{FALSE} for speed only if it + is known to already inherit from \code{\linkS4class{dgCMatrix}}.} %% .updateCHMfactor : \item{object}{a Cholesky factorization inheriting from virtual class \code{CHMfactor}, almost always the result of a call to generic @@ -166,58 +177,60 @@ \describe{ \item{\code{M}}{\code{\linkS4class{Matrix}}} - \item{\code{m}}{matrix or vector} + \item{\code{V}}{\code{\linkS4class{sparseVector}}} + \item{\code{m}}{matrix} \item{\code{v}}{vector} - \item{\code{dense}}{\code{\linkS4class{denseMatrix}}} + \item{\code{dense}}{\code{\linkS4class{denseMatrix}}} \item{\code{unpacked}}{\code{\linkS4class{unpackedMatrix}}} \item{\code{packed}}{\code{\linkS4class{packedMatrix}}} \item{\code{sparse}}{% - \code{\linkS4class{CsparseMatrix}}, + \code{\linkS4class{CsparseMatrix}}, \code{\linkS4class{RsparseMatrix}}, or \code{\linkS4class{TsparseMatrix}}} - \item{\code{C}}{\code{\linkS4class{CsparseMatrix}}} + \item{\code{C}}{\code{\linkS4class{CsparseMatrix}}} \item{\code{R}}{\code{\linkS4class{RsparseMatrix}}} \item{\code{T}}{\code{\linkS4class{TsparseMatrix}}} \item{\code{gen}}{\code{\linkS4class{generalMatrix}}} \item{\code{sym}}{\code{\linkS4class{symmetricMatrix}}} \item{\code{tri}}{\code{\linkS4class{triangularMatrix}}} \item{\code{diag}}{\code{\linkS4class{diagonalMatrix}}} - \item{\code{ind}}{\code{\linkS4class{indMatrix}}} + \item{\code{ind}}{\code{\linkS4class{indMatrix}}} } Abbreviations should be seen as a guide, rather than as an - exact description of behaviour. For example, \code{.m2dense} - and \code{.m2sparse} accept vectors in addition to matrices. - + exact description of behaviour. Notably, \code{.m2dense}, + \code{.m2sparse}, and \code{.m2V} accept vectors that are + not matrices. + \subsection{\code{.tCRT(x)}}{ - If \code{lazy = TRUE}, then \code{.tCRT} constructs the transpose - of \code{x} using the most efficient representation, - which for \samp{CRT} is \samp{RCT}. If \code{lazy = FALSE}, - then \code{.tCRT} preserves the representation of \code{x}, - behaving as the corresponding methods for generic function \code{t}. + If \code{lazy = TRUE}, then \code{.tCRT} constructs the transpose + of \code{x} using the most efficient representation, + which for \samp{CRT} is \samp{RCT}. If \code{lazy = FALSE}, + then \code{.tCRT} preserves the representation of \code{x}, + behaving as the corresponding methods for generic function \code{t}. } \subsection{\code{.diag.dsC(x)}}{ \code{.diag.dsC} computes (or uses if \code{Chx} is supplied) - the Cholesky factorization of \code{x} as \eqn{L D L'} in order - to calculate one of several possible statistics from the diagonal - entries of \eqn{D}. See \code{res.kind} under \sQuote{Arguments}. + the Cholesky factorization of \code{x} as \eqn{L D L'} in order + to calculate one of several possible statistics from the diagonal + entries of \eqn{D}. See \code{res.kind} under \sQuote{Arguments}. } \subsection{\code{.solve.dgC.*(a, b)}}{ \code{.solve.dgC.lu(a, b)} needs a square matrix \code{a}. \code{.solve.dgC.qr(a, b)} needs a \dQuote{long} matrix \code{a}, with \code{nrow(a) >= ncol(a)}. \code{.solve.dgC.chol(a, b)} needs a \dQuote{wide} matrix \code{a}, - with \code{nrow(a) <= ncol(a)}. - + with \code{nrow(a) <= ncol(a)}. + All three may be used to solve sparse linear systems directly. Only \code{.solve.dgC.qr} and \code{.solve.dgC.chol} be used to solve sparse \emph{least squares} problems. } \subsection{\code{.updateCHMfactor(object, parent, mult)}}{ \code{.updateCHMfactor} updates \code{object} with the result - of Cholesky factorizing - \code{F(parent) + mult[1] * diag(nrow(parent))}, - i.e., \code{F(parent)} plus \code{mult[1]} times the identity matrix, + of Cholesky factorizing + \code{F(parent) + mult[1] * diag(nrow(parent))}, + i.e., \code{F(parent)} plus \code{mult[1]} times the identity matrix, where \code{F = identity} if \code{parent} is a \code{dsCMatrix} and \code{F = tcrossprod} if \code{parent} is a \code{dgCMatrix}. The nonzero pattern of \code{F(parent)} must match @@ -242,10 +255,10 @@ as(C., "lMatrix")) identical(.M2kind(.sparse2dense(C.), "l"), as(as(C., "denseMatrix"), "lMatrix")) - identical(.diag2sparse(D.0, "t", "C"), - .dense2sparse(.diag2dense(D.0, "t", TRUE), "C")) - identical(.M2gen(.diag2dense(D.0, "s", FALSE)), - .sparse2dense(.M2gen(.diag2sparse(D.0, "s", "T")))) + identical(.diag2sparse(D.0, ".", "t", "C"), + .dense2sparse(.diag2dense(D.0, ".", "t", TRUE), "C")) + identical(.M2gen(.diag2dense(D.0, ".", "s", FALSE)), + .sparse2dense(.M2gen(.diag2sparse(D.0, ".", "s", "T")))) identical(S., .M2m(.m2sparse(S., ".sR"))) identical(S. * lower.tri(S.) + diag(1, 6L), diff -Nru rmatrix-1.6-1.1/man/forceSymmetric.Rd rmatrix-1.6-5/man/forceSymmetric.Rd --- rmatrix-1.6-1.1/man/forceSymmetric.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/forceSymmetric.Rd 2023-08-16 08:02:09.000000000 +0000 @@ -14,16 +14,14 @@ \alias{forceSymmetric,RsparseMatrix,missing-method} \alias{forceSymmetric,TsparseMatrix,character-method} \alias{forceSymmetric,TsparseMatrix,missing-method} +\alias{forceSymmetric,denseMatrix,character-method} +\alias{forceSymmetric,denseMatrix,missing-method} \alias{forceSymmetric,diagonalMatrix,character-method} \alias{forceSymmetric,diagonalMatrix,missing-method} \alias{forceSymmetric,indMatrix,character-method} \alias{forceSymmetric,indMatrix,missing-method} \alias{forceSymmetric,matrix,character-method} \alias{forceSymmetric,matrix,missing-method} -\alias{forceSymmetric,packedMatrix,character-method} -\alias{forceSymmetric,packedMatrix,missing-method} -\alias{forceSymmetric,unpackedMatrix,character-method} -\alias{forceSymmetric,unpackedMatrix,missing-method} % \description{ Force a square matrix \code{x} to a \code{\linkS4class{symmetricMatrix}}, diff -Nru rmatrix-1.6-1.1/man/graph2T.Rd rmatrix-1.6-5/man/graph2T.Rd --- rmatrix-1.6-1.1/man/graph2T.Rd 2023-07-28 18:24:15.000000000 +0000 +++ rmatrix-1.6-5/man/graph2T.Rd 2023-08-30 06:03:42.000000000 +0000 @@ -31,7 +31,7 @@ } \usage{ graph2T(from, use.weights = ) -T2graph(from, need.uniq = is_not_uniqT(from), edgemode = NULL) +T2graph(from, need.uniq = !isUniqueT(from), edgemode = NULL) } \arguments{ \item{from}{for \code{graph2T()}, an \R object of class @@ -82,7 +82,7 @@ , identical(tg3 <- graph2T(g3), graph2T(g3, use.weights=FALSE)) , - identical(as(m3,"TsparseMatrix"), uniqTsparse(tg3)) + identical(as(m3,"TsparseMatrix"), asUniqueT(tg3)) ) } a. <- sparseMatrix(i=4:1, j=1:4, dimnames=list(n4, n4), repr="T") # no 'x' diff -Nru rmatrix-1.6-1.1/man/indMatrix-class.Rd rmatrix-1.6-5/man/indMatrix-class.Rd --- rmatrix-1.6-1.1/man/indMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/indMatrix-class.Rd 2024-01-03 16:12:15.000000000 +0000 @@ -7,17 +7,20 @@ % \alias{indMatrix-class} % +\alias{!,indMatrix-method} \alias{-,indMatrix,missing-method} +\alias{Math,indMatrix-method} \alias{Summary,indMatrix-method} \alias{coerce,indMatrix,pMatrix-method} -\alias{coerce,indMatrix,sparseVector-method} \alias{coerce,list,indMatrix-method} \alias{coerce,matrix,indMatrix-method} \alias{coerce,numeric,indMatrix-method} \alias{determinant,indMatrix,logical-method} \alias{diag,indMatrix-method} \alias{diag<-,indMatrix-method} +\alias{log,indMatrix-method} \alias{t,indMatrix-method} +\alias{which,indMatrix-method} % \description{ The \code{indMatrix} class is the class of row and column @@ -90,7 +93,7 @@ their \dQuote{interaction}.} } } -\author{Fabian Scheipl and Uni Muenchen, building on the existing class +\author{Fabian Scheipl at \file{uni-muenchen.de}, building on the existing class \code{\linkS4class{pMatrix}} after a nice hike's conversation with Martin Maechler. Methods for \code{\link{crossprod}(x, y)} and \code{\link{kronecker}(x, y)} with both arguments inheriting from @@ -108,7 +111,7 @@ The cross product of a row index matrix \code{R} and itself is a diagonal matrix whose diagonal entries are the the number of entries in each column of \code{R}. - + Given a row index matrix \code{R} with \code{perm} slot \code{p}, a column index matrix \code{C} with \code{perm} slot \code{q}, and a matrix \code{M} with conformable dimensions, we have diff -Nru rmatrix-1.6-1.1/man/is.na-methods.Rd rmatrix-1.6-5/man/is.na-methods.Rd --- rmatrix-1.6-1.1/man/is.na-methods.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/is.na-methods.Rd 2023-08-29 04:10:03.000000000 +0000 @@ -7,107 +7,65 @@ \keyword{programming} \keyword{methods} % +\alias{anyNA} +\alias{anyNA-methods} \alias{is.na} \alias{is.na-methods} \alias{is.nan} \alias{is.nan-methods} -\alias{is.finite} -\alias{is.finite-methods} \alias{is.infinite} \alias{is.infinite-methods} -\alias{anyNA} -\alias{anyNA-methods} +\alias{is.finite} +\alias{is.finite-methods} +% +\alias{anyNA,denseMatrix-method} +\alias{anyNA,diagonalMatrix-method} +\alias{anyNA,indMatrix-method} +\alias{anyNA,sparseMatrix-method} +\alias{anyNA,sparseVector-method} % \alias{is.na,abIndex-method} -\alias{is.na,dgeMatrix-method} +\alias{is.na,denseMatrix-method} \alias{is.na,diagonalMatrix-method} -\alias{is.na,dspMatrix-method} -\alias{is.na,dsparseMatrix-method} -\alias{is.na,dsyMatrix-method} -\alias{is.na,dtpMatrix-method} -\alias{is.na,dtrMatrix-method} \alias{is.na,indMatrix-method} -\alias{is.na,lgeMatrix-method} -\alias{is.na,lspMatrix-method} -\alias{is.na,lsparseMatrix-method} -\alias{is.na,lsyMatrix-method} -\alias{is.na,ltpMatrix-method} -\alias{is.na,ltrMatrix-method} -\alias{is.na,nMatrix-method} -\alias{is.na,nsparseVector-method} +\alias{is.na,sparseMatrix-method} \alias{is.na,sparseVector-method} % -\alias{is.nan,ddiMatrix-method} -\alias{is.nan,dgeMatrix-method} -\alias{is.nan,dspMatrix-method} -\alias{is.nan,dsparseMatrix-method} -\alias{is.nan,dsyMatrix-method} -\alias{is.nan,dtpMatrix-method} -\alias{is.nan,dtrMatrix-method} +\alias{is.nan,denseMatrix-method} +\alias{is.nan,diagonalMatrix-method} \alias{is.nan,indMatrix-method} -\alias{is.nan,lMatrix-method} -\alias{is.nan,nMatrix-method} -\alias{is.nan,nsparseVector-method} +\alias{is.nan,sparseMatrix-method} \alias{is.nan,sparseVector-method} % -\alias{is.finite,abIndex-method} -\alias{is.finite,dgeMatrix-method} -\alias{is.finite,diagonalMatrix-method} -\alias{is.finite,dspMatrix-method} -\alias{is.finite,dsparseMatrix-method} -\alias{is.finite,dsyMatrix-method} -\alias{is.finite,dtpMatrix-method} -\alias{is.finite,dtrMatrix-method} -\alias{is.finite,indMatrix-method} -\alias{is.finite,lgeMatrix-method} -\alias{is.finite,lspMatrix-method} -\alias{is.finite,lsparseMatrix-method} -\alias{is.finite,lsyMatrix-method} -\alias{is.finite,ltpMatrix-method} -\alias{is.finite,ltrMatrix-method} -\alias{is.finite,nMatrix-method} -\alias{is.finite,nsparseVector-method} -\alias{is.finite,sparseVector-method} -% \alias{is.infinite,abIndex-method} -\alias{is.infinite,ddiMatrix-method} -\alias{is.infinite,dgeMatrix-method} -\alias{is.infinite,dspMatrix-method} -\alias{is.infinite,dsparseMatrix-method} -\alias{is.infinite,dsyMatrix-method} -\alias{is.infinite,dtpMatrix-method} -\alias{is.infinite,dtrMatrix-method} +\alias{is.infinite,denseMatrix-method} +\alias{is.infinite,diagonalMatrix-method} \alias{is.infinite,indMatrix-method} -\alias{is.infinite,lMatrix-method} -\alias{is.infinite,nMatrix-method} -\alias{is.infinite,nsparseVector-method} +\alias{is.infinite,sparseMatrix-method} \alias{is.infinite,sparseVector-method} % -\alias{anyNA,ddenseMatrix-method} -\alias{anyNA,diagonalMatrix-method} -\alias{anyNA,dsparseMatrix-method} -\alias{anyNA,indMatrix-method} -\alias{anyNA,ldenseMatrix-method} -\alias{anyNA,lsparseMatrix-method} -\alias{anyNA,nMatrix-method} -\alias{anyNA,nsparseVector-method} -\alias{anyNA,sparseVector-method} +\alias{is.finite,abIndex-method} +\alias{is.finite,denseMatrix-method} +\alias{is.finite,diagonalMatrix-method} +\alias{is.finite,indMatrix-method} +\alias{is.finite,sparseMatrix-method} +\alias{is.finite,sparseVector-method} % \description{ - Methods for generic functions \code{\link{is.na}()}, - \code{\link{is.nan}()}, \code{\link{is.finite}()}, - \code{\link{is.infinite}()}, and \code{\link{anyNA}()}, + Methods for generic functions \code{\link{anyNA}()}, + \code{\link{is.na}()}, \code{\link{is.nan}()}, + \code{\link{is.infinite}()}, and \code{\link{is.finite}()}, for objects inheriting from virtual class \code{\linkS4class{Matrix}} or \code{\linkS4class{sparseVector}}. } \usage{ -\S4method{is.na}{dsparseMatrix}(x) -\S4method{is.nan}{dsparseMatrix}(x) -\S4method{is.finite}{dsparseMatrix}(x) -\S4method{is.infinite}{dsparseMatrix}(x) -\S4method{anyNA}{dsparseMatrix}(x) +\S4method{is.na}{denseMatrix}(x) +\S4method{is.na}{sparseMatrix}(x) +\S4method{is.na}{diagonalMatrix}(x) +\S4method{is.na}{indMatrix}(x) +\S4method{is.na}{sparseVector}(x) ## ... -## and for other classes +## and likewise for anyNA, is.nan, is.infinite, is.finite } \arguments{ \item{x}{an \R object, here a sparse or dense matrix or vector.} diff -Nru rmatrix-1.6-1.1/man/isSymmetric-methods.Rd rmatrix-1.6-5/man/isSymmetric-methods.Rd --- rmatrix-1.6-1.1/man/isSymmetric-methods.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/isSymmetric-methods.Rd 2023-08-16 08:02:09.000000000 +0000 @@ -9,24 +9,17 @@ \alias{isSymmetric} \alias{isSymmetric-methods} % +\alias{isSymmetric,CsparseMatrix-method} +\alias{isSymmetric,RsparseMatrix-method} +\alias{isSymmetric,TsparseMatrix-method} +\alias{isSymmetric,denseMatrix-method} \alias{isSymmetric,diagonalMatrix-method} \alias{isSymmetric,indMatrix-method} -\alias{isSymmetric,symmetricMatrix-method} -\alias{isSymmetric,triangularMatrix-method} -% disambiguation: +% tolerating numerical fuzz for [dz]Matrix: \alias{isSymmetric,dgCMatrix-method} \alias{isSymmetric,dgRMatrix-method} \alias{isSymmetric,dgTMatrix-method} \alias{isSymmetric,dgeMatrix-method} -\alias{isSymmetric,lgCMatrix-method} -\alias{isSymmetric,lgRMatrix-method} -\alias{isSymmetric,lgTMatrix-method} -\alias{isSymmetric,lgeMatrix-method} -\alias{isSymmetric,ngCMatrix-method} -\alias{isSymmetric,ngRMatrix-method} -\alias{isSymmetric,ngTMatrix-method} -\alias{isSymmetric,ngeMatrix-method} -% tolerating numerical fuzz for [dz]Matrix: \alias{isSymmetric,dtCMatrix-method} \alias{isSymmetric,dtRMatrix-method} \alias{isSymmetric,dtTMatrix-method} @@ -45,24 +38,22 @@ inheriting from virtual class \code{"\linkS4class{Matrix}"}. } \usage{ -\S4method{isSymmetric}{symmetricMatrix}(object, \dots) -\S4method{isSymmetric}{triangularMatrix}(object, checkDN = TRUE, \dots) +\S4method{isSymmetric}{denseMatrix}(object, checkDN = TRUE, \dots) +\S4method{isSymmetric}{CsparseMatrix}(object, checkDN = TRUE, \dots) +\S4method{isSymmetric}{RsparseMatrix}(object, checkDN = TRUE, \dots) +\S4method{isSymmetric}{TsparseMatrix}(object, checkDN = TRUE, \dots) \S4method{isSymmetric}{diagonalMatrix}(object, checkDN = TRUE, \dots) \S4method{isSymmetric}{indMatrix}(object, checkDN = TRUE, \dots) -\S4method{isSymmetric}{dgeMatrix}(object, tol = 100 * .Machine$double.eps, tol1 = 8 * tol, checkDN = TRUE, \dots) -\S4method{isSymmetric}{lgeMatrix}(object, checkDN = TRUE, \dots) -\S4method{isSymmetric}{ngeMatrix}(object, checkDN = TRUE, \dots) -\S4method{isSymmetric}{dgCMatrix}(object, tol = 100 * .Machine$double.eps, checkDN = TRUE, \dots) -\S4method{isSymmetric}{lgCMatrix}(object, checkDN = TRUE, \dots) -\S4method{isSymmetric}{ngCMatrix}(object, checkDN = TRUE, \dots) +\S4method{isSymmetric}{dgeMatrix}(object, checkDN = TRUE, tol = 100 * .Machine$double.eps, tol1 = 8 * tol, \dots) +\S4method{isSymmetric}{dgCMatrix}(object, checkDN = TRUE, tol = 100 * .Machine$double.eps, \dots) } \arguments{ \item{object}{a \code{"Matrix"}.} + \item{checkDN}{a \link{logical} indicating whether symmetry of the + \code{Dimnames} \link{slot} of \code{object} should be checked.} \item{tol, tol1}{numerical tolerances allowing \emph{approximate} symmetry of numeric (rather than logical) matrices. See also \code{\link{isSymmetric.matrix}}.} - \item{checkDN}{a \link{logical} indicating whether symmetry of the - \code{Dimnames} \link{slot} of \code{object} should be checked.} \item{\dots}{further arguments passed to methods (typically methods for \code{\link{all.equal}}).} } diff -Nru rmatrix-1.6-1.1/man/isTriangular.Rd rmatrix-1.6-5/man/isTriangular.Rd --- rmatrix-1.6-1.1/man/isTriangular.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/isTriangular.Rd 2023-08-16 08:02:09.000000000 +0000 @@ -11,33 +11,21 @@ \alias{isDiagonal} \alias{isDiagonal-methods} % +\alias{isTriangular,CsparseMatrix-method} +\alias{isTriangular,RsparseMatrix-method} +\alias{isTriangular,TsparseMatrix-method} +\alias{isTriangular,denseMatrix-method} \alias{isTriangular,diagonalMatrix-method} \alias{isTriangular,indMatrix-method} \alias{isTriangular,matrix-method} -\alias{isTriangular,symmetricMatrix-method} -\alias{isTriangular,triangularMatrix-method} % \alias{isDiagonal,CsparseMatrix-method} \alias{isDiagonal,RsparseMatrix-method} \alias{isDiagonal,TsparseMatrix-method} +\alias{isDiagonal,denseMatrix-method} \alias{isDiagonal,diagonalMatrix-method} \alias{isDiagonal,indMatrix-method} \alias{isDiagonal,matrix-method} -\alias{isDiagonal,packedMatrix-method} -\alias{isDiagonal,unpackedMatrix-method} -% disambiguation: -\alias{isTriangular,dgCMatrix-method} -\alias{isTriangular,dgRMatrix-method} -\alias{isTriangular,dgTMatrix-method} -\alias{isTriangular,dgeMatrix-method} -\alias{isTriangular,lgCMatrix-method} -\alias{isTriangular,lgRMatrix-method} -\alias{isTriangular,lgTMatrix-method} -\alias{isTriangular,lgeMatrix-method} -\alias{isTriangular,ngCMatrix-method} -\alias{isTriangular,ngRMatrix-method} -\alias{isTriangular,ngTMatrix-method} -\alias{isTriangular,ngeMatrix-method} % \description{ \code{isTriangular} and \code{isDiagonal} test whether their argument diff -Nru rmatrix-1.6-1.1/man/ldenseMatrix-class.Rd rmatrix-1.6-5/man/ldenseMatrix-class.Rd --- rmatrix-1.6-1.1/man/ldenseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ldenseMatrix-class.Rd 2023-09-14 17:58:48.000000000 +0000 @@ -7,15 +7,18 @@ % \alias{ldenseMatrix-class} % +\alias{!,ldenseMatrix-method} \alias{&,ldenseMatrix,ddiMatrix-method} \alias{&,ldenseMatrix,ldiMatrix-method} +\alias{&,ldenseMatrix,ndiMatrix-method} \alias{*,ldenseMatrix,ddiMatrix-method} \alias{*,ldenseMatrix,ldiMatrix-method} +\alias{*,ldenseMatrix,ndiMatrix-method} \alias{Logic,ldenseMatrix,lsparseMatrix-method} \alias{Ops,ldenseMatrix,ldenseMatrix-method} -\alias{Summary,ldenseMatrix-method} \alias{^,ldenseMatrix,ddiMatrix-method} \alias{^,ldenseMatrix,ldiMatrix-method} +\alias{^,ldenseMatrix,ndiMatrix-method} \alias{coerce,matrix,ldenseMatrix-method} \alias{coerce,vector,ldenseMatrix-method} \alias{which,ldenseMatrix-method} diff -Nru rmatrix-1.6-1.1/man/ldiMatrix-class.Rd rmatrix-1.6-5/man/ldiMatrix-class.Rd --- rmatrix-1.6-1.1/man/ldiMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ldiMatrix-class.Rd 2023-09-14 17:58:48.000000000 +0000 @@ -6,6 +6,7 @@ \keyword{classes} % \alias{ldiMatrix-class} +\alias{ndiMatrix-class} % for now % \alias{!,ldiMatrix-method} \alias{\%\%,ldiMatrix,Matrix-method} @@ -24,7 +25,6 @@ \alias{*,ldiMatrix,ddenseMatrix-method} \alias{*,ldiMatrix,ldenseMatrix-method} \alias{*,ldiMatrix,ndenseMatrix-method} -\alias{-,ldiMatrix,missing-method} \alias{/,ldiMatrix,Matrix-method} \alias{/,ldiMatrix,ddenseMatrix-method} \alias{/,ldiMatrix,ldenseMatrix-method} @@ -39,14 +39,39 @@ \alias{Ops,ldiMatrix,dMatrix-method} \alias{Ops,ldiMatrix,ddiMatrix-method} \alias{Ops,ldiMatrix,ldiMatrix-method} +\alias{Ops,ldiMatrix,ndiMatrix-method} \alias{Ops,ldiMatrix,logical-method} \alias{Ops,ldiMatrix,numeric-method} \alias{Ops,ldiMatrix,sparseMatrix-method} -\alias{Summary,ldiMatrix-method} -\alias{prod,ldiMatrix-method} -\alias{sum,ldiMatrix-method} \alias{which,ldiMatrix-method} % +\alias{!,ndiMatrix-method} +\alias{\%\%,ndiMatrix,Matrix-method} +\alias{\%\%,ndiMatrix,ddenseMatrix-method} +\alias{\%\%,ndiMatrix,ldenseMatrix-method} +\alias{\%\%,ndiMatrix,ndenseMatrix-method} +\alias{\%/\%,ndiMatrix,Matrix-method} +\alias{\%/\%,ndiMatrix,ddenseMatrix-method} +\alias{\%/\%,ndiMatrix,ldenseMatrix-method} +\alias{\%/\%,ndiMatrix,ndenseMatrix-method} +\alias{&,ndiMatrix,Matrix-method} +\alias{&,ndiMatrix,ddenseMatrix-method} +\alias{&,ndiMatrix,ldenseMatrix-method} +\alias{&,ndiMatrix,ndenseMatrix-method} +\alias{*,ndiMatrix,Matrix-method} +\alias{*,ndiMatrix,Matrix-method} +\alias{*,ndiMatrix,ddenseMatrix-method} +\alias{*,ndiMatrix,ldenseMatrix-method} +\alias{*,ndiMatrix,ndenseMatrix-method} +\alias{/,ndiMatrix,Matrix-method} +\alias{/,ndiMatrix,ddenseMatrix-method} +\alias{/,ndiMatrix,ldenseMatrix-method} +\alias{/,ndiMatrix,ndenseMatrix-method} +\alias{Ops,ndiMatrix,ddiMatrix-method} +\alias{Ops,ndiMatrix,ldiMatrix-method} +\alias{Ops,ndiMatrix,ndiMatrix-method} +\alias{which,ndiMatrix-method} +% \description{The class \code{"ldiMatrix"} of logical diagonal matrices. %% FIXME add more } @@ -86,6 +111,6 @@ str(lM)#> gory details (slots) crossprod(lM) # numeric -(nM <- as(lM, "nMatrix"))# -> sparse (not formally ``diagonal'') -crossprod(nM) # logical sparse +(nM <- as(lM, "nMatrix")) +crossprod(nM) # pattern sparse } diff -Nru rmatrix-1.6-1.1/man/lgeMatrix-class.Rd rmatrix-1.6-5/man/lgeMatrix-class.Rd --- rmatrix-1.6-1.1/man/lgeMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/lgeMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -7,7 +7,6 @@ % \alias{lgeMatrix-class} % -\alias{!,lgeMatrix-method} \alias{Arith,lgeMatrix,lgeMatrix-method} \alias{Compare,lgeMatrix,lgeMatrix-method} \alias{Logic,lgeMatrix,lgeMatrix-method} diff -Nru rmatrix-1.6-1.1/man/lsparseMatrix-classes.Rd rmatrix-1.6-5/man/lsparseMatrix-classes.Rd --- rmatrix-1.6-1.1/man/lsparseMatrix-classes.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/lsparseMatrix-classes.Rd 2023-08-30 06:03:42.000000000 +0000 @@ -41,9 +41,9 @@ % lsR % lsT % -\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. +\description{The \code{lsparseMatrix} class is a virtual class + of logical sparse matrices, i.e., sparse matrices with entries + \code{TRUE}, \code{FALSE}, or \code{NA}. These can be stored in the \dQuote{triplet} form (class \code{\linkS4class{TsparseMatrix}}, subclasses \code{lgTMatrix}, @@ -81,7 +81,7 @@ \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 + Note the use of \code{\link{asUniqueT}()} for getting an internally unique representation without duplicated \eqn{(i,j)} entries. } \section{Slots}{ diff -Nru rmatrix-1.6-1.1/man/lsyMatrix-class.Rd rmatrix-1.6-5/man/lsyMatrix-class.Rd --- rmatrix-1.6-1.1/man/lsyMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/lsyMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -8,10 +8,6 @@ \alias{lsyMatrix-class} \alias{lspMatrix-class} % -\alias{!,lsyMatrix-method} -% -\alias{!,lspMatrix-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 diff -Nru rmatrix-1.6-1.1/man/ltrMatrix-class.Rd rmatrix-1.6-5/man/ltrMatrix-class.Rd --- rmatrix-1.6-1.1/man/ltrMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/ltrMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -8,10 +8,6 @@ \alias{ltrMatrix-class} \alias{ltpMatrix-class} % -\alias{!,ltrMatrix-method} -% -\alias{!,ltpMatrix-method} -% \description{ The \code{"ltrMatrix"} class is the class of triangular, dense, logical matrices in nonpacked storage. The \code{"ltpMatrix"} class diff -Nru rmatrix-1.6-1.1/man/lu.Rd rmatrix-1.6-5/man/lu.Rd --- rmatrix-1.6-1.1/man/lu.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/lu.Rd 2023-11-02 17:07:44.000000000 +0000 @@ -37,9 +37,9 @@ where \eqn{P_{1}}{P1} is an \eqn{m \times m}{m-by-m} permutation matrix, \eqn{P_{2}}{P2} is an \eqn{n \times n}{n-by-n} permutation matrix, - \eqn{L} is an \eqn{m \times \text{min}(m,n)}{m-by-min(m,n)} + \eqn{L} is an \eqn{m \times \min(m,n)}{m-by-min(m,n)} unit lower trapezoidal matrix, and - \eqn{U} is a \eqn{\text{min}(m,n) \times n}{min(m,n)-by-n} + \eqn{U} is a \eqn{\min(m,n) \times n}{min(m,n)-by-n} upper trapezoidal matrix. Methods for \code{\linkS4class{denseMatrix}} are built on diff -Nru rmatrix-1.6-1.1/man/macros/local.Rd rmatrix-1.6-5/man/macros/local.Rd --- rmatrix-1.6-1.1/man/macros/local.Rd 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/man/macros/local.Rd 2023-11-01 18:35:44.000000000 +0000 @@ -0,0 +1,6 @@ +%% amsmath commands supported since 4.2.2 (PDF), 4.2.0 (HTML) +%% unfortunately commands in #1 really do need 8 escapes ... + +\newcommand{\Seqn}{\ifelse{latex}{\Sexpr[results=rd]{if (getRversion() >= "4.2.2") "\\\\\\\\eqn{#1}" else "\\\\\\\\verb{#2}"}}{\ifelse{html}{\Sexpr[results=rd]{if (getRversion() >= "4.2.0") "\\\\\\\\eqn{#1}" else "\\\\\\\\verb{#2}"}}{\Sexpr[results=rd]{"\\\\\\\\eqn{#2}"}}}} + +\newcommand{\Sdeqn}{\ifelse{latex}{\Sexpr[results=rd]{if (getRversion() >= "4.2.2") "\\\\\\\\deqn{#1}" else "\\\\\\\\preformatted{#2}"}}{\ifelse{html}{\Sexpr[results=rd]{if (getRversion() >= "4.2.0") "\\\\\\\\deqn{#1}" else "\\\\\\\\preformatted{#2}"}}{\Sexpr[results=rd]{"\\\\\\\\deqn{#2}"}}}} diff -Nru rmatrix-1.6-1.1/man/mat2triplet.Rd rmatrix-1.6-5/man/mat2triplet.Rd --- rmatrix-1.6-1.1/man/mat2triplet.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/mat2triplet.Rd 2023-08-30 06:03:42.000000000 +0000 @@ -21,7 +21,7 @@ package matrices.} \item{uniqT}{\code{\link{logical}} indicating if the triplet representation should be \sQuote{unique} in the sense of - \code{\link{uniqTsparse}()}.} + \code{\link{asUniqueT}(byrow=FALSE)}.} } \value{ A \code{\link{list}}, typically with three components, diff -Nru rmatrix-1.6-1.1/man/matrix-products.Rd rmatrix-1.6-5/man/matrix-products.Rd --- rmatrix-1.6-1.1/man/matrix-products.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/matrix-products.Rd 2023-09-11 06:28:46.000000000 +0000 @@ -13,146 +13,118 @@ \alias{tcrossprod} \alias{tcrossprod-methods} \alias{matmult-methods} -% `%*%` +% %*% \alias{\%*\%,ANY,Matrix-method} -\alias{\%*\%,ANY,TsparseMatrix-method} +\alias{\%*\%,ANY,sparseVector-method} \alias{\%*\%,CsparseMatrix,CsparseMatrix-method} -\alias{\%*\%,CsparseMatrix,ddenseMatrix-method} +\alias{\%*\%,CsparseMatrix,RsparseMatrix-method} +\alias{\%*\%,CsparseMatrix,TsparseMatrix-method} +\alias{\%*\%,CsparseMatrix,denseMatrix-method} \alias{\%*\%,CsparseMatrix,diagonalMatrix-method} \alias{\%*\%,CsparseMatrix,matrix-method} -\alias{\%*\%,CsparseMatrix,numLike-method} +\alias{\%*\%,CsparseMatrix,vector-method} \alias{\%*\%,Matrix,ANY-method} -\alias{\%*\%,Matrix,TsparseMatrix-method} \alias{\%*\%,Matrix,indMatrix-method} -\alias{\%*\%,Matrix,matrix-method} -\alias{\%*\%,Matrix,numLike-method} \alias{\%*\%,Matrix,pMatrix-method} +\alias{\%*\%,Matrix,sparseVector-method} +\alias{\%*\%,RsparseMatrix,CsparseMatrix-method} +\alias{\%*\%,RsparseMatrix,RsparseMatrix-method} +\alias{\%*\%,RsparseMatrix,TsparseMatrix-method} +\alias{\%*\%,RsparseMatrix,denseMatrix-method} \alias{\%*\%,RsparseMatrix,diagonalMatrix-method} -\alias{\%*\%,RsparseMatrix,mMatrix-method} -\alias{\%*\%,TsparseMatrix,ANY-method} -\alias{\%*\%,TsparseMatrix,Matrix-method} +\alias{\%*\%,RsparseMatrix,matrix-method} +\alias{\%*\%,RsparseMatrix,vector-method} +\alias{\%*\%,TsparseMatrix,CsparseMatrix-method} +\alias{\%*\%,TsparseMatrix,RsparseMatrix-method} \alias{\%*\%,TsparseMatrix,TsparseMatrix-method} +\alias{\%*\%,TsparseMatrix,denseMatrix-method} \alias{\%*\%,TsparseMatrix,diagonalMatrix-method} -\alias{\%*\%,dMatrix,lMatrix-method} -\alias{\%*\%,dMatrix,nMatrix-method} -\alias{\%*\%,ddenseMatrix,CsparseMatrix-method} -\alias{\%*\%,ddenseMatrix,ddenseMatrix-method} -\alias{\%*\%,ddenseMatrix,dsyMatrix-method} -\alias{\%*\%,ddenseMatrix,dtrMatrix-method} -\alias{\%*\%,ddenseMatrix,ldenseMatrix-method} -\alias{\%*\%,ddenseMatrix,matrix-method} -\alias{\%*\%,ddenseMatrix,ndenseMatrix-method} +\alias{\%*\%,TsparseMatrix,matrix-method} +\alias{\%*\%,TsparseMatrix,vector-method} +\alias{\%*\%,denseMatrix,CsparseMatrix-method} +\alias{\%*\%,denseMatrix,RsparseMatrix-method} +\alias{\%*\%,denseMatrix,TsparseMatrix-method} +\alias{\%*\%,denseMatrix,denseMatrix-method} \alias{\%*\%,denseMatrix,diagonalMatrix-method} -\alias{\%*\%,dgeMatrix,dgeMatrix-method} -\alias{\%*\%,dgeMatrix,dtpMatrix-method} -\alias{\%*\%,dgeMatrix,matrix-method} +\alias{\%*\%,denseMatrix,matrix-method} +\alias{\%*\%,denseMatrix,vector-method} \alias{\%*\%,diagonalMatrix,CsparseMatrix-method} \alias{\%*\%,diagonalMatrix,RsparseMatrix-method} \alias{\%*\%,diagonalMatrix,TsparseMatrix-method} \alias{\%*\%,diagonalMatrix,denseMatrix-method} \alias{\%*\%,diagonalMatrix,diagonalMatrix-method} \alias{\%*\%,diagonalMatrix,matrix-method} -\alias{\%*\%,dspMatrix,ddenseMatrix-method} -\alias{\%*\%,dspMatrix,matrix-method} -\alias{\%*\%,dsyMatrix,ddenseMatrix-method} -\alias{\%*\%,dsyMatrix,dsyMatrix-method} -\alias{\%*\%,dsyMatrix,matrix-method} -\alias{\%*\%,dtpMatrix,ddenseMatrix-method} -\alias{\%*\%,dtpMatrix,matrix-method} -\alias{\%*\%,dtrMatrix,ddenseMatrix-method} -\alias{\%*\%,dtrMatrix,dtrMatrix-method} -\alias{\%*\%,dtrMatrix,matrix-method} +\alias{\%*\%,diagonalMatrix,vector-method} \alias{\%*\%,indMatrix,Matrix-method} \alias{\%*\%,indMatrix,indMatrix-method} \alias{\%*\%,indMatrix,matrix-method} \alias{\%*\%,indMatrix,pMatrix-method} -\alias{\%*\%,lMatrix,dMatrix-method} -\alias{\%*\%,lMatrix,lMatrix-method} -\alias{\%*\%,lMatrix,nMatrix-method} -\alias{\%*\%,ldenseMatrix,ddenseMatrix-method} -\alias{\%*\%,ldenseMatrix,ldenseMatrix-method} -\alias{\%*\%,ldenseMatrix,lsparseMatrix-method} -\alias{\%*\%,ldenseMatrix,matrix-method} -\alias{\%*\%,ldenseMatrix,ndenseMatrix-method} -\alias{\%*\%,lsparseMatrix,ldenseMatrix-method} -\alias{\%*\%,lsparseMatrix,lsparseMatrix-method} -\alias{\%*\%,mMatrix,RsparseMatrix-method} -\alias{\%*\%,mMatrix,sparseVector-method} +\alias{\%*\%,indMatrix,vector-method} \alias{\%*\%,matrix,CsparseMatrix-method} -\alias{\%*\%,matrix,Matrix-method} -\alias{\%*\%,matrix,ddenseMatrix-method} -\alias{\%*\%,matrix,dgeMatrix-method} +\alias{\%*\%,matrix,RsparseMatrix-method} +\alias{\%*\%,matrix,TsparseMatrix-method} +\alias{\%*\%,matrix,denseMatrix-method} \alias{\%*\%,matrix,diagonalMatrix-method} -\alias{\%*\%,matrix,dsyMatrix-method} -\alias{\%*\%,matrix,dtpMatrix-method} -\alias{\%*\%,matrix,dtrMatrix-method} \alias{\%*\%,matrix,indMatrix-method} -\alias{\%*\%,matrix,ldenseMatrix-method} -\alias{\%*\%,matrix,ndenseMatrix-method} \alias{\%*\%,matrix,pMatrix-method} -\alias{\%*\%,matrix,sparseMatrix-method} -\alias{\%*\%,nMatrix,dMatrix-method} -\alias{\%*\%,nMatrix,lMatrix-method} -\alias{\%*\%,nMatrix,nMatrix-method} -\alias{\%*\%,ndenseMatrix,ddenseMatrix-method} -\alias{\%*\%,ndenseMatrix,ldenseMatrix-method} -\alias{\%*\%,ndenseMatrix,matrix-method} -\alias{\%*\%,ndenseMatrix,ndenseMatrix-method} -\alias{\%*\%,ndenseMatrix,nsparseMatrix-method} -\alias{\%*\%,nsparseMatrix,ndenseMatrix-method} -\alias{\%*\%,nsparseMatrix,nsparseMatrix-method} -\alias{\%*\%,numLike,CsparseMatrix-method} -\alias{\%*\%,numLike,Matrix-method} -\alias{\%*\%,numLike,sparseVector-method} +\alias{\%*\%,matrix,sparseVector-method} \alias{\%*\%,pMatrix,Matrix-method} \alias{\%*\%,pMatrix,indMatrix-method} \alias{\%*\%,pMatrix,matrix-method} \alias{\%*\%,pMatrix,pMatrix-method} -\alias{\%*\%,sparseMatrix,matrix-method} -\alias{\%*\%,sparseVector,mMatrix-method} -\alias{\%*\%,sparseVector,numLike-method} +\alias{\%*\%,pMatrix,vector-method} +\alias{\%*\%,sparseVector,ANY-method} +\alias{\%*\%,sparseVector,Matrix-method} +\alias{\%*\%,sparseVector,matrix-method} \alias{\%*\%,sparseVector,sparseVector-method} +\alias{\%*\%,sparseVector,vector-method} +\alias{\%*\%,vector,CsparseMatrix-method} +\alias{\%*\%,vector,RsparseMatrix-method} +\alias{\%*\%,vector,TsparseMatrix-method} +\alias{\%*\%,vector,denseMatrix-method} +\alias{\%*\%,vector,diagonalMatrix-method} +\alias{\%*\%,vector,indMatrix-method} +\alias{\%*\%,vector,pMatrix-method} +\alias{\%*\%,vector,sparseVector-method} % crossprod -\alias{crossprod,ANY,ANY-method} \alias{crossprod,ANY,Matrix-method} -\alias{crossprod,ANY,RsparseMatrix-method} -\alias{crossprod,ANY,TsparseMatrix-method} +\alias{crossprod,ANY,sparseVector-method} \alias{crossprod,CsparseMatrix,CsparseMatrix-method} -\alias{crossprod,CsparseMatrix,ddenseMatrix-method} +\alias{crossprod,CsparseMatrix,RsparseMatrix-method} +\alias{crossprod,CsparseMatrix,TsparseMatrix-method} +\alias{crossprod,CsparseMatrix,denseMatrix-method} \alias{crossprod,CsparseMatrix,diagonalMatrix-method} \alias{crossprod,CsparseMatrix,matrix-method} \alias{crossprod,CsparseMatrix,missing-method} -\alias{crossprod,CsparseMatrix,numLike-method} +\alias{crossprod,CsparseMatrix,vector-method} \alias{crossprod,Matrix,ANY-method} -\alias{crossprod,Matrix,Matrix-method} -\alias{crossprod,Matrix,TsparseMatrix-method} \alias{crossprod,Matrix,indMatrix-method} -\alias{crossprod,Matrix,matrix-method} -\alias{crossprod,Matrix,missing-method} -\alias{crossprod,Matrix,numLike-method} \alias{crossprod,Matrix,pMatrix-method} -\alias{crossprod,RsparseMatrix,ANY-method} +\alias{crossprod,Matrix,sparseVector-method} +\alias{crossprod,RsparseMatrix,CsparseMatrix-method} +\alias{crossprod,RsparseMatrix,RsparseMatrix-method} +\alias{crossprod,RsparseMatrix,TsparseMatrix-method} +\alias{crossprod,RsparseMatrix,denseMatrix-method} \alias{crossprod,RsparseMatrix,diagonalMatrix-method} -\alias{crossprod,RsparseMatrix,mMatrix-method} -\alias{crossprod,TsparseMatrix,ANY-method} -\alias{crossprod,TsparseMatrix,Matrix-method} +\alias{crossprod,RsparseMatrix,matrix-method} +\alias{crossprod,RsparseMatrix,missing-method} +\alias{crossprod,RsparseMatrix,vector-method} +\alias{crossprod,TsparseMatrix,CsparseMatrix-method} +\alias{crossprod,TsparseMatrix,RsparseMatrix-method} \alias{crossprod,TsparseMatrix,TsparseMatrix-method} +\alias{crossprod,TsparseMatrix,denseMatrix-method} \alias{crossprod,TsparseMatrix,diagonalMatrix-method} +\alias{crossprod,TsparseMatrix,matrix-method} \alias{crossprod,TsparseMatrix,missing-method} -\alias{crossprod,ddenseMatrix,CsparseMatrix-method} -\alias{crossprod,ddenseMatrix,ddenseMatrix-method} -\alias{crossprod,ddenseMatrix,dgCMatrix-method} -\alias{crossprod,ddenseMatrix,dsparseMatrix-method} -\alias{crossprod,ddenseMatrix,ldenseMatrix-method} -\alias{crossprod,ddenseMatrix,matrix-method} -\alias{crossprod,ddenseMatrix,missing-method} -\alias{crossprod,ddenseMatrix,ndenseMatrix-method} +\alias{crossprod,TsparseMatrix,vector-method} +\alias{crossprod,denseMatrix,CsparseMatrix-method} +\alias{crossprod,denseMatrix,RsparseMatrix-method} +\alias{crossprod,denseMatrix,TsparseMatrix-method} +\alias{crossprod,denseMatrix,denseMatrix-method} \alias{crossprod,denseMatrix,diagonalMatrix-method} -\alias{crossprod,dgCMatrix,dgeMatrix-method} -\alias{crossprod,dgeMatrix,dgeMatrix-method} -\alias{crossprod,dgeMatrix,matrix-method} -\alias{crossprod,dgeMatrix,missing-method} -\alias{crossprod,dgeMatrix,numLike-method} +\alias{crossprod,denseMatrix,matrix-method} +\alias{crossprod,denseMatrix,missing-method} +\alias{crossprod,denseMatrix,vector-method} \alias{crossprod,diagonalMatrix,CsparseMatrix-method} \alias{crossprod,diagonalMatrix,RsparseMatrix-method} \alias{crossprod,diagonalMatrix,TsparseMatrix-method} @@ -160,96 +132,73 @@ \alias{crossprod,diagonalMatrix,diagonalMatrix-method} \alias{crossprod,diagonalMatrix,matrix-method} \alias{crossprod,diagonalMatrix,missing-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,diagonalMatrix,vector-method} \alias{crossprod,indMatrix,Matrix-method} \alias{crossprod,indMatrix,matrix-method} \alias{crossprod,indMatrix,missing-method} -\alias{crossprod,ldenseMatrix,ddenseMatrix-method} -\alias{crossprod,ldenseMatrix,ldenseMatrix-method} -\alias{crossprod,ldenseMatrix,lsparseMatrix-method} -\alias{crossprod,ldenseMatrix,matrix-method} -\alias{crossprod,ldenseMatrix,missing-method} -\alias{crossprod,ldenseMatrix,ndenseMatrix-method} -\alias{crossprod,lsparseMatrix,ldenseMatrix-method} -\alias{crossprod,lsparseMatrix,lsparseMatrix-method} -\alias{crossprod,mMatrix,RsparseMatrix-method} -\alias{crossprod,mMatrix,sparseVector-method} +\alias{crossprod,indMatrix,vector-method} \alias{crossprod,matrix,CsparseMatrix-method} -\alias{crossprod,matrix,Matrix-method} -\alias{crossprod,matrix,dgeMatrix-method} +\alias{crossprod,matrix,RsparseMatrix-method} +\alias{crossprod,matrix,TsparseMatrix-method} +\alias{crossprod,matrix,denseMatrix-method} \alias{crossprod,matrix,diagonalMatrix-method} -\alias{crossprod,matrix,dtrMatrix-method} \alias{crossprod,matrix,indMatrix-method} \alias{crossprod,matrix,pMatrix-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} -\alias{crossprod,ndenseMatrix,nsparseMatrix-method} -\alias{crossprod,nsparseMatrix,ndenseMatrix-method} -\alias{crossprod,nsparseMatrix,nsparseMatrix-method} -\alias{crossprod,numLike,CsparseMatrix-method} -\alias{crossprod,numLike,Matrix-method} -\alias{crossprod,numLike,dgeMatrix-method} -\alias{crossprod,numLike,sparseVector-method} +\alias{crossprod,matrix,sparseVector-method} \alias{crossprod,pMatrix,missing-method} -\alias{crossprod,sparseVector,mMatrix-method} +\alias{crossprod,pMatrix,pMatrix-method} +\alias{crossprod,sparseVector,ANY-method} +\alias{crossprod,sparseVector,Matrix-method} +\alias{crossprod,sparseVector,matrix-method} \alias{crossprod,sparseVector,missing-method} -\alias{crossprod,sparseVector,numLike-method} \alias{crossprod,sparseVector,sparseVector-method} -\alias{crossprod,symmetricMatrix,ANY-method} -\alias{crossprod,symmetricMatrix,Matrix-method} -\alias{crossprod,symmetricMatrix,missing-method} +\alias{crossprod,sparseVector,vector-method} +\alias{crossprod,vector,CsparseMatrix-method} +\alias{crossprod,vector,RsparseMatrix-method} +\alias{crossprod,vector,TsparseMatrix-method} +\alias{crossprod,vector,denseMatrix-method} +\alias{crossprod,vector,diagonalMatrix-method} +\alias{crossprod,vector,indMatrix-method} +\alias{crossprod,vector,pMatrix-method} +\alias{crossprod,vector,sparseVector-method} % tcrossprod -\alias{tcrossprod,ANY,ANY-method} \alias{tcrossprod,ANY,Matrix-method} -\alias{tcrossprod,ANY,RsparseMatrix-method} -\alias{tcrossprod,ANY,TsparseMatrix-method} -\alias{tcrossprod,ANY,symmetricMatrix-method} +\alias{tcrossprod,ANY,sparseVector-method} \alias{tcrossprod,CsparseMatrix,CsparseMatrix-method} -\alias{tcrossprod,CsparseMatrix,ddenseMatrix-method} +\alias{tcrossprod,CsparseMatrix,RsparseMatrix-method} +\alias{tcrossprod,CsparseMatrix,TsparseMatrix-method} +\alias{tcrossprod,CsparseMatrix,denseMatrix-method} \alias{tcrossprod,CsparseMatrix,diagonalMatrix-method} \alias{tcrossprod,CsparseMatrix,matrix-method} \alias{tcrossprod,CsparseMatrix,missing-method} -\alias{tcrossprod,CsparseMatrix,numLike-method} +\alias{tcrossprod,CsparseMatrix,vector-method} \alias{tcrossprod,Matrix,ANY-method} -\alias{tcrossprod,Matrix,Matrix-method} -\alias{tcrossprod,Matrix,TsparseMatrix-method} \alias{tcrossprod,Matrix,indMatrix-method} -\alias{tcrossprod,Matrix,matrix-method} -\alias{tcrossprod,Matrix,missing-method} -\alias{tcrossprod,Matrix,numLike-method} -\alias{tcrossprod,Matrix,symmetricMatrix-method} -\alias{tcrossprod,RsparseMatrix,ANY-method} +\alias{tcrossprod,Matrix,sparseVector-method} +\alias{tcrossprod,RsparseMatrix,CsparseMatrix-method} +\alias{tcrossprod,RsparseMatrix,RsparseMatrix-method} +\alias{tcrossprod,RsparseMatrix,TsparseMatrix-method} +\alias{tcrossprod,RsparseMatrix,denseMatrix-method} \alias{tcrossprod,RsparseMatrix,diagonalMatrix-method} -\alias{tcrossprod,RsparseMatrix,mMatrix-method} -\alias{tcrossprod,TsparseMatrix,ANY-method} -\alias{tcrossprod,TsparseMatrix,Matrix-method} +\alias{tcrossprod,RsparseMatrix,matrix-method} +\alias{tcrossprod,RsparseMatrix,missing-method} +\alias{tcrossprod,RsparseMatrix,vector-method} +\alias{tcrossprod,TsparseMatrix,CsparseMatrix-method} +\alias{tcrossprod,TsparseMatrix,RsparseMatrix-method} \alias{tcrossprod,TsparseMatrix,TsparseMatrix-method} +\alias{tcrossprod,TsparseMatrix,denseMatrix-method} \alias{tcrossprod,TsparseMatrix,diagonalMatrix-method} +\alias{tcrossprod,TsparseMatrix,matrix-method} \alias{tcrossprod,TsparseMatrix,missing-method} -\alias{tcrossprod,ddenseMatrix,CsparseMatrix-method} -\alias{tcrossprod,ddenseMatrix,ddenseMatrix-method} -\alias{tcrossprod,ddenseMatrix,dsCMatrix-method} -\alias{tcrossprod,ddenseMatrix,dtrMatrix-method} -\alias{tcrossprod,ddenseMatrix,ldenseMatrix-method} -\alias{tcrossprod,ddenseMatrix,lsCMatrix-method} -\alias{tcrossprod,ddenseMatrix,matrix-method} -\alias{tcrossprod,ddenseMatrix,missing-method} -\alias{tcrossprod,ddenseMatrix,ndenseMatrix-method} -\alias{tcrossprod,ddenseMatrix,nsCMatrix-method} +\alias{tcrossprod,TsparseMatrix,vector-method} +\alias{tcrossprod,denseMatrix,CsparseMatrix-method} +\alias{tcrossprod,denseMatrix,RsparseMatrix-method} +\alias{tcrossprod,denseMatrix,TsparseMatrix-method} +\alias{tcrossprod,denseMatrix,denseMatrix-method} \alias{tcrossprod,denseMatrix,diagonalMatrix-method} -\alias{tcrossprod,dgeMatrix,dgeMatrix-method} -\alias{tcrossprod,dgeMatrix,matrix-method} -\alias{tcrossprod,dgeMatrix,missing-method} -\alias{tcrossprod,dgeMatrix,numLike-method} +\alias{tcrossprod,denseMatrix,matrix-method} +\alias{tcrossprod,denseMatrix,missing-method} +\alias{tcrossprod,denseMatrix,vector-method} \alias{tcrossprod,diagonalMatrix,CsparseMatrix-method} \alias{tcrossprod,diagonalMatrix,RsparseMatrix-method} \alias{tcrossprod,diagonalMatrix,TsparseMatrix-method} @@ -257,44 +206,36 @@ \alias{tcrossprod,diagonalMatrix,diagonalMatrix-method} \alias{tcrossprod,diagonalMatrix,matrix-method} \alias{tcrossprod,diagonalMatrix,missing-method} -\alias{tcrossprod,dtrMatrix,dtrMatrix-method} +\alias{tcrossprod,diagonalMatrix,vector-method} \alias{tcrossprod,indMatrix,Matrix-method} \alias{tcrossprod,indMatrix,matrix-method} \alias{tcrossprod,indMatrix,missing-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,mMatrix,RsparseMatrix-method} -\alias{tcrossprod,mMatrix,sparseVector-method} +\alias{tcrossprod,indMatrix,vector-method} \alias{tcrossprod,matrix,CsparseMatrix-method} -\alias{tcrossprod,matrix,Matrix-method} -\alias{tcrossprod,matrix,dgeMatrix-method} +\alias{tcrossprod,matrix,RsparseMatrix-method} +\alias{tcrossprod,matrix,TsparseMatrix-method} +\alias{tcrossprod,matrix,denseMatrix-method} \alias{tcrossprod,matrix,diagonalMatrix-method} -\alias{tcrossprod,matrix,dsCMatrix-method} -\alias{tcrossprod,matrix,dtrMatrix-method} \alias{tcrossprod,matrix,indMatrix-method} -\alias{tcrossprod,matrix,lsCMatrix-method} -\alias{tcrossprod,matrix,nsCMatrix-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} -\alias{tcrossprod,numLike,CsparseMatrix-method} -\alias{tcrossprod,numLike,Matrix-method} -\alias{tcrossprod,numLike,dgeMatrix-method} -\alias{tcrossprod,numLike,sparseVector-method} +\alias{tcrossprod,matrix,sparseVector-method} \alias{tcrossprod,pMatrix,Matrix-method} \alias{tcrossprod,pMatrix,matrix-method} \alias{tcrossprod,pMatrix,missing-method} -\alias{tcrossprod,sparseMatrix,sparseVector-method} -\alias{tcrossprod,sparseVector,mMatrix-method} +\alias{tcrossprod,pMatrix,pMatrix-method} +\alias{tcrossprod,pMatrix,vector-method} +\alias{tcrossprod,sparseVector,ANY-method} +\alias{tcrossprod,sparseVector,Matrix-method} +\alias{tcrossprod,sparseVector,matrix-method} \alias{tcrossprod,sparseVector,missing-method} -\alias{tcrossprod,sparseVector,numLike-method} -\alias{tcrossprod,sparseVector,sparseMatrix-method} \alias{tcrossprod,sparseVector,sparseVector-method} +\alias{tcrossprod,sparseVector,vector-method} +\alias{tcrossprod,vector,CsparseMatrix-method} +\alias{tcrossprod,vector,RsparseMatrix-method} +\alias{tcrossprod,vector,TsparseMatrix-method} +\alias{tcrossprod,vector,denseMatrix-method} +\alias{tcrossprod,vector,diagonalMatrix-method} +\alias{tcrossprod,vector,indMatrix-method} +\alias{tcrossprod,vector,sparseVector-method} % \description{ The basic matrix product, \code{\%*\%} is implemented for all our @@ -320,11 +261,9 @@ \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 } diff -Nru rmatrix-1.6-1.1/man/nMatrix-class.Rd rmatrix-1.6-5/man/nMatrix-class.Rd --- rmatrix-1.6-1.1/man/nMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/nMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -28,7 +28,6 @@ \alias{Ops,nMatrix,nMatrix-method} \alias{Ops,nMatrix,numeric-method} \alias{Ops,numeric,nMatrix-method} -\alias{Summary,nMatrix-method} \alias{coerce,matrix,nMatrix-method} \alias{coerce,vector,nMatrix-method} % diff -Nru rmatrix-1.6-1.1/man/ndenseMatrix-class.Rd rmatrix-1.6-5/man/ndenseMatrix-class.Rd --- rmatrix-1.6-1.1/man/ndenseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ndenseMatrix-class.Rd 2023-09-14 17:58:48.000000000 +0000 @@ -7,14 +7,17 @@ % \alias{ndenseMatrix-class} % +\alias{!,ndenseMatrix-method} \alias{&,ndenseMatrix,ddiMatrix-method} \alias{&,ndenseMatrix,ldiMatrix-method} +\alias{&,ndenseMatrix,ndiMatrix-method} \alias{*,ndenseMatrix,ddiMatrix-method} \alias{*,ndenseMatrix,ldiMatrix-method} +\alias{*,ndenseMatrix,ndiMatrix-method} \alias{Ops,ndenseMatrix,ndenseMatrix-method} -\alias{Summary,ndenseMatrix-method} \alias{^,ndenseMatrix,ddiMatrix-method} \alias{^,ndenseMatrix,ldiMatrix-method} +\alias{^,ndenseMatrix,ndiMatrix-method} \alias{coerce,matrix,ndenseMatrix-method} \alias{coerce,vector,ndenseMatrix-method} \alias{which,ndenseMatrix-method} diff -Nru rmatrix-1.6-1.1/man/ngeMatrix-class.Rd rmatrix-1.6-5/man/ngeMatrix-class.Rd --- rmatrix-1.6-1.1/man/ngeMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/ngeMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -7,7 +7,6 @@ % \alias{ngeMatrix-class} % -\alias{!,ngeMatrix-method} \alias{Arith,ngeMatrix,ngeMatrix-method} \alias{Compare,ngeMatrix,ngeMatrix-method} \alias{Logic,ngeMatrix,ngeMatrix-method} diff -Nru rmatrix-1.6-1.1/man/nnzero.Rd rmatrix-1.6-5/man/nnzero.Rd --- rmatrix-1.6-1.1/man/nnzero.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/nnzero.Rd 2023-08-18 05:02:52.000000000 +0000 @@ -11,7 +11,6 @@ % \alias{nnzero,ANY-method} \alias{nnzero,CHMfactor-method} -\alias{nnzero,array-method} \alias{nnzero,denseMatrix-method} \alias{nnzero,diagonalMatrix-method} \alias{nnzero,indMatrix-method} diff -Nru rmatrix-1.6-1.1/man/norm.Rd rmatrix-1.6-5/man/norm.Rd --- rmatrix-1.6-1.1/man/norm.Rd 2023-06-01 15:12:16.000000000 +0000 +++ rmatrix-1.6-5/man/norm.Rd 2023-11-01 21:59:30.000000000 +0000 @@ -11,12 +11,7 @@ % \alias{norm,ANY,missing-method} \alias{norm,denseMatrix,character-method} -\alias{norm,dgeMatrix,character-method} \alias{norm,diagonalMatrix,character-method} -\alias{norm,dspMatrix,character-method} -\alias{norm,dsyMatrix,character-method} -\alias{norm,dtpMatrix,character-method} -\alias{norm,dtrMatrix,character-method} \alias{norm,indMatrix,character-method} \alias{norm,pMatrix,character-method} \alias{norm,sparseMatrix,character-method} @@ -47,7 +42,7 @@ 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 + \item{\code{"2"}}{specifies the \dQuote{spectral norm} aka \dQuote{2-norm}, which is the largest singular value (\code{\link{svd}}) of \code{x}.} } The default is \code{"O"}. Only the first character of @@ -81,8 +76,11 @@ 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 <- function(x) { + ## norm(NA, "2") did not work until R 4.0.0 + do2 <- getRversion() >= "4.0.0" || !anyNA(x) + vapply(c("1", "I", "F", "M", if(do2) "2"), norm, 0, x = x) +} allnorms(x) allnorms(Hilbert(10)) diff -Nru rmatrix-1.6-1.1/man/nsyMatrix-class.Rd rmatrix-1.6-5/man/nsyMatrix-class.Rd --- rmatrix-1.6-1.1/man/nsyMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/nsyMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -8,10 +8,6 @@ \alias{nsyMatrix-class} \alias{nspMatrix-class} % -\alias{!,nsyMatrix-method} -% -\alias{!,nspMatrix-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 diff -Nru rmatrix-1.6-1.1/man/ntrMatrix-class.Rd rmatrix-1.6-5/man/ntrMatrix-class.Rd --- rmatrix-1.6-1.1/man/ntrMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/ntrMatrix-class.Rd 2023-08-17 22:20:59.000000000 +0000 @@ -8,10 +8,6 @@ \alias{ntrMatrix-class} \alias{ntpMatrix-class} % -\alias{!,ntrMatrix-method} -% -\alias{!,ntpMatrix-method} -% \description{ The \code{"ntrMatrix"} class is the class of triangular, dense, logical matrices in nonpacked storage. The \code{"ntpMatrix"} class diff -Nru rmatrix-1.6-1.1/man/pMatrix-class.Rd rmatrix-1.6-5/man/pMatrix-class.Rd --- rmatrix-1.6-1.1/man/pMatrix-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/pMatrix-class.Rd 2024-01-03 16:12:15.000000000 +0000 @@ -37,7 +37,7 @@ \item{\code{margin},\code{perm}}{inherited from superclass \code{\linkS4class{indMatrix}}. Here, \code{perm} is an integer vector of length \code{Dim[1]} and a permutation - of \code{1:Dim[1]}}. + of \code{1:Dim[1]}.} \item{\code{Dim},\code{Dimnames}}{inherited from virtual superclass \code{\linkS4class{Matrix}}.} } diff -Nru rmatrix-1.6-1.1/man/packedMatrix-class.Rd rmatrix-1.6-5/man/packedMatrix-class.Rd --- rmatrix-1.6-1.1/man/packedMatrix-class.Rd 2023-04-28 21:23:45.000000000 +0000 +++ rmatrix-1.6-5/man/packedMatrix-class.Rd 2023-09-09 00:05:48.000000000 +0000 @@ -9,9 +9,6 @@ % \alias{coerce,matrix,packedMatrix-method} \alias{cov2cor,packedMatrix-method} -\alias{diag,packedMatrix-method} -\alias{diag<-,packedMatrix-method} -\alias{t,packedMatrix-method} % \description{ Class \code{"packedMatrix"} is the \emph{virtual} class of dense @@ -36,7 +33,6 @@ Class \code{"\linkS4class{denseMatrix}"}, directly. Class \code{"\linkS4class{Matrix}"}, by class \code{"denseMatrix"}, distance 2. - Class \code{"mMatrix"}, by class \code{"Matrix"}, distance 3. Class \code{"replValueSp"}, by class \code{"Matrix"}, distance 3. } \section{Methods}{ diff -Nru rmatrix-1.6-1.1/man/qr-methods.Rd rmatrix-1.6-5/man/qr-methods.Rd --- rmatrix-1.6-1.1/man/qr-methods.Rd 2023-07-03 13:19:07.000000000 +0000 +++ rmatrix-1.6-5/man/qr-methods.Rd 2023-11-01 21:39:04.000000000 +0000 @@ -67,8 +67,7 @@ \eqn{(n-r)} rows of (partly non-structural) zeros, such that the augmented matrix has structural rank \eqn{n}. This augmented matrix is factorized as described above: - \deqn{P_1 A P_2 = P_1 \begin{bmatrix} A_{0} \\ 0 \end{bmatrix} P_2 = Q R}{% - P1 * A * P2 = P1 * [A0; 0] * P2 = Q * R} + \Sdeqn{P_1 A P_2 = P_1 \\\\\\\\begin{bmatrix} A_{0} \\\\\\\\\\\\\\\\ 0 \\\\\\\\end{bmatrix} P_2 = Q R}{P1 * A * P2 = P1 * [A0; 0] * P2 = Q * R} where \eqn{A_0}{A0} denotes the original, user-supplied \eqn{(m-(n-r)) \times n}{(m-(n-r))-by-n} matrix. } @@ -123,7 +122,7 @@ stopifnot(exprs = { rankMatrix(A1) == ncol(A1) - { d1 <- diag(qr.A1@R); sum(d1 < max(d1) * eps) == 0L } + { d1 <- abs(diag(qr.A1@R)); sum(d1 < max(d1) * eps) == 0L } rcond(crossprod(A1)) >= eps all.equal(qr.coef(qr.A1, b), drop(solve(crossprod(A1), crossprod(A1, b)))) all.equal(qr.fitted(qr.A1, b) + qr.resid(qr.A1, b), b) @@ -138,7 +137,7 @@ stopifnot(exprs = { rankMatrix(A2) == ncol(A2) - 2L - { d2 <- diag(qr.A2@R); sum(d2 < max(d2) * eps) == 2L } + { d2 <- abs(diag(qr.A2@R)); sum(d2 < max(d2) * eps) == 2L } rcond(crossprod(A2)) < eps ## 'qr.coef' computes unique least squares solution of "nearby" problem @@ -167,7 +166,7 @@ ## The augmented matrix remains numerically rank deficient rankMatrix(A3) == ncol(A3) - 2L - { d3 <- diag(qr.A3@R); sum(d3 < max(d3) * eps) == 2L } + { d3 <- abs(diag(qr.A3@R)); sum(d3 < max(d3) * eps) == 2L } rcond(crossprod(A3)) < eps }) diff -Nru rmatrix-1.6-1.1/man/rankMatrix.Rd rmatrix-1.6-5/man/rankMatrix.Rd --- rmatrix-1.6-1.1/man/rankMatrix.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/rankMatrix.Rd 2023-10-25 15:50:21.000000000 +0000 @@ -90,9 +90,8 @@ \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. + \item{do.warn}{logical; if true, warn about non-finite diagonal + entries in the \eqn{R} matrix of the \eqn{QR} decomposition. Do not change lightly!} } \details{ diff -Nru rmatrix-1.6-1.1/man/rcond.Rd rmatrix-1.6-5/man/rcond.Rd --- rmatrix-1.6-1.1/man/rcond.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/rcond.Rd 2023-09-20 19:22:09.000000000 +0000 @@ -11,14 +11,7 @@ % \alias{rcond,ANY,missing-method} \alias{rcond,denseMatrix,character-method} -\alias{rcond,dgeMatrix,character-method} \alias{rcond,diagonalMatrix,character-method} -\alias{rcond,dpoMatrix,character-method} -\alias{rcond,dppMatrix,character-method} -\alias{rcond,dspMatrix,character-method} -\alias{rcond,dsyMatrix,character-method} -\alias{rcond,dtpMatrix,character-method} -\alias{rcond,dtrMatrix,character-method} \alias{rcond,indMatrix,character-method} \alias{rcond,pMatrix,character-method} \alias{rcond,sparseMatrix,character-method} diff -Nru rmatrix-1.6-1.1/man/solve-methods.Rd rmatrix-1.6-5/man/solve-methods.Rd --- rmatrix-1.6-1.1/man/solve-methods.Rd 2023-06-06 17:29:19.000000000 +0000 +++ rmatrix-1.6-5/man/solve-methods.Rd 2023-08-18 05:02:52.000000000 +0000 @@ -28,23 +28,23 @@ \alias{solve,MatrixFactorization,diagonalMatrix-method} \alias{solve,MatrixFactorization,indMatrix-method} \alias{solve,MatrixFactorization,matrix-method} -\alias{solve,MatrixFactorization,numLike-method} \alias{solve,MatrixFactorization,sparseVector-method} +\alias{solve,MatrixFactorization,vector-method} \alias{solve,RsparseMatrix,ANY-method} \alias{solve,Schur,ANY-method} \alias{solve,TsparseMatrix,ANY-method} \alias{solve,ddiMatrix,Matrix-method} \alias{solve,ddiMatrix,matrix-method} \alias{solve,ddiMatrix,missing-method} -\alias{solve,ddiMatrix,numLike-method} +\alias{solve,ddiMatrix,vector-method} \alias{solve,denseLU,missing-method} \alias{solve,denseLU,dgeMatrix-method} \alias{solve,denseMatrix,ANY-method} \alias{solve,dgCMatrix,denseMatrix-method} \alias{solve,dgCMatrix,matrix-method} \alias{solve,dgCMatrix,missing-method} -\alias{solve,dgCMatrix,numLike-method} \alias{solve,dgCMatrix,sparseMatrix-method} +\alias{solve,dgCMatrix,vector-method} \alias{solve,dgeMatrix,ANY-method} \alias{solve,diagonalMatrix,ANY-method} \alias{solve,dpoMatrix,ANY-method} @@ -52,8 +52,8 @@ \alias{solve,dsCMatrix,denseMatrix-method} \alias{solve,dsCMatrix,matrix-method} \alias{solve,dsCMatrix,missing-method} -\alias{solve,dsCMatrix,numLike-method} \alias{solve,dsCMatrix,sparseMatrix-method} +\alias{solve,dsCMatrix,vector-method} \alias{solve,dspMatrix,ANY-method} \alias{solve,dsyMatrix,ANY-method} \alias{solve,dtCMatrix,dgCMatrix-method} @@ -76,7 +76,7 @@ \alias{solve,pMatrix,Matrix-method} \alias{solve,pMatrix,matrix-method} \alias{solve,pMatrix,missing-method} -\alias{solve,pMatrix,numLike-method} +\alias{solve,pMatrix,vector-method} \alias{solve,sparseLU,missing-method} \alias{solve,sparseLU,dgeMatrix-method} \alias{solve,sparseLU,dgCMatrix-method} @@ -92,7 +92,7 @@ \alias{solve,triangularMatrix,diagonalMatrix-method} \alias{solve,triangularMatrix,indMatrix-method} \alias{solve,triangularMatrix,matrix-method} -\alias{solve,triangularMatrix,numLike-method} +\alias{solve,triangularMatrix,vector-method} % \description{ Methods for generic function \code{\link[base]{solve}} for solving @@ -200,7 +200,7 @@ Methods for \code{a} inheriting from \code{\linkS4class{CHMfactor}} can solve systems other than the default one \eqn{A X = B}{A * X = B}. - The correspondance between its \code{system} argument the system + The correspondence between its \code{system} argument the system actually solved is outlined in the table below. See \code{\link{CHMfactor-class}} for a definition of notation. diff -Nru rmatrix-1.6-1.1/man/spMatrix.Rd rmatrix-1.6-5/man/spMatrix.Rd --- rmatrix-1.6-1.1/man/spMatrix.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/spMatrix.Rd 2023-08-16 04:20:26.000000000 +0000 @@ -14,7 +14,7 @@ somewhat \emph{deprecated}. } \usage{ -spMatrix(nrow, ncol, i = integer(), j = integer(), x = double()) +spMatrix(nrow, ncol, i = integer(0L), j = integer(0L), x = double(0L)) } \arguments{ \item{nrow, ncol}{integers specifying the desired number of rows and diff -Nru rmatrix-1.6-1.1/man/sparseMatrix-class.Rd rmatrix-1.6-5/man/sparseMatrix-class.Rd --- rmatrix-1.6-1.1/man/sparseMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/sparseMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -15,11 +15,13 @@ \alias{Ops,sparseMatrix,nsparseMatrix-method} \alias{Ops,sparseMatrix,numeric-method} \alias{Ops,sparseMatrix,sparseMatrix-method} +\alias{Summary,sparseMatrix-method} \alias{coerce,ANY,sparseMatrix-method} \alias{coerce,factor,sparseMatrix-method} \alias{coerce,matrix,sparseMatrix-method} \alias{coerce,vector,sparseMatrix-method} \alias{cov2cor,sparseMatrix-method} +\alias{diff,sparseMatrix-method} \alias{dim<-,sparseMatrix-method} \alias{format,sparseMatrix-method} \alias{log,sparseMatrix-method} diff -Nru rmatrix-1.6-1.1/man/sparseQR-class.Rd rmatrix-1.6-5/man/sparseQR-class.Rd --- rmatrix-1.6-1.1/man/sparseQR-class.Rd 2023-07-03 13:19:07.000000000 +0000 +++ rmatrix-1.6-5/man/sparseQR-class.Rd 2023-11-01 21:39:04.000000000 +0000 @@ -16,23 +16,23 @@ \alias{qr.coef,sparseQR,Matrix-method} \alias{qr.coef,sparseQR,dgeMatrix-method} \alias{qr.coef,sparseQR,matrix-method} -\alias{qr.coef,sparseQR,numLike-method} +\alias{qr.coef,sparseQR,vector-method} \alias{qr.fitted,sparseQR,Matrix-method} \alias{qr.fitted,sparseQR,dgeMatrix-method} \alias{qr.fitted,sparseQR,matrix-method} -\alias{qr.fitted,sparseQR,numLike-method} +\alias{qr.fitted,sparseQR,vector-method} \alias{qr.qty,sparseQR,Matrix-method} \alias{qr.qty,sparseQR,dgeMatrix-method} \alias{qr.qty,sparseQR,matrix-method} -\alias{qr.qty,sparseQR,numLike-method} +\alias{qr.qty,sparseQR,vector-method} \alias{qr.qy,sparseQR,Matrix-method} \alias{qr.qy,sparseQR,dgeMatrix-method} \alias{qr.qy,sparseQR,matrix-method} -\alias{qr.qy,sparseQR,numLike-method} +\alias{qr.qy,sparseQR,vector-method} \alias{qr.resid,sparseQR,Matrix-method} \alias{qr.resid,sparseQR,dgeMatrix-method} \alias{qr.resid,sparseQR,matrix-method} -\alias{qr.resid,sparseQR,numLike-method} +\alias{qr.resid,sparseQR,vector-method} % \alias{qrR} % @@ -40,13 +40,9 @@ \code{sparseQR} is the class of sparse, row- and column-pivoted QR factorizations of \eqn{m \times n}{m-by-n} (\eqn{m \ge n}{m >= n}) real matrices, having the general form - \deqn{P_1 A P_2 = Q R = \begin{bmatrix} Q_1 & Q_2 \end{bmatrix} - \begin{bmatrix} R_1 \\ 0 \end{bmatrix} = Q_1 R_1}{% - P1 * A * P2 = Q * R = [Q1, Q2] * [R1; 0] = Q1 * R1} + \Sdeqn{P_1 A P_2 = Q R = \\\\\\\\begin{bmatrix} Q_1 & Q_2 \\\\\\\\end{bmatrix} \\\\\\\\begin{bmatrix} R_1 \\\\\\\\\\\\\\\\ 0 \\\\\\\\end{bmatrix} = Q_1 R_1}{P1 * A * P2 = Q * R = [Q1, Q2] * [R1; 0] = Q1 * R1} or (equivalently) - \deqn{A = P_1' Q R P_2' = P_1' \begin{bmatrix} Q_1 & Q_2 \end{bmatrix} - \begin{bmatrix} R_1 \\ 0 \end{bmatrix} P_2' = P_1' Q_1 R_1 P_2'}{% - A = P1' * Q * R * P2' = P1' * [Q1, Q2] * [R1; 0] * P2' = P1' * Q1 * R1 * P2'} + \Sdeqn{A = P_1' Q R P_2' = P_1' \\\\\\\\begin{bmatrix} Q_1 & Q_2 \\\\\\\\end{bmatrix} \\\\\\\\begin{bmatrix} R_1 \\\\\\\\\\\\\\\\ 0 \\\\\\\\end{bmatrix} P_2' = P_1' Q_1 R_1 P_2'}{A = P1' * Q * R * P2' = P1' * [Q1, Q2] * [R1; 0] * P2' = P1' * Q1 * R1 * P2'} where \eqn{P_1}{P1} and \eqn{P_2}{P2} are permutation matrices, \eqn{Q = \prod_{j = 1}^{n} H_j}{Q = prod(Hj : j = 1,...,n)} @@ -55,7 +51,7 @@ equal to the product of \eqn{n} Householder matrices \eqn{H_j}{Hj}, and \eqn{R} is an \eqn{m \times n}{m-by-n} upper trapezoidal matrix (\eqn{R_1}{R1} contains the first \eqn{n} row vectors and is - upper \emph{triangular}) with non-negative diagonal elements. + upper \emph{triangular}). } \usage{ qrR(qr, complete = FALSE, backPermute = TRUE, row.names = TRUE) @@ -87,8 +83,7 @@ \code{diag(Dim[1]) - beta[j] * tcrossprod(V[, j])}.} \item{\code{R}}{an object of class \code{\linkS4class{dgCMatrix}} with \code{nrow(V)} rows and \code{Dim[2]} columns. - \code{R} is the upper trapezoidal \eqn{R} factor with - non-negative diagonal elements.} + \code{R} is the upper trapezoidal \eqn{R} factor.} \item{\code{p}, \code{q}}{0-based integer vectors of length \code{nrow(V)} and \code{Dim[2]}, respectively, specifying the permutations applied to the rows and columns of diff -Nru rmatrix-1.6-1.1/man/sparseVector-class.Rd rmatrix-1.6-5/man/sparseVector-class.Rd --- rmatrix-1.6-1.1/man/sparseVector-class.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/sparseVector-class.Rd 2023-09-13 23:51:33.000000000 +0000 @@ -11,7 +11,6 @@ \alias{isparseVector-class} \alias{dsparseVector-class} \alias{zsparseVector-class} -\alias{xsparseVector-class} % sparse \alias{!,sparseVector-method} \alias{Arith,sparseVector,ddenseMatrix-method} @@ -29,24 +28,35 @@ \alias{Ops,sparseVector,atomicVector-method} \alias{Ops,sparseVector,sparseVector-method} \alias{Summary,sparseVector-method} +\alias{as.array,sparseVector-method} +\alias{as.complex,sparseVector-method} +\alias{as.integer,sparseVector-method} \alias{as.logical,sparseVector-method} +\alias{as.matrix,sparseVector-method} \alias{as.numeric,sparseVector-method} \alias{as.vector,sparseVector-method} \alias{coerce,ANY,sparseVector-method} +\alias{coerce,matrix,sparseVector-method} \alias{coerce,sparseVector,CsparseMatrix-method} \alias{coerce,sparseVector,Matrix-method} \alias{coerce,sparseVector,RsparseMatrix-method} \alias{coerce,sparseVector,TsparseMatrix-method} +\alias{coerce,sparseVector,denseMatrix-method} \alias{coerce,sparseVector,dsparseVector-method} -\alias{coerce,sparseVector,integer-method} +\alias{coerce,sparseVector,generalMatrix-method} \alias{coerce,sparseVector,isparseVector-method} -\alias{coerce,sparseVector,logical-method} \alias{coerce,sparseVector,lsparseVector-method} \alias{coerce,sparseVector,nsparseVector-method} -\alias{coerce,sparseVector,numeric-method} \alias{coerce,sparseVector,sparseMatrix-method} -\alias{coerce,sparseVector,vector-method} +\alias{coerce,sparseVector,unpackedMatrix-method} \alias{coerce,sparseVector,zsparseVector-method} +\alias{coerce,vector,dsparseVector-method} +\alias{coerce,vector,isparseVector-method} +\alias{coerce,vector,lsparseVector-method} +\alias{coerce,vector,nsparseVector-method} +\alias{coerce,vector,sparseVector-method} +\alias{coerce,vector,zsparseVector-method} +\alias{diff,sparseVector-method} \alias{dim<-,sparseVector-method} \alias{head,sparseVector-method} \alias{initialize,sparseVector-method} @@ -55,25 +65,22 @@ \alias{mean,sparseVector-method} \alias{rep,sparseVector-method} \alias{show,sparseVector-method} +\alias{sort,sparseVector-method} \alias{t,sparseVector-method} \alias{tail,sparseVector-method} \alias{toeplitz,sparseVector-method} +\alias{zapsmall,sparseVector-method} % nsparse -\alias{Summary,nsparseVector-method} -\alias{coerce,ANY,nsparseVector-method} -\alias{coerce,nsparseVector,dsparseVector-method} -\alias{coerce,nsparseVector,isparseVector-method} -\alias{coerce,nsparseVector,lsparseVector-method} -\alias{coerce,nsparseVector,zsparseVector-method} +\alias{!,nsparseVector-method} \alias{which,nsparseVector-method} % lsparse +\alias{!,lsparseVector-method} \alias{Logic,lsparseVector,lsparseVector-method} \alias{which,lsparseVector-method} % isparse % dsparse \alias{-,dsparseVector,missing-method} \alias{Arith,dsparseVector,dsparseVector-method} -\alias{Math2,dsparseVector-method} % zsparse % \alias{c.sparseVector} @@ -102,13 +109,7 @@ \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"}. - } + \code{"lsparseVector"}, etc.} } } \section{Methods}{ @@ -185,7 +186,6 @@ } 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")) @@ -230,16 +230,16 @@ 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)) + 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)), + identical(unname(as.matrix(T20)), toeplitz(as.vector(x20)))) ## c() method for "sparseVector" - also available as regular function @@ -253,11 +253,12 @@ ## 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) -) +stopifnot(exprs = { + 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, + check.class = FALSE) + all.equal(c5, .s(c(0,0, .v(x20))), tol = 0) +}) } diff -Nru rmatrix-1.6-1.1/man/symmpart.Rd rmatrix-1.6-5/man/symmpart.Rd --- rmatrix-1.6-1.1/man/symmpart.Rd 2023-04-27 23:51:54.000000000 +0000 +++ rmatrix-1.6-5/man/symmpart.Rd 2023-08-30 00:44:08.000000000 +0000 @@ -15,20 +15,18 @@ \alias{symmpart,CsparseMatrix-method} \alias{symmpart,RsparseMatrix-method} \alias{symmpart,TsparseMatrix-method} +\alias{symmpart,denseMatrix-method} \alias{symmpart,diagonalMatrix-method} \alias{symmpart,indMatrix-method} -\alias{symmpart,packedMatrix-method} \alias{symmpart,matrix-method} -\alias{symmpart,unpackedMatrix-method} % \alias{skewpart,CsparseMatrix-method} \alias{skewpart,RsparseMatrix-method} \alias{skewpart,TsparseMatrix-method} +\alias{skewpart,denseMatrix-method} \alias{skewpart,diagonalMatrix-method} \alias{skewpart,indMatrix-method} -\alias{skewpart,packedMatrix-method} \alias{skewpart,matrix-method} -\alias{skewpart,unpackedMatrix-method} % \description{ \code{symmpart(x)} computes the symmetric part \code{(x + t(x))/2} and @@ -57,16 +55,18 @@ 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{symmpart(x)} returns a symmetric matrix, + inheriting from \code{\linkS4class{symmetricMatrix}} + or \code{\linkS4class{diagonalMatrix}} if \code{x} + inherits 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}}). + \code{skewpart(x)} returns a skew-symmetric matrix, + inheriting from \code{\linkS4class{generalMatrix}}, + \code{\linkS4class{symmetricMatrix}} or + \code{\linkS4class{diagonalMatrix}} if \code{x} + inherits from \code{Matrix}. } -\seealso{ - \code{\link{isSymmetric}}.} +\seealso{\code{\link{isSymmetric}}.} \examples{ m <- Matrix(1:4, 2,2) symmpart(m) diff -Nru rmatrix-1.6-1.1/man/uniqTsparse.Rd rmatrix-1.6-5/man/uniqTsparse.Rd --- rmatrix-1.6-1.1/man/uniqTsparse.Rd 2023-06-27 16:28:24.000000000 +0000 +++ rmatrix-1.6-5/man/uniqTsparse.Rd 2023-08-30 16:48:22.000000000 +0000 @@ -1,60 +1,58 @@ -\name{uniqTsparse} -\title{Unique (Sorted) TsparseMatrix Representations} +\name{asUniqueT} +\title{Standardize a Sparse Matrix in Triplet Format} % \keyword{array} \keyword{logic} \keyword{manip} \keyword{utilities} % -\alias{uniqTsparse} \alias{anyDuplicatedT} +\alias{isUniqueT} +\alias{asUniqueT} +\alias{aggregateT} +% +\alias{uniqTsparse} % \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}. + Detect or standardize a \code{\linkS4class{TsparseMatrix}} with + unsorted or duplicated \eqn{(i,j)} pairs. } \usage{ -uniqTsparse(x, class.x = c(class(x))) -anyDuplicatedT(x, di = dim(x)) +anyDuplicatedT(x, \dots) +isUniqueT(x, byrow = FALSE, isT = is(x, "TsparseMatrix")) +asUniqueT(x, byrow = FALSE, isT = is(x, "TsparseMatrix")) +aggregateT(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)}.} + \item{x}{an \R{} object. \code{anyDuplicatedT} and \code{aggregateT} + require \code{x} inheriting from \code{\linkS4class{TsparseMatrix}}. + \code{asUniqueT} requires \code{x} inheriting from + \code{\linkS4class{Matrix}} and coerces \code{x} + to \code{\linkS4class{TsparseMatrix}} if necessary.} + \item{\dots}{optional arguments passed to the default method for + generic function \code{\link{anyDuplicated}}.} + \item{byrow}{a logical indicating if \code{x} should be sorted + by row then by column.} + \item{isT}{a logical indicating if \code{x} inherits from virtual + class \code{\linkS4class{TsparseMatrix}}.} } -%% \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 the index of the first duplicated + \eqn{(i,j)} pair in \code{x} (0 if there are no duplicated pairs). - \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}}. + \code{isUniqueT(x)} returns \code{TRUE} if \code{x} is a + \code{\linkS4class{TsparseMatrix}} with sorted, nonduplicated + \eqn{(i,j)} pairs and \code{FALSE} otherwise. + + \code{asUniqueT(x)} returns the unique + \code{\linkS4class{TsparseMatrix}} representation of \code{x} with + sorted, nonduplicated \eqn{(i,j)} pairs. Values corresponding to + identical \eqn{(i,j)} pairs are aggregated by addition, where in the + logical case \dQuote{addition} refers to logical OR. + + \code{aggregateT(x)} aggregates without sorting. } +\seealso{Virtual class \code{\linkS4class{TsparseMatrix}}.} \examples{ \dontshow{ % for R_DEFAULT_PACKAGES=NULL library(stats, pos = "package:base", verbose = FALSE) @@ -62,7 +60,7 @@ } example("dgTMatrix-class", echo=FALSE) ## -> 'T2' with (i,j,x) slots of length 5 each -T2u <- uniqTsparse(T2) +T2u <- asUniqueT(T2) stopifnot(## They "are" the same (and print the same): all.equal(T2, T2u, tol=0), ## but not internally: @@ -71,23 +69,20 @@ 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 +isUniqueT(T2 ) # FALSE +isUniqueT(T2u) # TRUE T3 <- T2u T3[1, c(1,3)] <- 10; T3[2, c(1,5)] <- 20 -T3u <- uniqTsparse(T3) +T3u <- asUniqueT(T3) str(T3u) # sorted in 'j', and within j, sorted in i -stopifnot(!non_uniqT(T3u)) +stopifnot(isUniqueT(T3u)) ## Logical l.TMatrix and n.TMatrix : (L2 <- T2 > 0) -validObject(L2u <- uniqTsparse(L2)) +validObject(L2u <- asUniqueT(L2)) (N2 <- as(L2, "nMatrix")) -validObject(N2u <- uniqTsparse(N2)) +validObject(N2u <- asUniqueT(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]: diff -Nru rmatrix-1.6-1.1/man/unpackedMatrix-class.Rd rmatrix-1.6-5/man/unpackedMatrix-class.Rd --- rmatrix-1.6-1.1/man/unpackedMatrix-class.Rd 2023-07-30 17:02:26.000000000 +0000 +++ rmatrix-1.6-5/man/unpackedMatrix-class.Rd 2023-09-09 00:05:48.000000000 +0000 @@ -10,9 +10,6 @@ \alias{coerce,matrix,unpackedMatrix-method} \alias{coerce,vector,unpackedMatrix-method} \alias{cov2cor,unpackedMatrix-method} -\alias{diag,unpackedMatrix-method} -\alias{diag<-,unpackedMatrix-method} -\alias{t,unpackedMatrix-method} % \description{ Class \code{"unpackedMatrix"} is the \emph{virtual} class of dense @@ -35,7 +32,6 @@ Class \code{"\linkS4class{denseMatrix}"}, directly. Class \code{"\linkS4class{Matrix}"}, by class \code{"denseMatrix"}, distance 2. - Class \code{"mMatrix"}, by class \code{"Matrix"}, distance 3. Class \code{"replValueSp"}, by class \code{"Matrix"}, distance 3. } \section{Methods}{ diff -Nru rmatrix-1.6-1.1/man/updown.Rd rmatrix-1.6-5/man/updown.Rd --- rmatrix-1.6-1.1/man/updown.Rd 2023-05-24 15:26:14.000000000 +0000 +++ rmatrix-1.6-5/man/updown.Rd 2023-08-18 05:02:52.000000000 +0000 @@ -9,8 +9,7 @@ \alias{updown} \alias{updown-methods} % -\alias{updown,character,Matrix,CHMfactor-method} -\alias{updown,character,matrix,CHMfactor-method} +\alias{updown,character,ANY,ANY-method} \alias{updown,logical,Matrix,CHMfactor-method} \alias{updown,logical,dgCMatrix,CHMfactor-method} \alias{updown,logical,dsCMatrix,CHMfactor-method} diff -Nru rmatrix-1.6-1.1/po/Matrix.pot rmatrix-1.6-5/po/Matrix.pot --- rmatrix-1.6-1.1/po/Matrix.pot 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/Matrix.pot 2023-11-03 01:34:40.000000000 +0000 @@ -6,9 +6,9 @@ #, fuzzy msgid "" msgstr "" -"Project-Id-Version: Matrix 1.6-1\n" +"Project-Id-Version: Matrix 1.6-2\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" @@ -17,1277 +17,1073 @@ "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" -#: CHMfactor.c:35 +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 #, c-format -msgid "diagonal element %d of Cholesky factor is missing" +msgid "'%s' failed" msgstr "" -#: CHMfactor.c:66 +#: Csparse.c:35 chm_common.c:54 #, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +msgid "'%s' slot is not increasing within columns after sorting" msgstr "" -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "" - -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "" - -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "" - -#: Csparse.c:145 +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 #, c-format -msgid "failure to open file \"%s\" for writing" -msgstr "" - -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" +msgid "invalid '%s' to '%s'" msgstr "" -#: Csparse.c:331 +#: Csparse.c:316 #, c-format -msgid "%s = '%s' (back-permuted) is experimental" +msgid "failed to open file \"%s\" for writing" msgstr "" -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "" - -#: Mutils.c:410 +#: attrib.c:229 msgid "invalid factor name" msgstr "" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:634 -msgid "invalid transposition vector" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is not of type \"%s\"" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, c-format -msgid "'%s' does not have length %d" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:683 Mutils.c:706 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "'%s' or '%s' is not of type \"%s\"" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:685 Mutils.c:708 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format -msgid "'%s' or '%s' does not have length %d" +msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." msgstr "" -#: Mutils.c:704 +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 #, c-format -msgid "'%s' has length exceeding %s" +msgid "'%s' slot is not of type \"%s\"" msgstr "" -#: Mutils.c:718 +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 #, c-format -msgid "'%s' is NA or less than %s" +msgid "'%s' slot does not have length %s" msgstr "" -#: Mutils.c:744 +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 #, c-format -msgid "unexpected type \"%s\" in %s()" +msgid "first element of '%s' slot is not 0" msgstr "" -#: Mutils.c:766 Mutils.c:787 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "unexpected kind \"%c\" in %s()" +msgid "'%s' slot contains NA" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: chm_common.c:26 validity.c:416 validity.c:467 #, c-format -msgid "indices would exceed %s" +msgid "'%s' slot is not nondecreasing" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "attempt to allocate vector of length exceeding %s" -msgstr "" - -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "" - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "" - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "" - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" -msgstr "" - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" +msgid "first differences of '%s' slot exceed %s" msgstr "" -#: Mutils.c:1406 +#: chm_common.c:37 validity.c:424 validity.c:475 #, c-format -msgid "invalid '%s' argument" -msgstr "" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "" - -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "" - -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "" - -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" +msgid "'%s' slot has length less than %s" msgstr "" -#: Mutils.c:1444 +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgid "'%s' slot has elements not in {%s}" msgstr "" -#: Mutils.c:1449 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" +msgid "wrong '%s'" msgstr "" -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "" - -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "" - -#: Mutils.c:1530 +#: chm_common.c:477 cholmod-etc.c:186 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" -msgstr "" - -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" -msgstr "" - -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" +msgid "'%s' would overflow type \"%s\"" msgstr "" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:481 cholmod-etc.c:190 #, c-format -msgid "dimensions cannot exceed %s" -msgstr "" - -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" - -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" -msgstr "" - -#: bind.c:227 -msgid "complex matrices are not yet supported" +msgid "n+1 would overflow type \"%s\"" msgstr "" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 +#: chm_common.c:486 cholmod-etc.c:195 #, c-format -msgid "%s cannot exceed %s" -msgstr "" - -#: bind.c:848 -msgid "should never happen ..." -msgstr "" - -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "" - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "" - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "" - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "" - -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "" - -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" -msgstr "" - -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "" - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "" - -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "" - -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +msgid "leading principal minor of order %d is not positive" msgstr "" -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" +#: chm_common.c:489 cholmod-etc.c:198 +#, c-format +msgid "leading principal minor of order %d is zero" msgstr "" -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" -#: chm_common.c:801 +#: chm_common.c:838 #, c-format -msgid "Cholmod error '%s' at file %s, line %d" +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "" -#: chm_common.c:805 +#: chm_common.c:841 #, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "" -#: chm_common.c:834 +#: coerce.c:24 coerce.c:364 coerce.c:1050 #, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "" - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" +msgid "attempt to construct non-square %s" msgstr "" -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "" - -#: chm_common.c:1057 -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "" - -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "" - -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" msgstr "" -#: chm_common.c:1173 +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 #, c-format -msgid "f->xtype of %d not recognized" +msgid "'%s' must be \"%s\" or \"%s\"" msgstr "" -#: chm_common.c:1240 +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" +msgid "'%s' must be %s or %s" msgstr "" -#: chm_common.c:1283 -#, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" msgstr "" -#: coerce.c:60 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "attempt to construct %s or %s from non-square matrix" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" msgstr "" -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "invalid '%s' to %s()" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 msgid "attempt to pack non-square matrix" msgstr "" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, c-format msgid "attempt to pack a %s" msgstr "" -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, c-format +msgid "'%s' must be %s or %s or %s" msgstr "" -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, c-format +msgid "'%s' must be an integer from %s to %s" msgstr "" -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 +#: dense.c:218 sparse.c:598 #, c-format -msgid "invalid class of object to %s" +msgid "'%s' must be less than or equal to '%s'" msgstr "" -#: cs_utils.c:147 +#: dense.c:428 sparse.c:1069 #, c-format -msgid "cs matrix not compatible with class '%s'" +msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" msgstr "" -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +msgid "attempt to symmetrize a non-square matrix" msgstr "" -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, c-format -msgid "'%s' must be an integer from %s to %s" +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" + +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:1678 sparse.c:3135 #, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "" -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "" -#: dense.c:891 +#: dense.c:2220 msgid "unknown error in getGivens" msgstr "" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "" -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "" -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "" -#: dense.c:936 +#: dense.c:2265 #, c-format msgid "LAPACK dposv returned error code %d" msgstr "" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, c-format msgid "LAPACK dgels returned error code %d" msgstr "" -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "" -#: dense.c:992 +#: dense.c:2321 #, c-format msgid "tol, given as %g, must be >= 0" msgstr "" -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "" -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "" -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "" - -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "" - -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "" - -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#: determinant.c:33 +msgid "determinant of non-square matrix is undefined" msgstr "" -#: dgCMatrix.c:77 +#: determinant.c:276 #, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" -msgstr "" - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "" - -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "" - -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" +msgid "%s(<%s>) does not support structurally rank deficient case" msgstr "" -#: dgCMatrix.c:127 +#: dgCMatrix.c:14 #, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +msgid "'%s' is empty or not square" msgstr "" -#: dgCMatrix.c:131 +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 #, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" +#: dgCMatrix.c:40 +#, c-format +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" +#: dgCMatrix.c:63 +#, c-format +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" msgstr "" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "" -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "" -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "" -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "" -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "" -#: factorizations.c:73 +#: factorizations.c:355 sparse.c:196 #, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" +msgid "'%s' is not a number" msgstr "" -#: factorizations.c:153 +#: factorizations.c:376 #, c-format -msgid "expected %s or %s" +msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:231 +#: factorizations.c:385 #, c-format -msgid "wrong '%s' or '%s' or '%s" +msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:236 +#: factorizations.c:462 #, c-format -msgid "'%s' would overflow \"%s\"" +msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:239 +#: factorizations.c:471 #, c-format -msgid "n+1 would overflow \"%s\"" +msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:243 +#: factorizations.c:571 factorizations.c:849 #, c-format -msgid "leading principal minor of order %d is not positive" +msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:246 +#: idz.c:467 idz.c:528 #, c-format -msgid "leading principal minor of order %d is zero" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: factorizations.c:317 +#: kappa.c:10 kappa.c:54 #, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" +msgid "argument '%s' is not of type \"%s\"" msgstr "" -#: factorizations.c:326 factorizations.c:329 +#: kappa.c:13 kappa.c:57 #, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +msgid "argument '%s' has length %d" msgstr "" -#: factorizations.c:339 factorizations.c:342 +#: kappa.c:17 kappa.c:61 #, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" +msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "" -#: factorizations.c:355 factorizations.c:358 +#: kappa.c:41 #, c-format msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" +"argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " +"\"%s\"" msgstr "" -#: factorizations.c:647 sparse.c:195 +#: kappa.c:75 #, c-format -msgid "'%s' is not a number" +msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "" -#: factorizations.c:665 +#: kappa.c:238 #, c-format -msgid "LU factorization of m-by-n %s requires m == n" +msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: factorizations.c:674 +#: objects.c:23 #, c-format -msgid "LU factorization of %s failed: out of memory or near-singular" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: factorizations.c:764 +#: objects.c:41 objects.c:58 #, c-format -msgid "QR factorization of m-by-n %s requires m >= n" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: factorizations.c:773 -#, c-format -msgid "QR factorization of %s failed: out of memory" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" msgstr "" -#: factorizations.c:867 factorizations.c:2223 -#, c-format -msgid "'%s' is not a number or not finite" +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" msgstr "" -#: factorizations.c:1124 -msgid "determinant of non-square matrix is undefined" +#: perm.c:66 +msgid "invalid transposition vector" msgstr "" -#: factorizations.c:1290 +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" +msgid "'%s' is not of type \"%s\"" msgstr "" -#: factorizations.c:1412 +#: perm.c:83 perm.c:100 perm.c:147 #, c-format -msgid "'%s' is not square" +msgid "'%s' does not have length %d" msgstr "" -#: factorizations.c:1418 factorizations.c:2058 +#: perm.c:86 perm.c:103 #, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" +msgid "'%s' is NA" msgstr "" -#: factorizations.c:1612 +#: perm.c:115 perm.c:138 #, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" +msgid "'%s' or '%s' is not of type \"%s\"" msgstr "" -#: factorizations.c:1703 +#: perm.c:117 perm.c:140 #, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" +msgid "'%s' or '%s' does not have length %d" msgstr "" -#: init.c:421 -msgid "missing 'Matrix' namespace; should never happen" +#: perm.c:120 perm.c:143 +#, c-format +msgid "'%s' or '%s' is NA" msgstr "" -#: init.c:431 -msgid "'Matrix' namespace not determined correctly" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" msgstr "" -#: kappa.c:7 kappa.c:50 +#: perm.c:150 #, c-format -msgid "argument '%s' is not of type \"%s\"" +msgid "'%s' is NA or less than %s" msgstr "" -#: kappa.c:10 kappa.c:53 -#, c-format -msgid "argument '%s' has length %d" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" msgstr "" -#: kappa.c:14 kappa.c:57 +#: products.c:782 products.c:807 #, c-format -msgid "argument '%s' (\"%s\") does not have string length %d" +msgid "'%s' does not support complex matrices" msgstr "" -#: kappa.c:38 +#: solve.c:38 #, c-format -msgid "" -"argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " -"\"%s\"" +msgid "'%s' is not square" msgstr "" -#: kappa.c:71 +#: solve.c:497 #, c-format -msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: kappa.c:107 +#: solve.c:618 #, c-format -msgid "%s(%s) is undefined: '%s' is not square" +msgid "attempt to construct %s with more than %s nonzero elements" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: sparseVector.c:90 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "%s length cannot exceed %s" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 +#: subscript.c:2209 #, c-format -msgid "'%s' must be %s or %s" +msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 -#, c-format -msgid "replacement diagonal has incompatible type \"%s\"" +#: t_Csparse_subassign.c:142 +msgid "invalid class of 'x' in Csparse_subassign()" msgstr "" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" +#: t_Csparse_subassign.c:144 +msgid "invalid class of 'value' in Csparse_subassign()" msgstr "" -#: products.c:155 products.c:248 +#: t_Csparse_subassign.c:187 #, c-format -msgid "Dimensions of x and y are not compatible for %s" +msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" +#: t_Csparse_subassign.c:192 +#, c-format +msgid "" +"x[] <- val: val should be integer or logical, is coerced to integer, for " +"\"%s\" x" msgstr "" -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" +#: t_Csparse_subassign.c:199 +msgid "programming error in Csparse_subassign() should never happen" msgstr "" -#: products.c:408 +#: utils-R.c:30 utils-R.c:116 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "indices would exceed %s" msgstr "" -#: products.c:486 -msgid "dtrMatrix must be square" +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" msgstr "" -#: products.c:528 products.c:559 -#, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#: utils-R.c:345 +msgid "'data' must be of a vector type" msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" +#: utils-R.c:352 +#, c-format +msgid "invalid '%s' argument" msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -msgid "attempt to symmetrize a non-square matrix" +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" msgstr "" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" msgstr "" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: utils-R.c:390 #, c-format -msgid "%s too dense for %s; would have more than %s nonzero entries" +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" msgstr "" -#: subscript.c:2146 +#: utils-R.c:395 #, c-format -msgid "NA subscripts in %s not supported for '%s' inheriting from %s" +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" msgstr "" -#: t_Csparse_subassign.c:144 -msgid "invalid class of 'x' in Csparse_subassign()" +#: utils-R.c:399 +msgid "data length exceeds size of matrix" msgstr "" -#: t_Csparse_subassign.c:146 -msgid "invalid class of 'value' in Csparse_subassign()" +#: utils-R.c:404 +msgid "too many elements specified" msgstr "" -#: t_Csparse_subassign.c:189 -#, c-format -msgid "x[] <- val: val is coerced to logical for \"%s\" x" +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" msgstr "" -#: t_Csparse_subassign.c:194 -#, c-format -msgid "" -"x[] <- val: val should be integer or logical, is coerced to integer, for " -"\"%s\" x" +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" msgstr "" -#: t_Csparse_subassign.c:201 -msgid "programming error in Csparse_subassign() should never happen" +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" msgstr "" -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, c-format -msgid "'%s' slot is not of type \"%s\"" +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 #, c-format msgid "'%s' slot does not have length %d" msgstr "" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 -#, c-format -msgid "'%s' slot contains NA" -msgstr "" - -#: validity.c:54 validity.c:976 validity.c:1009 +#: validity.c:45 validity.c:965 validity.c:998 #, c-format msgid "'%s' slot has negative elements" msgstr "" -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, c-format msgid "'%s' slot is not a list" msgstr "" -#: validity.c:98 +#: validity.c:89 #, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "" -#: validity.c:101 +#: validity.c:92 #, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "" -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "" -#: validity.c:351 +#: validity.c:340 #, c-format msgid "'%s' slot is not %d or %d" msgstr "" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format -msgid "'%s' slot does not have length %s" +msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 +#: validity.c:437 validity.c:1613 #, c-format -msgid "'%s' slot has elements not in {%s}" +msgid "'%s' slot is not increasing within columns" msgstr "" -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:488 #, c-format -msgid "'%s' slot contains duplicates" +msgid "'%s' slot is not increasing within rows" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, c-format -msgid "first element of '%s' slot is not 0" +msgid "'%s' and '%s' slots do not have equal length" msgstr "" -#: validity.c:427 validity.c:478 +#: validity.c:515 #, c-format -msgid "'%s' slot is not nondecreasing" +msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:429 validity.c:480 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, c-format -msgid "first differences of '%s' slot exceed %s" +msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "" -#: validity.c:435 validity.c:486 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, c-format -msgid "'%s' slot has length less than %s" +msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "" -#: validity.c:448 validity.c:1543 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, c-format -msgid "'%s' slot is not increasing within columns" +msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "" -#: validity.c:499 +#: validity.c:911 validity.c:935 validity.c:939 +msgid "matrix has negative diagonal elements" +msgstr "" + +#: validity.c:955 validity.c:983 validity.c:987 +msgid "matrix has nonunit diagonal elements" +msgstr "" + +#: validity.c:1007 validity.c:1032 validity.c:1826 #, c-format -msgid "'%s' slot is not increasing within rows" +msgid "'%s' slot is not of type \"%s\" or \"%s\"" msgstr "" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:1015 validity.c:1022 #, c-format -msgid "'%s' and '%s' slots do not have equal length" +msgid "'%s' slot is NA" msgstr "" -#: validity.c:526 +#: validity.c:1017 validity.c:1024 #, c-format -msgid "'%s' slot has nonzero length but %s is 0" +msgid "'%s' slot is negative" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:1026 #, c-format -msgid "%s=\"%s\" but there are entries below the diagonal" +msgid "'%s' slot exceeds %s" msgstr "" -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:1036 #, c-format -msgid "%s=\"%s\" but there are entries above the diagonal" +msgid "'%s' slot has length greater than '%s' slot" msgstr "" -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 #, c-format -msgid "%s=\"%s\" but there are entries on the diagonal" +msgid "'%s' slot is not increasing" msgstr "" -#: validity.c:922 validity.c:946 validity.c:950 -msgid "matrix has negative diagonal elements" +#: validity.c:1056 +#, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 -msgid "matrix has nonunit diagonal elements" +#: validity.c:1059 +#, c-format +msgid "'%s' slot is not increasing after truncation towards zero" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, c-format msgid "'%s' slot has fewer than %s rows" msgstr "" -#: validity.c:1158 +#: validity.c:1228 #, c-format msgid "'%s' slot has more than %s rows" msgstr "" -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, c-format msgid "'%s' slot does not have %s columns" msgstr "" -#: validity.c:1167 +#: validity.c:1237 #, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "" -#: validity.c:1181 +#: validity.c:1250 #, c-format msgid "'%s' slot does not have %s row" msgstr "" -#: validity.c:1191 +#: validity.c:1259 #, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, c-format msgid "%s[%d] (%s) is not in %s" msgstr "" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, c-format msgid "%s is not in {%s}" msgstr "" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, c-format msgid "%s is not %d" msgstr "" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, c-format msgid "'%s' slot has length less than %d" msgstr "" -#: validity.c:1594 +#: validity.c:1664 #, c-format msgid "'%s' slot has length greater than %s" msgstr "" -#: validity.c:1599 +#: validity.c:1669 #, c-format msgid "last element of '%s' slot is not %s" msgstr "" -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, c-format -msgid "'%s' slot is not increasing" -msgstr "" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "" -#: validity.c:1756 -#, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "" - -#: validity.c:1775 +#: validity.c:1845 #, c-format msgid "invalid class \"%s\" object: %s" msgstr "" diff -Nru rmatrix-1.6-1.1/po/R-Matrix.pot rmatrix-1.6-5/po/R-Matrix.pot --- rmatrix-1.6-1.1/po/R-Matrix.pot 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-Matrix.pot 2023-11-03 01:34:40.000000000 +0000 @@ -1,7 +1,7 @@ msgid "" msgstr "" -"Project-Id-Version: Matrix 1.6-1\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"Project-Id-Version: Matrix 1.6-2\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" @@ -10,58 +10,28 @@ "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" -msgid "invalid 'mod': %s" +msgid "invalid mode \"%s\"" msgstr "" -msgid "not-yet-implemented method for %s(<%s>).\n ->> Ask the package authors to implement the missing feature." +msgid "%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement the missing method" msgstr "" -msgid "not-yet-implemented method for %s(<%s>, <%s>).\n ->> Ask the package authors to implement the missing feature." +msgid "complex %s not yet implemented" msgstr "" -msgid "non-conformable matrix dimensions in %s" -msgstr "" - -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "" - -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" -msgstr "" - -msgid "[[ suppressing %d column name%s %s ... ]]" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "" msgid "non0.i() not yet implemented for class %s" msgstr "" -msgid "not yet implemented for class \"%s\"" -msgstr "" - -msgid "invalid 'uplo'" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" -msgstr "" - -msgid "nothing to replace with" -msgstr "" - -msgid "number of items to replace is not a multiple of replacement length" -msgstr "" - -msgid "too many replacement values" -msgstr "" - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "" - -msgid "using\"old code\" part in Csparse subassignment\n >>> please report to Matrix-authors@r-project.org" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" msgid "Not a valid format" @@ -124,349 +94,346 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "invalid 'data'" -msgstr "" - -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgid "longer object length is not a multiple of shorter object length" msgstr "" -msgid "data is too long" +msgid "invalid class \"%s\" in '%s' method" msgstr "" -msgid "'lag' and 'differences' must be integers >= 1" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -msgid ".M.repl.i.2col(): 'i' has no integer column number;\n should never happen; please report" +msgid "non-conformable matrix dimensions in %s" msgstr "" -msgid "such indexing must be by logical or 2-column numeric matrix" +msgid "dimnames [%d] mismatch in %s" msgstr "" -msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgid "inefficient method used for \"- e1\"" msgstr "" -msgid "negative values are not allowed in a matrix subscript" +msgid "dim [product %d] do not match the length of object [%d]" msgstr "" -msgid "NAs are not allowed in subscripted assignments" +msgid "internal bug in \"Compare\" method (Cmp.Mat.atomic); please report" msgstr "" -msgid "m[ ] <- v: inefficiently treating single elements" +msgid "Cmp.Mat.atomic() should not be called for diagonalMatrix" msgstr "" -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgid "Matrices must have same number of rows for arithmetic" msgstr "" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "number of rows are not compatible for %s" msgstr "" -msgid "not-yet-implemented 'Matrix[<-' method" +msgid "length of 2nd arg does not match dimension of first" msgstr "" -msgid "dimnames [%d] mismatch in %s" +msgid "length of 1st arg does not match dimension of 2nd" msgstr "" -msgid "inefficient method used for \"- e1\"" +msgid "internal bug in \"Logic\" method (Logic.Mat.atomic); please report" msgstr "" -msgid "dim [product %d] do not match the length of object [%d]" +msgid "Logic.Mat.atomic() should not be called for diagonalMatrix" msgstr "" -msgid "internal bug in \"Compare\" method (Cmp.Mat.atomic); please report" +msgid "vector too long in Matrix - vector operation" msgstr "" -msgid "Cmp.Mat.atomic() should not be called for diagonalMatrix" +msgid "longer object length\n\tis not a multiple of shorter object length" msgstr "" -msgid "Matrices must have same number of rows for arithmetic" +msgid "intermediate 'r' is of type %s" msgstr "" -msgid "number of rows are not compatible for %s" +msgid "not yet implemented .. please report" msgstr "" -msgid "length of 2nd arg does not match dimension of first" +msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "" -msgid "length of 1st arg does not match dimension of 2nd" +msgid "invalid (to - from)/by in seq(.)" msgstr "" -msgid "internal bug in \"Logic\" method (Logic.Mat.atomic); please report" +msgid "wrong sign in 'by' argument" msgstr "" -msgid "Logic.Mat.atomic() should not be called for diagonalMatrix" +msgid "'by' argument is much too small" msgstr "" -msgid "vector too long in Matrix - vector operation" +msgid "length must be non-negative number" msgstr "" -msgid "longer object length\n\tis not a multiple of shorter object length" +msgid "too many arguments" msgstr "" -msgid "longer object length is not a multiple of shorter object length" +msgid "c(,..) of different kinds, coercing all to 'rleDiff'" msgstr "" -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" +msgid "[i] is not yet implemented" msgstr "" -msgid "in Summary(, .): %s(<%s>, <%s>,...)" +msgid "all() is not yet implemented" msgstr "" -msgid "in Summary(, .): %s(<%s>, <%s>)" +msgid "sum() is not yet implemented" msgstr "" -msgid "you cannot mix negative and positive indices" +msgid "prod() is not yet implemented" msgstr "" -msgid "index larger than maximal %d" +msgid "not yet implemented" msgstr "" -msgid "'NA' indices are not (yet?) supported for sparse Matrices" +msgid "x / 0 for an x with sign-change\n no longer representable as 'rleDiff'" msgstr "" -msgid "logical subscript too long (%d, should be %d)" +msgid " --> is not yet implemented" msgstr "" -msgid "no 'dimnames[[.]]': cannot use character indexing" +msgid " --> is not yet implemented" msgstr "" -msgid "invalid character indexing" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "" -msgid "internal bug: missing 'i' in replTmat(): please report" +msgid "matrix is not square" msgstr "" -msgid "[ ] indexing not allowed: forgot a \",\" ?" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1.\", or \"%4$s\"" msgstr "" -msgid "internal bug: matrix 'i' in replTmat(): please report" +msgid "'%s' does not inherit from virtual class %s" msgstr "" -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgid "D[i,i] is NA, i=%d" msgstr "" -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgid "matrix is not symmetric; consider forceSymmetric(.) or symmpart(.)" msgstr "" -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgid "matrix is not triangular; consider triu(.) or tril(.)" msgstr "" -msgid "nargs() = %d should never happen; please report." +msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "row indices must be <= nrow(.) which is %d" +msgid "invalid type \"%s\" in '%s'" msgstr "" -msgid "column indices must be <= ncol(.) which is %d" +msgid "invalid %s=\"%s\" to '%s'" msgstr "" -msgid "'force' must be (coercable to) TRUE or FALSE" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid (to - from)/by in seq(.)" +msgid "invalid class \"%s\" in '%s'" msgstr "" -msgid "wrong sign in 'by' argument" +msgid "%s length cannot exceed %s" msgstr "" -msgid "'by' argument is much too small" +msgid "'A' must be a square matrix" msgstr "" -msgid "length must be non-negative number" +msgid "must either specify 'A' or the functions 'A.x' and 'At.x'" msgstr "" -msgid "too many arguments" +msgid "when 'A' is specified, 'A.x' and 'At.x' are disregarded" msgstr "" -msgid "c(,..) of different kinds, coercing all to 'rleDiff'" +msgid "not converged in %d iterations" msgstr "" -msgid "[i] is not yet implemented" +msgid "hit a cycle (1) -- stop iterations" msgstr "" -msgid "all() is not yet implemented" +msgid "hit a cycle (2) -- stop iterations" msgstr "" -msgid "sum() is not yet implemented" +msgid "not enough new vecs -- stop iterations" msgstr "" -msgid "prod() is not yet implemented" +msgid "invalid 'data'" msgstr "" -msgid "not yet implemented" +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" msgstr "" -msgid "x / 0 for an x with sign-change\n no longer representable as 'rleDiff'" +msgid "data is too long" msgstr "" -msgid " --> is not yet implemented" +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" msgstr "" -msgid " --> is not yet implemented" +msgid "use Diagonal() to construct diagonal (symmetric && triangular) sparse matrices" msgstr "" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgid "'giveCsparse' is deprecated; using 'repr' instead" msgstr "" -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" msgstr "" -msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgid "'p' must be a nondecreasing vector c(0, ...)" msgstr "" -msgid "'diagonals' must have the same length (%d) as 'k'" +msgid "dimensions cannot exceed 2^31-1" msgstr "" -msgid "matrix can only be symmetric if square, but n != m" +msgid "'i' and 'j' must not contain NA" msgstr "" -msgid "for symmetric band matrix, only specify upper or lower triangle\n hence, all k must have the same sign" +msgid "'i' and 'j' must be" msgstr "" -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgid "positive" msgstr "" -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgid "non-negative" msgstr "" -msgid "number of rows of matrices must match" +msgid "invalid 'dims'" msgstr "" -msgid "number of columns of matrices must match" +msgid "'dims' must contain all (i,j) pairs" msgstr "" -msgid "dimensions cannot exceed 2^31-1" +msgid "symmetric matrix must be square" msgstr "" -msgid "resulting x-slot has different type than x's or y's" +msgid "triangular matrix must be square" msgstr "" -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "p[length(p)]" msgstr "" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" +msgid "length(i)" msgstr "" -msgid "matrix is not square" +msgid "is not an integer multiple of length(x)" msgstr "" -msgid "'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +msgid "length(x) must not exceed" msgstr "" -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" msgstr "" -msgid "D[i,i] is NA, i=%d" +msgid "'n' must be a non-negative integer" msgstr "" -msgid "D[i,i] is negative, i=%d" +msgid "'x' has unsupported class \"%s\"" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'x' has unsupported type \"%s\"" msgstr "" -msgid "matrix is not symmetric; consider forceSymmetric(.) or symmpart(.)" +msgid "attempt to recycle 'x' of length 0 to length 'n' (n > 0)" msgstr "" -msgid "matrix is not triangular; consider triu(.) or tril(.)" +msgid "'shape' must be one of \"g\", \"t\", \"s\"" msgstr "" -msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" +msgid "'kind' must be one of \"d\", \"l\", \"n\"" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" +msgid "mismatch between typeof(x)=\"%s\" and kind=\"%s\"; using kind=\"%s\"" msgstr "" -msgid "invalid kind \"%s\" to .m2dense.checking()" +msgid "'cols' must be numeric" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "'cols' has elements not in seq(0, length.out = n)" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +msgid "'uplo' must be \"U\" or \"L\"" msgstr "" -msgid "'A' must be a square matrix" +msgid "'lst' must be a list" msgstr "" -msgid "must either specify 'A' or the functions 'A.x' and 'At.x'" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" msgstr "" -msgid "when 'A' is specified, 'A.x' and 'At.x' are disregarded" +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" msgstr "" -msgid "not converged in %d iterations" +msgid "'diagonals' matrix must have %d columns (= length(k) )" msgstr "" -msgid "hit a cycle (1) -- stop iterations" +msgid "'diagonals' must have the same length (%d) as 'k'" msgstr "" -msgid "hit a cycle (2) -- stop iterations" +msgid "matrix can only be symmetric if square, but n != m" msgstr "" -msgid "not enough new vecs -- stop iterations" +msgid "for symmetric band matrix, only specify upper or lower triangle\n hence, all k must have the same sign" msgstr "" -msgid "dimensions must be numeric of length 2" +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" msgstr "" -msgid "dimensions cannot contain NA" +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" msgstr "" -msgid "dimensions cannot contain negative values" +msgid "'x' must inherit from \"sparseVector\"" msgstr "" -msgid "invalid nargs()= %d" +msgid "'ncol' must be >= 0" msgstr "" -msgid "the default value of argument 'sqrt' of method 'determinant(, )' may change from TRUE to FALSE as soon as the next release of Matrix; set 'sqrt' when programming" +msgid "'nrow' must be >= 0" msgstr "" -msgid "determinant of non-square matrix is undefined" +msgid "Must specify 'nrow' when 'symmetric' is true" msgstr "" -msgid "'n' must be a non-negative integer" +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" msgstr "" -msgid "'x' has unsupported class \"%s\"" +msgid "'x' must have length nrow^2 when 'symmetric' is true" msgstr "" -msgid "'x' has unsupported type \"%s\"" +msgid "'ncol' is not a factor of length(x)" msgstr "" -msgid "attempt to recycle 'x' of length 0 to length 'n' (n > 0)" +msgid "'nrow' is not a factor of length(x)" msgstr "" -msgid "'shape' must be one of \"g\", \"t\", \"s\"" +msgid "Class %s is not yet implemented" msgstr "" -msgid "'kind' must be one of \"d\", \"l\", \"n\"" +msgid "'%s' and '%s' must be positive integers" msgstr "" -msgid "mismatch between typeof(x)=\"%s\" and kind=\"%s\"; using kind=\"%s\"" +msgid "matrix is not symmetric or triangular" msgstr "" -msgid "'cols' must be numeric" +msgid "matrix is not symmetric" msgstr "" -msgid "'cols' has elements not in seq(0, length.out = n)" +msgid "matrix is not triangular" msgstr "" -msgid "'uplo' must be \"U\" or \"L\"" +msgid "the default value of argument '%s' of method '%s(<%s>, <%s>)' may change from %s to %s as soon as the next release of Matrix; set '%s' when programming" msgstr "" -msgid "'lst' must be a list" +msgid "determinant of non-square matrix is undefined" msgstr "" msgid "replacement diagonal has wrong length" @@ -475,22 +442,28 @@ msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" msgstr "" -msgid "intermediate 'r' is of type %s" +msgid "assigned dimensions do not have length %d" msgstr "" -msgid "not yet implemented .. please report" +msgid "assigned dimensions are NA" msgstr "" -msgid "not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" +msgstr "" + +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +msgid "'%s' has non-finite values" +msgstr "" + +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" msgid "only square matrices can be used as graph incidence matrices" @@ -499,79 +472,91 @@ msgid "'lwd' must be NULL or non-negative numeric" msgstr "" -msgid "'perm' must be numeric" +msgid "%s(<%s>) is not yet implemented" msgstr "" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" msgstr "" -msgid "'margin' must be 1 or 2" +msgid "'%s' has elements less than %d" msgstr "" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' is not a non-negative number" msgstr "" -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' has elements exceeding '%s'" msgstr "" -msgid "method for kronecker() must use default FUN=\"*\"" +msgid "'%s' is not %d or %d" msgstr "" -msgid "number of nonzero entries cannot exceed 2^31-1" +msgid "'%s' is not a permutation of seq_len(%s)" msgstr "" -msgid "Matrix seems negative semi-definite" +msgid "matrix must have exactly one entry in each row or column" msgstr "" -msgid "'nearPD()' did not converge in %d iterations" +msgid "attempt to coerce non-square matrix to %s" msgstr "" -msgid "'norm' via sparse -> dense coercion" +msgid "matrix must have exactly one entry in each row and column" msgstr "" -msgid "invalid 'type'" +msgid "'%s' via sparse -> dense coercion" msgstr "" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "invalid %s=\"%s\"" msgstr "" -msgid "attempt to coerce non-square matrix to pMatrix" +msgid "norm" msgstr "" -msgid "matrix must have exactly one nonzero element in each row and column" +msgid "'%s' method must use default %s=\"%s\"" msgstr "" -msgid "not-yet-implemented method for <%s> %%*%% <%s>" +msgid "number of nonzero entries cannot exceed %s" msgstr "" -msgid "non-conformable arguments" +msgid "Matrix seems negative semi-definite" msgstr "" -msgid "'boolArith = %d' not yet implemented" +msgid "'nearPD()' did not converge in %d iterations" msgstr "" -msgid "matrix is structurally rank deficient; using augmented matrix with additional %d row(s) of zeros" +msgid "'cl' is not a character string" msgstr "" -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or \"R1\"" +msgid "not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" -msgid "'Dvec' has the wrong length" +msgid "'%s' is not a square numeric matrix" msgstr "" -msgid "invalid 'ncol': not in 0:%d" +msgid "diag(%s) has non-positive or non-finite entries; finite result is doubtful" msgstr "" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "non-conformable arguments" msgstr "" -msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" +msgid "matrix is structurally rank deficient; using augmented matrix with additional %d row(s) of zeros" +msgstr "" + +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", \"%3$s1\", \"%4$s\", or \"%4$s1\"" +msgstr "" + +msgid "'%s' has the wrong length" msgstr "" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" +msgid "invalid '%s': not in %d:%d" +msgstr "" + +msgid "need greater '%s' as pivoting occurred" +msgstr "" + +msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "" msgid "rankMatrix(, method = '%s') coerces to dense matrix.\n Probably should rather use method = 'qr' !?" @@ -580,25 +565,43 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "" -msgid "rcond(x) is undefined: 'x' has length 0" +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "" + +msgid "invalid 'col.names' string: %s" +msgstr "" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" msgstr "" -msgid "'rcond' via sparse -> dense coercion" +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" msgstr "" -msgid "invalid 'norm'" +msgid "in show(); maybe adjust options(max.print=, width=)" msgstr "" -msgid "'a' is not square" +msgid "suppressing %d columns and %d rows" msgstr "" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "suppressing %d rows" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "suppressing %d columns" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "" + +msgid "'%s' is not square" +msgstr "" + +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "" + +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" +msgstr "" + +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -610,10 +613,7 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -msgid "cannot coerce zsparseVector to dgCMatrix" -msgstr "" - -msgid "cannot coerce zsparseVector to dgeMatrix" +msgid "cannot coerce from %s to %s" msgstr "" msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -628,139 +628,136 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "" -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "" - -msgid "use Diagonal() to construct diagonal (symmetric && triangular) sparse matrices" +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" msgstr "" -msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgid "length of 'center' must equal the number of columns of 'x'" msgstr "" -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgid "length of 'scale' must equal the number of columns of 'x'" msgstr "" -msgid "'p' must be a nondecreasing vector c(0, ...)" +msgid "trimmed means are not defined for complex data" msgstr "" -msgid "'i' and 'j' must not contain NA" +msgid "first element used of '%s' argument" msgstr "" -msgid "'i' and 'j' must be" +msgid "invalid '%s' argument" msgstr "" -msgid "positive" +msgid "should never happen ..." msgstr "" -msgid "non-negative" +msgid "'%s' is deprecated; using '%s' instead" msgstr "" -msgid "invalid 'dims'" +msgid "'%s' is deprecated; setting %s=\"%s\"" msgstr "" -msgid "'dims' must contain all (i,j) pairs" +msgid ".M.repl.i.2col(): 'i' has no integer column number;\n should never happen; please report" msgstr "" -msgid "symmetric matrix must be square" +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" -msgid "triangular matrix must be square" +msgid ".M.repl.i.2col(): drop 'matrix' case ..." msgstr "" -msgid "p[length(p)]" +msgid "negative values are not allowed in a matrix subscript" msgstr "" -msgid "length(i)" +msgid "NAs are not allowed in subscripted assignments" msgstr "" -msgid "is not an integer multiple of length(x)" +msgid "number of items to replace is not a multiple of replacement length" msgstr "" -msgid "length(x) must not exceed" +msgid "m[ ] <- v: inefficiently treating single elements" msgstr "" -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" msgstr "" -msgid "invalid 'col.names' string: %s" +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgid "not-yet-implemented 'Matrix[<-' method" msgstr "" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgid "invalid nargs()= %d" msgstr "" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" +msgid "nothing to replace with" msgstr "" -msgid "suppressing %d columns and %d rows" +msgid "too many replacement values" msgstr "" -msgid "suppressing %d rows" +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" msgstr "" -msgid "suppressing %d columns" +msgid "using\t \"old code\" part in Csparse subassignment" msgstr "" -msgid "logic programming error in printSpMatrix2(), please report" +msgid "using\"old code\" part in Csparse subassignment\n >>> please report to Matrix-authors@r-project.org" msgstr "" -msgid "'V' is not a *square* matrix" +msgid "you cannot mix negative and positive indices" msgstr "" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" +msgid "index larger than maximal %d" msgstr "" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" msgstr "" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgid "logical subscript too long (%d, should be %d)" msgstr "" -msgid "length of 'center' must equal the number of columns of 'x'" +msgid "no 'dimnames[[.]]': cannot use character indexing" msgstr "" -msgid "length of 'scale' must equal the number of columns of 'x'" +msgid "invalid character indexing" msgstr "" -msgid "'x' must inherit from \"sparseVector\"" +msgid "internal bug: missing 'i' in replTmat(): please report" msgstr "" -msgid "'ncol' must be >= 0" +msgid "[ ] indexing not allowed: forgot a \",\" ?" msgstr "" -msgid "'nrow' must be >= 0" +msgid "internal bug: matrix 'i' in replTmat(): please report" msgstr "" -msgid "Must specify 'nrow' when 'symmetric' is true" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." msgstr "" -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." msgstr "" -msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." msgstr "" -msgid "'ncol' is not a factor of length(x)" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." msgstr "" -msgid "'nrow' is not a factor of length(x)" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" msgstr "" -msgid "Class %s is not yet implemented" +msgid "nargs() = %d should never happen; please report." msgstr "" -msgid "suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" +msgid "row indices must be <= nrow(.) which is %d" msgstr "" -msgid "index must be numeric, logical or sparseVector for indexing sparseVectors" +msgid "column indices must be <= ncol(.) which is %d" msgstr "" -msgid "'times >= 0' is required" +msgid "Internal bug: nargs()=%d; please report" msgstr "" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" +msgid "index must be numeric, logical or sparseVector for indexing sparseVectors" msgstr "" msgid "invalid subscript class \"%s\"" @@ -769,10 +766,10 @@ msgid "invalid subscript type \"%s\"" msgstr "" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -784,16 +781,13 @@ msgid "incorrect number of dimensions" msgstr "" -msgid "matrix is not symmetric or triangular" +msgid "only zeros may be mixed with negative subscripts" msgstr "" -msgid "matrix is not symmetric" -msgstr "" - -msgid "matrix is not triangular" +msgid "'%s' has length 0 but '%s' does not" msgstr "" -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" msgid "invalid 'Class2'" diff -Nru rmatrix-1.6-1.1/po/R-de.po rmatrix-1.6-5/po/R-de.po --- rmatrix-1.6-1.1/po/R-de.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-de.po 2023-11-03 01:34:40.000000000 +0000 @@ -7,7 +7,7 @@ msgstr "" "Project-Id-Version: R 4.0.0 / matrix 1.3-0\n" "Report-Msgid-Bugs-To: bugs.r-project.org\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2020-04-01 16:01+0200\n" "Last-Translator: Detlef Steuer \n" "Language-Team: R-Core \n" @@ -17,80 +17,35 @@ "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "ungültiges 'mod': %s" msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"noch nicht implementierte Methode für %s(<%s>).\n" -" ->> Bitten Sie die Autoren des Pakets, diese fehlende Funktion zu " -"implementieren." - -msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"noch nicht implementierte Methode für %s(<%s>, <%s>).\n" -" ->> Bitten Sie die Autoren des Pakets, diese fehlende Funktion zu " -"implementieren." - -msgid "non-conformable matrix dimensions in %s" -msgstr "nicht konforme Matrixdimensionen in %s" #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "allgemeine Matrixklasse noch nicht implementiert für %s" +msgid "complex %s not yet implemented" +msgstr "Klasse %s noch nicht implementiert" #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "'NA's können nicht in \"nsparseMatrix\" umgewandelt werden" #, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ unterdrücke %d Spaltennamen %s ...]]" - -#, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "noch nicht implementiert für Klasse %s" -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "noch nicht implementiert für Klasse %s" - -#, fuzzy -msgid "invalid 'uplo'" -msgstr "ungültiger 'type'" - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "nothing to replace with" -msgstr "nichts zu ersetzen mit" - -msgid "number of items to replace is not a multiple of replacement length" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"Anzahl der zu ersetzenden Elemente ist kein Vielfaches der Austauschlänge" - -msgid "too many replacement values" -msgstr "zu viele Austauschwerte" - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "i1[1] == 0 ==> C-Ebene wird nicht detailliert sein!" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "benutzt wird\t 'alter Kode'-Teil in Csparse-Unterzuweisung" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" -msgstr "" -"benutzt wird 'alter Kode'-Teil in Csparse-Unterzuweisung\n" -" >>> bitte an Matrix-authors@r-project.org berichten" msgid "Not a valid format" msgstr "Kein gültiges Format" @@ -154,57 +109,26 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "'%s()' ist noch nicht implementiert für Darstellung '%s'" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" -msgstr "" - -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "invalid 'data'" -msgstr "ungültiges 'data'" - -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "'nrow', 'ncol', etc werden nicht für Matrix 'data' berücksichtigt" - -msgid "data is too long" -msgstr "" - -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag' und 'differences' müssen ganze Zahlen >=1 sein" - msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -".M.repl.i.2col(): 'i' hat keine ganzzahlige Spaltennummer.\n" -"Sollte nie passieren. Bitte melden." - -msgid "such indexing must be by logical or 2-column numeric matrix" -msgstr "" -"solche Indexierung muss von logischer oder 2-spaltig numerischer Matrix sein" - -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col(): 'matrix'-Fall weglassen ..." - -msgid "negative values are not allowed in a matrix subscript" -msgstr "negative Werte sind in einer Matrix-Subskript nicht erlaubt" - -msgid "NAs are not allowed in subscripted assignments" -msgstr "NAs sind in indexierten Anweisungen nicht erlaubt" -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v: Einzelne Elemente ineffizient behandelt" +msgid "longer object length is not a multiple of shorter object length" +msgstr "längere Objektlänge ist kein Vielfaches der kürzeren Objektlänge" -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. Irrelevante ungültige Argumente innerhalb '[ .. ]'?" +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "ungültige 'col.names'-Zeichenkette: %s" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"RHS 'value' (Klasse %s) passt zu 'ANY', muss aber zur Matrixklasse %s passen" -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "noch nicht implementierte 'Matrix[<-'-Methode" +msgid "non-conformable matrix dimensions in %s" +msgstr "nicht konforme Matrixdimensionen in %s" msgid "dimnames [%d] mismatch in %s" msgstr "dimnames [%d] passen nicht in %s" @@ -251,77 +175,11 @@ "längere Objektlänge\n" "\tist kein Vielfaches der kürzeren Objektlänge" -msgid "longer object length is not a multiple of shorter object length" -msgstr "längere Objektlänge ist kein Vielfaches der kürzeren Objektlänge" - -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "" -"Programmierfehler: min() ohne erstes Argument hätte eher abgefangen sein " -"müssen" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "in Summary(, .): %s(<%s>, <%s>, ...)" - -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "in Summary(, .): %s(<%s>, <%s>)" - -msgid "you cannot mix negative and positive indices" -msgstr "Sie können positive und negative Indizes nicht mischen" - -msgid "index larger than maximal %d" -msgstr "Index größer als maximales %d" - -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "" -"'NA'-Indizes werden (noch?) nicht für dünn besetzte Matrizen unterstützt" - -msgid "logical subscript too long (%d, should be %d)" -msgstr "logisches Subskript zu lang (%d, sollte %d sein)" - -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "keine 'dimnames[[.]]': Zeichenindexierung kann nicht benutzt werden" - -msgid "invalid character indexing" -msgstr "ungültige Zeichenindexierung" - -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "interner Fehler: Fehlendes 'i' in replTmat(): Bitte berichten" - -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "[ ] Indexierung nicht erlaubt: Ein ',' vergessen?" - -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "interner Fehler: Matrix 'i' in replTmat(): Bitte berichten" - -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- val: x ist %s, val nicht in {TRUE, FALSE}, wird umgewandelt;\n" -"NA |--> TRUE." - -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "x[.] <- val: x ist %s, val nicht in {TRUE, FALSE}, wird umgewandelt." - -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[.,.] <- val: x ist %s, val nicht in {TRUE, FALSE} wird umgewandelt NA |--> " -"TRUE." - -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "x[.,.] <- val: x ist %s, val nicht in {TRUE, FALSE} wird umgewandelt" - -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "x[.,.] <- val : x wird von Tsparse* in CsparseMatrix umgewandelt" - -msgid "nargs() = %d should never happen; please report." -msgstr "nargs() = %d sollte niemals vorkommen. Bitte berichten." - -msgid "row indices must be <= nrow(.) which is %d" -msgstr "Zeilenindizes müssen <= nrow(.) sein, das ist %d" +msgid "intermediate 'r' is of type %s" +msgstr "Zwischenergebnis 'r' ist vom Typ %s" -msgid "column indices must be <= ncol(.) which is %d" -msgstr "Spaltenindizes müssen <= ncol(.) sein, das ist %d" +msgid "not yet implemented .. please report" +msgstr "noch nicht implementiert ... bitte melden" msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "'force' muss (umwandelbar nach) TRUE oder FALSE sein" @@ -374,67 +232,21 @@ msgid " --> is not yet implemented" msgstr " --> ist noch nicht implementiert" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "" - -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "'diagonals'-Matrix muss %d Spalten haben (= length(k) )" - -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagonals' muss die gleiche Länge (%d) wie 'k' haben" - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "" -"Matrix kann nur symmetrisch sein, wenn sie quadratisch ist, aber n != m" - -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"geben Sie für symmetrische Bandmatrizen nur oberes oder unteres Dreieck an.\n" -" deshalb müssen alle k dasselbe Vorzeichen haben." - -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "" -"die %d-te (Unter)-Diagonale (k = %d) ist zu kurz und wird mit NA aufgefüllt" - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "" - -#, fuzzy -msgid "number of rows of matrices must match" -msgstr "Anzahl der Zeilen ist nicht kompatibel für %s" - #, fuzzy -msgid "number of columns of matrices must match" -msgstr "Anzahl der Zeilen ist nicht kompatibel für %s" - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "resultierender x-slot hat einen anderen Typ als x oder y" - -#, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "chol() ist undefiniert für diagonale Matrix mit negativen Einträgen" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - #, fuzzy msgid "matrix is not square" msgstr "Matrix ist nicht diagonal" msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "'x' muss von \"sparseVector\" geerbt sein" msgid "D[i,i] is NA, i=%d" @@ -443,7 +255,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" #, fuzzy @@ -458,16 +270,22 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "ungültiger 'type'" -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "Ungültiger Speichertyp: %s" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "ungültige 'col.names'-Zeichenkette: %s" + +msgid "%s length cannot exceed %s" msgstr "" msgid "'A' must be a square matrix" @@ -491,26 +309,77 @@ msgid "not enough new vecs -- stop iterations" msgstr "nicht genügend neue Vektoren – Iterationen stoppen" +msgid "invalid 'data'" +msgstr "ungültiges 'data'" + #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "dim(.)-Wert muss numerisch sein und die Länge 2 haben" +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "'nrow', 'ncol', etc werden nicht für Matrix 'data' berücksichtigt" -msgid "dimensions cannot contain NA" +msgid "data is too long" msgstr "" -msgid "dimensions cannot contain negative values" +#, fuzzy +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgstr "exakt eins von 'i', 'j' oder 'p' muss im Aufruf fehlen" + +msgid "" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" msgstr "" -msgid "invalid nargs()= %d" -msgstr "ungültige nargs()= %d" +msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgstr "" -msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" msgstr "" -msgid "determinant of non-square matrix is undefined" +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p' muss ein nicht abnehmender Vektor (0, ...) sein" + +msgid "dimensions cannot exceed 2^31-1" +msgstr "" + +msgid "'i' and 'j' must not contain NA" +msgstr "" + +msgid "'i' and 'j' must be" +msgstr "" + +msgid "positive" +msgstr "" + +msgid "non-negative" +msgstr "" + +#, fuzzy +msgid "invalid 'dims'" +msgstr "ungültiges 'data'" + +msgid "'dims' must contain all (i,j) pairs" +msgstr "" + +msgid "symmetric matrix must be square" +msgstr "symmetrische Matrix muss quadratisch sein" + +msgid "triangular matrix must be square" +msgstr "Dreiecksmatrix muss quadratisch sein" + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "length(i) ist kein Vielfaches von length(x)" + +msgid "length(x) must not exceed" +msgstr "" + +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" msgstr "" #, fuzzy @@ -549,29 +418,118 @@ msgid "'lst' must be a list" msgstr "'ncol' muss >= 0 sein" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "" + +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "'diagonals'-Matrix muss %d Spalten haben (= length(k) )" + +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagonals' muss die gleiche Länge (%d) wie 'k' haben" + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "" +"Matrix kann nur symmetrisch sein, wenn sie quadratisch ist, aber n != m" + +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"geben Sie für symmetrische Bandmatrizen nur oberes oder unteres Dreieck an.\n" +" deshalb müssen alle k dasselbe Vorzeichen haben." + +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "" +"die %d-te (Unter)-Diagonale (k = %d) ist zu kurz und wird mit NA aufgefüllt" + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "" + +msgid "'x' must inherit from \"sparseVector\"" +msgstr "'x' muss von \"sparseVector\" geerbt sein" + +msgid "'ncol' must be >= 0" +msgstr "'ncol' muss >= 0 sein" + +msgid "'nrow' must be >= 0" +msgstr "'nrow' muss >= 0 sein" + +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "'nrow' muss angegeben werden, wenn 'symmetric' auf true gesetzt ist" + +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "" +"'nrow' und 'ncol' müssen gleich sein, wenn 'symmetric' auf true gesetzt ist" + +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "'x' muss die Länge nrow^2, wenn 'symmetric' auf true gesetzt ist" + +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol' ist kein Faktor von length(x)" + +msgid "'nrow' is not a factor of length(x)" +msgstr "'nrow' ist kein Faktor von length(x)" + +msgid "Class %s is not yet implemented" +msgstr "Klasse %s noch nicht implementiert" + +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "Länge muss eine nicht negative Zahl sein" + +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x' ist weder symmetrisch noch in Dreiecksform" + +#, fuzzy +msgid "matrix is not symmetric" +msgstr "die Matrix ist nicht dreieckig" + +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x' ist weder symmetrisch noch in Dreiecksform" + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" -msgstr "Interner Fehler: nargs()=%d; bitte melden" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -msgid "intermediate 'r' is of type %s" -msgstr "Zwischenergebnis 'r' ist vom Typ %s" +msgid "assigned dimensions do not have length %d" +msgstr "" -msgid "not yet implemented .. please report" -msgstr "noch nicht implementiert ... bitte melden" +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "dim [produkt %d] passt nicht zur Länge des Objekts [%d]" + +msgid "'%s' has non-finite values" +msgstr "" + +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" #, fuzzy @@ -584,33 +542,65 @@ msgstr "'lwd' muss NULL oder nicht negativ numerisch sein" #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A' muss eine quadratische Matrix sein" +msgid "%s(<%s>) is not yet implemented" +msgstr "Klasse %s noch nicht implementiert" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" +msgstr "" + +msgid "'%s' has elements less than %d" msgstr "" #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol' muss >= 0 sein" +msgid "'%s' is not a non-negative number" +msgstr "Länge muss eine nicht negative Zahl sein" + +msgid "'%s' has elements exceeding '%s'" +msgstr "" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' is not %d or %d" msgstr "" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol' ist kein Faktor von length(x)" + +#, fuzzy +msgid "matrix must have exactly one entry in each row or column" msgstr "muss genau einen Nicht-Null-Eintrag pro Zeile haben" #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" -msgstr "kronecker-Methode muss Standard 'FUN' benutzen" +msgid "attempt to coerce non-square matrix to %s" +msgstr "" +"nicht symmetrische \"dgTMatrix\" kann nicht in \"dsCMatrix\" Klasse " +"umgewandelt werden" -msgid "number of nonzero entries cannot exceed 2^31-1" +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "muss genau einen Nicht-Null-Eintrag pro Zeile haben" + +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "rcond(.) über Umwandlung dünn besetzt -> dicht besetzt" + +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "ungültige nargs()= %d" + +msgid "norm" msgstr "" +#, fuzzy +msgid "'%s' method must use default %s=\"%s\"" +msgstr "kronecker-Methode muss Standard 'FUN' benutzen" + +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "Anzahl der Zeilen ist nicht kompatibel für %s" + msgid "Matrix seems negative semi-definite" msgstr "Matrix scheint negativ semidefinit zu sein" @@ -618,62 +608,51 @@ msgstr "nearPD() ist nicht in %d Iterationen konvergiert" #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "rcond(.) über Umwandlung dünn besetzt -> dicht besetzt" - -msgid "invalid 'type'" -msgstr "ungültiger 'type'" +msgid "'cl' is not a character string" +msgstr "'V' ist keine *quadratische* Matrix" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "" -"nicht symmetrische \"dgTMatrix\" kann nicht in \"dsCMatrix\" Klasse " -"umgewandelt werden" +msgid "'%s' is not a square numeric matrix" +msgstr "'V' ist keine *quadratische* Matrix" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "muss genau einen Nicht-Null-Eintrag pro Zeile haben" - -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "noch nicht implementierte Methode für <%s> %%*%% <%s>" +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "" +"diag(.) hatte 0 oder NA Einträge. Nicht-endliches Ergebnis ist zweifelhaft" msgid "non-conformable arguments" msgstr "nicht passende Argumente" -msgid "'boolArith = %d' not yet implemented" -msgstr "'boolArith = %d' noch nicht implementiert" - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" #, fuzzy -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "RHS 'b' hat falsche Länge" #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "ungültige 'col.names'-Zeichenkette: %s" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "" "qr2rankMatrix(.): QR Zerlegung mit nur %d von %d endlichen diag(R) Werten" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "qr2rankMatrix(.): QR enthält negative diag(R) Werte" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -684,28 +663,46 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr'): t(x) berechnet, da nrow(x) < ncol(x)" -msgid "rcond(x) is undefined: 'x' has length 0" -msgstr "" - #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "rcond(.) über Umwandlung dünn besetzt -> dicht besetzt" +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ unterdrücke %d Spaltennamen %s ...]]" + +msgid "invalid 'col.names' string: %s" +msgstr "ungültige 'col.names'-Zeichenkette: %s" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgstr "uniDiag=TRUE, aber nicht alle Diagonaleinträge sind 1" + +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgstr "uniDiag=TRUE, aber nicht alle Einträge der Diagonalen als 1 kodiert" #, fuzzy -msgid "invalid 'norm'" -msgstr "ungültiges 'data'" +msgid "in show(); maybe adjust options(max.print=, width=)" +msgstr "in show(); evtl. 'options(max.print= *, width= *)' anpassen" + +msgid "suppressing %d columns and %d rows" +msgstr "%d Spalten und %d Zeilen werden unterdrückt" + +msgid "suppressing %d rows" +msgstr "%d Zeilen werden unterdrückt" + +msgid "suppressing %d columns" +msgstr "%d Spalten werden unterdrückt" + +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "logischer Programmierfehler in printSpMatrix2(), bitte berichten" #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V' ist keine quadratische Matrix" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -717,13 +714,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" -msgstr "'NA's können nicht in \"ngCMatrix\" umgewandelt werden" - -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "Kann NAs nicht in 'nsparseVector' umwandeln" +msgid "cannot coerce from %s to %s" +msgstr "" #, fuzzy msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -740,142 +732,156 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "Variable '%s' fehlt, ihr Kontrast wird irgnoriert" -#, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "exakt eins von 'i', 'j' oder 'p' muss im Aufruf fehlen" - -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" msgstr "" +"eine schwach besetze Matrix sollte kaum je zentriert werden: sie ist dann " +"nicht mehr schwach besetzt" -msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "Länge von 'center' muss der Spaltenzahl von 'x' entsprechen" + +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "Länge von 'scale' muss der Spaltenzahl von 'x' entsprechen" + +msgid "trimmed means are not defined for complex data" msgstr "" -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgid "first element used of '%s' argument" msgstr "" #, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p' muss ein nicht abnehmender Vektor (0, ...) sein" +msgid "invalid '%s' argument" +msgstr "ungültiges 'data'" -msgid "'i' and 'j' must not contain NA" -msgstr "" +#, fuzzy +msgid "should never happen ..." +msgstr "Sollte niemals vorkommen. Bitte berichten." -msgid "'i' and 'j' must be" +msgid "'%s' is deprecated; using '%s' instead" msgstr "" -msgid "positive" +msgid "'%s' is deprecated; setting %s=\"%s\"" msgstr "" -msgid "non-negative" +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col(): 'i' hat keine ganzzahlige Spaltennummer.\n" +"Sollte nie passieren. Bitte melden." -#, fuzzy -msgid "invalid 'dims'" -msgstr "ungültiges 'data'" - -msgid "'dims' must contain all (i,j) pairs" +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" +"solche Indexierung muss von logischer oder 2-spaltig numerischer Matrix sein" -msgid "symmetric matrix must be square" -msgstr "symmetrische Matrix muss quadratisch sein" +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col(): 'matrix'-Fall weglassen ..." -msgid "triangular matrix must be square" -msgstr "Dreiecksmatrix muss quadratisch sein" +msgid "negative values are not allowed in a matrix subscript" +msgstr "negative Werte sind in einer Matrix-Subskript nicht erlaubt" -msgid "p[length(p)]" -msgstr "" +msgid "NAs are not allowed in subscripted assignments" +msgstr "NAs sind in indexierten Anweisungen nicht erlaubt" -msgid "length(i)" +msgid "number of items to replace is not a multiple of replacement length" msgstr "" +"Anzahl der zu ersetzenden Elemente ist kein Vielfaches der Austauschlänge" -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "length(i) ist kein Vielfaches von length(x)" +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v: Einzelne Elemente ineffizient behandelt" -msgid "length(x) must not exceed" -msgstr "" +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. Irrelevante ungültige Argumente innerhalb '[ .. ]'?" -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"RHS 'value' (Klasse %s) passt zu 'ANY', muss aber zur Matrixklasse %s passen" -msgid "invalid 'col.names' string: %s" -msgstr "ungültige 'col.names'-Zeichenkette: %s" +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "noch nicht implementierte 'Matrix[<-'-Methode" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "uniDiag=TRUE, aber nicht alle Diagonaleinträge sind 1" +msgid "invalid nargs()= %d" +msgstr "ungültige nargs()= %d" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" -msgstr "uniDiag=TRUE, aber nicht alle Einträge der Diagonalen als 1 kodiert" +msgid "nothing to replace with" +msgstr "nichts zu ersetzen mit" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" -msgstr "in show(); evtl. 'options(max.print= *, width= *)' anpassen" +msgid "too many replacement values" +msgstr "zu viele Austauschwerte" -msgid "suppressing %d columns and %d rows" -msgstr "%d Spalten und %d Zeilen werden unterdrückt" +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" +msgstr "i1[1] == 0 ==> C-Ebene wird nicht detailliert sein!" -msgid "suppressing %d rows" -msgstr "%d Zeilen werden unterdrückt" +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "benutzt wird\t 'alter Kode'-Teil in Csparse-Unterzuweisung" -msgid "suppressing %d columns" -msgstr "%d Spalten werden unterdrückt" +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" +msgstr "" +"benutzt wird 'alter Kode'-Teil in Csparse-Unterzuweisung\n" +" >>> bitte an Matrix-authors@r-project.org berichten" -msgid "logic programming error in printSpMatrix2(), please report" -msgstr "logischer Programmierfehler in printSpMatrix2(), bitte berichten" +msgid "you cannot mix negative and positive indices" +msgstr "Sie können positive und negative Indizes nicht mischen" -msgid "'V' is not a *square* matrix" -msgstr "'V' ist keine *quadratische* Matrix" +msgid "index larger than maximal %d" +msgstr "Index größer als maximales %d" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" msgstr "" -"diag(.) hatte 0 oder NA Einträge. Nicht-endliches Ergebnis ist zweifelhaft" +"'NA'-Indizes werden (noch?) nicht für dünn besetzte Matrizen unterstützt" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" -msgstr "Anzahl von Nicht-Nullen ist kleiner als 'nnz' wegen doppelter (i,j)s" +msgid "logical subscript too long (%d, should be %d)" +msgstr "logisches Subskript zu lang (%d, sollte %d sein)" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" -msgstr "" -"eine schwach besetze Matrix sollte kaum je zentriert werden: sie ist dann " -"nicht mehr schwach besetzt" +msgid "no 'dimnames[[.]]': cannot use character indexing" +msgstr "keine 'dimnames[[.]]': Zeichenindexierung kann nicht benutzt werden" -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "Länge von 'center' muss der Spaltenzahl von 'x' entsprechen" +msgid "invalid character indexing" +msgstr "ungültige Zeichenindexierung" -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "Länge von 'scale' muss der Spaltenzahl von 'x' entsprechen" +msgid "internal bug: missing 'i' in replTmat(): please report" +msgstr "interner Fehler: Fehlendes 'i' in replTmat(): Bitte berichten" -msgid "'x' must inherit from \"sparseVector\"" -msgstr "'x' muss von \"sparseVector\" geerbt sein" +msgid "[ ] indexing not allowed: forgot a \",\" ?" +msgstr "[ ] Indexierung nicht erlaubt: Ein ',' vergessen?" -msgid "'ncol' must be >= 0" -msgstr "'ncol' muss >= 0 sein" +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "interner Fehler: Matrix 'i' in replTmat(): Bitte berichten" -msgid "'nrow' must be >= 0" -msgstr "'nrow' muss >= 0 sein" +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- val: x ist %s, val nicht in {TRUE, FALSE}, wird umgewandelt;\n" +"NA |--> TRUE." -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "'nrow' muss angegeben werden, wenn 'symmetric' auf true gesetzt ist" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "x[.] <- val: x ist %s, val nicht in {TRUE, FALSE}, wird umgewandelt." -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." msgstr "" -"'nrow' und 'ncol' müssen gleich sein, wenn 'symmetric' auf true gesetzt ist" +"x[.,.] <- val: x ist %s, val nicht in {TRUE, FALSE} wird umgewandelt NA |--> " +"TRUE." -msgid "'x' must have length nrow^2 when 'symmetric' is true" -msgstr "'x' muss die Länge nrow^2, wenn 'symmetric' auf true gesetzt ist" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "x[.,.] <- val: x ist %s, val nicht in {TRUE, FALSE} wird umgewandelt" -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol' ist kein Faktor von length(x)" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgstr "x[.,.] <- val : x wird von Tsparse* in CsparseMatrix umgewandelt" -msgid "'nrow' is not a factor of length(x)" -msgstr "'nrow' ist kein Faktor von length(x)" +msgid "nargs() = %d should never happen; please report." +msgstr "nargs() = %d sollte niemals vorkommen. Bitte berichten." -msgid "Class %s is not yet implemented" -msgstr "Klasse %s noch nicht implementiert" +msgid "row indices must be <= nrow(.) which is %d" +msgstr "Zeilenindizes müssen <= nrow(.) sein, das ist %d" -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +msgid "column indices must be <= ncol(.) which is %d" +msgstr "Spaltenindizes müssen <= ncol(.) sein, das ist %d" + +msgid "Internal bug: nargs()=%d; please report" +msgstr "Interner Fehler: nargs()=%d; bitte melden" msgid "" "index must be numeric, logical or sparseVector for indexing sparseVectors" @@ -883,12 +889,6 @@ "Index muss numerisch, logisch oder sparseVector sein, um sparseVector zu " "indizieren" -msgid "'times >= 0' is required" -msgstr "'times >= 0' wird benötigt" - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "" - #, fuzzy msgid "invalid subscript class \"%s\"" msgstr "ungültige Klasse: %s" @@ -897,10 +897,10 @@ msgid "invalid subscript type \"%s\"" msgstr "Ungültiger Speichertyp: %s" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -914,25 +914,129 @@ msgid "incorrect number of dimensions" msgstr "inkompatible Matrixdimensionen" -#, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x' ist weder symmetrisch noch in Dreiecksform" +msgid "only zeros may be mixed with negative subscripts" +msgstr "" -#, fuzzy -msgid "matrix is not symmetric" -msgstr "die Matrix ist nicht dreieckig" +msgid "'%s' has length 0 but '%s' does not" +msgstr "" #, fuzzy -msgid "matrix is not triangular" -msgstr "'x' ist weder symmetrisch noch in Dreiecksform" - -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" +"nicht symmetrische \"dgTMatrix\" kann nicht in \"dsCMatrix\" Klasse " +"umgewandelt werden" #, fuzzy msgid "invalid 'Class2'" msgstr "ungültiges 'data'" +#~ msgid "qr2rankMatrix(.): QR has negative diag(R) entries" +#~ msgstr "qr2rankMatrix(.): QR enthält negative diag(R) Werte" + +#, fuzzy +#~ msgid "invalid 'each' argument" +#~ msgstr "falsches Vorzeichen im Argument 'by'" + +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "ungültiges 'data'" + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "noch nicht implementierte Methode für %s(<%s>).\n" +#~ " ->> Bitten Sie die Autoren des Pakets, diese fehlende Funktion zu " +#~ "implementieren." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "noch nicht implementierte Methode für %s(<%s>, <%s>).\n" +#~ " ->> Bitten Sie die Autoren des Pakets, diese fehlende Funktion zu " +#~ "implementieren." + +#, fuzzy +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "allgemeine Matrixklasse noch nicht implementiert für %s" + +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "noch nicht implementiert für Klasse %s" + +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "ungültiger 'type'" + +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag' und 'differences' müssen ganze Zahlen >=1 sein" + +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "" +#~ "Programmierfehler: min() ohne erstes Argument hätte eher abgefangen sein " +#~ "müssen" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>, ...)" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>)" + +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "Anzahl der Zeilen ist nicht kompatibel für %s" + +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "Anzahl der Zeilen ist nicht kompatibel für %s" + +#~ msgid "resulting x-slot has different type than x's or y's" +#~ msgstr "resultierender x-slot hat einen anderen Typ als x oder y" + +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "dim(.)-Wert muss numerisch sein und die Länge 2 haben" + +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A' muss eine quadratische Matrix sein" + +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol' muss >= 0 sein" + +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "noch nicht implementierte Methode für <%s> %%*%% <%s>" + +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "'boolArith = %d' noch nicht implementiert" + +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "rcond(.) über Umwandlung dünn besetzt -> dicht besetzt" + +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "ungültiges 'data'" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "'NA's können nicht in \"ngCMatrix\" umgewandelt werden" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "Kann NAs nicht in 'nsparseVector' umwandeln" + +#~ msgid "" +#~ "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +#~ msgstr "" +#~ "Anzahl von Nicht-Nullen ist kleiner als 'nnz' wegen doppelter (i,j)s" + +#~ msgid "'times >= 0' is required" +#~ msgstr "'times >= 0' wird benötigt" + #~ msgid "Matrices must have same number of rows in %s" #~ msgstr "Matrizen müssen die gleiche Anzahl Zeilen in %s haben" @@ -1289,9 +1393,6 @@ #~ msgid ", ..." #~ msgstr ", ..." -#~ msgid "should never happen; please report" -#~ msgstr "Sollte niemals vorkommen. Bitte berichten." - #~ msgid "" #~ msgstr "" diff -Nru rmatrix-1.6-1.1/po/R-fr.po rmatrix-1.6-5/po/R-fr.po --- rmatrix-1.6-1.1/po/R-fr.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-fr.po 2023-11-03 01:34:40.000000000 +0000 @@ -1,7 +1,7 @@ msgid "" msgstr "" "Project-Id-Version: Matrix 1.1-1\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2021-02-11 11:04+0100\n" "Last-Translator: Philippe Grosjean \n" "Language-Team: none\n" @@ -12,83 +12,35 @@ "X-Generator: Poedit 2.4.2\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "'mod' incorrect : %s" msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"méthode non encore implémentée pour %s(<%s>).\n" -" ->> Demandez aux auteurs du package d'implémenter cette fonction manquante." - -msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"méthode non encore implémentée pour %s(<%s>, <%s>).\n" -" ->> Demandez aux auteurs du package d'implémenter cette fonction manquante." - -msgid "non-conformable matrix dimensions in %s" -msgstr "matrices de dimensions incompatibles dans %s" #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "classe Matrix générale pas encore implémentée pour %s" +msgid "complex %s not yet implemented" +msgstr "La classe %s n'est pas encore implémentée" #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "impossible de convertir automatiquement des 'NA's en \"nsparseMatrix\"" #, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ suppression de %d noms de colonnes %s … ]]" - -#, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "pas encore implémenté pour la classe %s" -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "pas encore implémenté pour la classe %s" - -#, fuzzy -msgid "invalid 'uplo'" -msgstr "'type' invalide" - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "nothing to replace with" -msgstr "rien à remplacer avec" - -msgid "number of items to replace is not a multiple of replacement length" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"le nombre d'éléments à remplacer n'est pas un multiple de la longueur de " -"remplacement" - -msgid "too many replacement values" -msgstr "trop de valeurs de remplacement" - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "" -"i1[1] == 0 ==> au niveau C, aucune information détaillée ne sera affichée !" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "" -"utilisation d'une partie\t d'\"ancien code\" dans une sous-assignation " -"Csparse" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" -msgstr "" -"utilisation d'une partie d'\"ancien code\" dans une sous-assignation " -"Csparse\n" -" >>> veuillez envoyer un rapport à Matrix-authors@r-project.org" msgid "Not a valid format" msgstr "Pas un format acceptable" @@ -155,60 +107,28 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "'%s' n'est pas encore implémenté pour la représentation '%s'" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" -msgstr "" - -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" -msgstr "" - -msgid "invalid 'data'" -msgstr "'data' incorrect" - -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "'nrow', 'ncol', etc, ne sont pas utilisés pour la matrice 'data'" - -msgid "data is too long" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag' et 'differences' doivent être des entiers >= 1" - msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -".M.repl.i.2col() : 'i' n'a\tpas un nombre entier de colonnes ;\n" -" ceci ne devrait pas se produite. Veuillez envoyer un rapport de bogue" -msgid "such indexing must be by logical or 2-column numeric matrix" -msgstr "" -"un tel indiçage doit être réalisé avec un vecteur booléen ou une matrice " -"numérique à deux colonnes" - -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col() : cas 'matrix' non traité ..." - -msgid "negative values are not allowed in a matrix subscript" +msgid "longer object length is not a multiple of shorter object length" msgstr "" -"les valeurs négatives ne sont pas permises dans les indices de matrices" - -msgid "NAs are not allowed in subscripted assignments" -msgstr "Les NAs ne sont pas autorisés dans les assignations avec indices" - -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v : traitement inefficace d'éléments uniques" +"la longueur de l'objet le plus long n'est pas un multiple de la longueur de " +"l'objet le plus court" -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. Arguments supplémentaires dans '[ .. ]' illégaux ?" +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "chaîne de caractères 'col.names' incorrecte : %s" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"La 'value' du membre gauche de l'équation (classe %s) correspond à 'ANY', " -"mais doit correspondre à la classe de matrice %s" -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "méthode 'Matrix[<-' non encore implémentée" +msgid "non-conformable matrix dimensions in %s" +msgstr "matrices de dimensions incompatibles dans %s" msgid "dimnames [%d] mismatch in %s" msgstr "dimnames [%d] incohérentes dans %s" @@ -259,87 +179,11 @@ "la longueur de l'objet le plus long\n" "\tn'est pas un multiple de la longueur de l'objet le plus court" -msgid "longer object length is not a multiple of shorter object length" -msgstr "" -"la longueur de l'objet le plus long n'est pas un multiple de la longueur de " -"l'objet le plus court" - -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "" -"erreur de programmation : min() aurait dû être dispatché avec le 1er arg " -"bien plus tôt" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "dans Summary() : %s(<%s>, <%s>, …)" - -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "dans Summary(, ) : %s(<%s>, <%s>)" - -msgid "you cannot mix negative and positive indices" -msgstr "vous ne pouvez pas mélanger des indices négatifs et positifs" - -msgid "index larger than maximal %d" -msgstr "indice plus grand que la valeur maximale %d" - -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "" -"les indices 'NA' ne sont pas (encore?) supportés pour les Matrices éparses" - -msgid "logical subscript too long (%d, should be %d)" -msgstr "indice logique trop long (%d, devrait être %d)" - -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "" -"pas de 'dimnames[[.]]' : impossible d'utiliser un indiçage de chaîne de " -"caractères" - -msgid "invalid character indexing" -msgstr "indiçage de chaînes de caractères incorrect" - -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "bogue interne : 'i' manquant dans replTmat() : veuillez reporter ceci" - -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "" -"indiçage [ ] non permis : n'avez-vous pas oublié une \",\" ?" - -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "bogue interne : matrice 'i' dans replTmat() : veuillez reporter ceci" - -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " -"convertis ; NA |--> TRUE." - -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " -"convertis." - -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[.,.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " -"convertis NA |--> TRUE." - -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.,.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " -"convertis." - -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "" -"x[.,.] <- val: x est converti automatiquement de Tsparse* vers CsparseMatrix" - -msgid "nargs() = %d should never happen; please report." -msgstr "nargs() = %d ne devrait jamais se produire ; veuillez reporter ceci." - -msgid "row indices must be <= nrow(.) which is %d" -msgstr "les indices de lignes doivent être <= nrow(.) qui est %d" +msgid "intermediate 'r' is of type %s" +msgstr "le 'r' intermédiaire est de type %s" -msgid "column indices must be <= ncol(.) which is %d" -msgstr "les indices de colonnes doivent être <= ncol(.) qui est %d" +msgid "not yet implemented .. please report" +msgstr "pas encore implémenté .. veuillez reporter ceci" msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "'force' doit être (convertible en) TRUE ou FALSE" @@ -392,70 +236,22 @@ msgid " --> is not yet implemented" msgstr " --> n'est pas encore implémenté" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"T\"' pour vous" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "‘giveCsparse’ est obsolète ; utilisation de 'repr' à la place" - -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "une matrice 'diagonals' doit avoir %d colonnes (= length(k) )" - -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagonals' doit avoir la même longueur (%d) que 'k'" - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "" -"une matrice peut seulement être symétrique si elle est carrée, mais n != m" - -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"pour une matrice de bande symétrique, spécifiez seulement le triangle " -"supérieur ou inférieur\n" -" donc, tous les k doivent avoir le même signe" - -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "" -"la %d-ième (sous)-diagonale (k = %d) est trop courte ; elle est repliée avec " -"des NAs" - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "'repr' incorrect ; il doit être \"C\", \"T\", ou \"R\"" - #, fuzzy -msgid "number of rows of matrices must match" -msgstr "nombre incompatible de lignes pour %s" - -#, fuzzy -msgid "number of columns of matrices must match" -msgstr "nombre incompatible de lignes pour %s" - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "le slot x résultant a un type différent que celui des x ou des y" - -#, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "" "chol() est indéfini pour une matrice diagonale avec des entrées négatives" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - #, fuzzy msgid "matrix is not square" msgstr "la matrice n'est pas diagonale" msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "'x' doit hériter de \"sparseVector\"" msgid "D[i,i] is NA, i=%d" @@ -464,7 +260,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" #, fuzzy @@ -480,16 +276,22 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "'type' invalide" -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "Type de stockage incorrect : %s" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "chaîne de caractères 'col.names' incorrecte : %s" + +msgid "%s length cannot exceed %s" msgstr "" msgid "'A' must be a square matrix" @@ -513,28 +315,83 @@ msgid "not enough new vecs -- stop iterations" msgstr "pas assez de nouveaux vecs -- arrêt des itérations" +msgid "invalid 'data'" +msgstr "'data' incorrect" + #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "la valeur de dim(.) doit être numérique de longueur 2" +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "'nrow', 'ncol', etc, ne sont pas utilisés pour la matrice 'data'" -msgid "dimensions cannot contain NA" +msgid "data is too long" msgstr "" -msgid "dimensions cannot contain negative values" +#, fuzzy +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" msgstr "" - -msgid "invalid nargs()= %d" -msgstr "nargs()= %d incorrect" +"exactement une valeur parmi 'i', 'j' ou 'p' doit être manquante dans l'appel" msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" msgstr "" -msgid "determinant of non-square matrix is undefined" +#, fuzzy +msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgstr "‘giveCsparse’ est obsolète ; utilisation de 'repr' à la place" + +#, fuzzy +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"T\"' pour vous" + +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p' doit être un vecteur non décroissant (0, ...)" + +msgid "dimensions cannot exceed 2^31-1" +msgstr "" + +msgid "'i' and 'j' must not contain NA" +msgstr "" + +msgid "'i' and 'j' must be" +msgstr "" + +msgid "positive" +msgstr "" + +msgid "non-negative" +msgstr "" + +#, fuzzy +msgid "invalid 'dims'" +msgstr "'data' incorrect" + +msgid "'dims' must contain all (i,j) pairs" msgstr "" +msgid "symmetric matrix must be square" +msgstr "la matrice symétrique doit être carrée" + +msgid "triangular matrix must be square" +msgstr "la matrice triangulaire doit être carrée" + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "length(i) n'est pas un multiple de length(x)" + +msgid "length(x) must not exceed" +msgstr "" + +#, fuzzy +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgstr "'repr' incorrect ; il doit être \"C\", \"T\", ou \"R\"" + #, fuzzy msgid "'n' must be a non-negative integer" msgstr "la longueur doit être un nombre non négatif" @@ -573,29 +430,119 @@ msgid "'lst' must be a list" msgstr "'ncol' doit être >= 0" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"T\"' pour vous" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "‘giveCsparse’ est obsolète ; utilisation de 'repr' à la place" + +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "une matrice 'diagonals' doit avoir %d colonnes (= length(k) )" + +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagonals' doit avoir la même longueur (%d) que 'k'" + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "" +"une matrice peut seulement être symétrique si elle est carrée, mais n != m" + +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"pour une matrice de bande symétrique, spécifiez seulement le triangle " +"supérieur ou inférieur\n" +" donc, tous les k doivent avoir le même signe" + +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "" +"la %d-ième (sous)-diagonale (k = %d) est trop courte ; elle est repliée avec " +"des NAs" + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "'repr' incorrect ; il doit être \"C\", \"T\", ou \"R\"" + +msgid "'x' must inherit from \"sparseVector\"" +msgstr "'x' doit hériter de \"sparseVector\"" + +msgid "'ncol' must be >= 0" +msgstr "'ncol' doit être >= 0" + +msgid "'nrow' must be >= 0" +msgstr "'nrow' doit être >= 0" + +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "Il faut spécifier 'nrow' lorsque 'symmetric' est vrai" + +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "'now' et 'ncol' doivent être les mêmes lorsque 'symmetric' est vrai" + +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "'x' doit avoir une longueur nrow^2 lorsque 'symmetric' est vrai" + +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol' n'est pas un factor de length(x)" + +msgid "'nrow' is not a factor of length(x)" +msgstr "'nrow' n'est pas un factor de length(x)" + +msgid "Class %s is not yet implemented" +msgstr "La classe %s n'est pas encore implémentée" + +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "la longueur doit être un nombre non négatif" + +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x' n'est ni symétrique ni triangulaire" + +#, fuzzy +msgid "matrix is not symmetric" +msgstr "la matrice n'est pas triangulaire" + +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x' n'est ni symétrique ni triangulaire" + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" -msgstr "Bogue interne : nargs()=%d ; veuillez reporter ceci" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -msgid "intermediate 'r' is of type %s" -msgstr "le 'r' intermédiaire est de type %s" +msgid "assigned dimensions do not have length %d" +msgstr "" -msgid "not yet implemented .. please report" -msgstr "pas encore implémenté .. veuillez reporter ceci" +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "dim [product %d] ne correspond pas à la longueur de l'objet [%d]" + +msgid "'%s' has non-finite values" +msgstr "" + +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" #, fuzzy @@ -608,33 +555,65 @@ msgstr "'lwd' doit être un nombre non négatif ou NULL" #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A' doit être une matrice carrée" +msgid "%s(<%s>) is not yet implemented" +msgstr "La classe %s n'est pas encore implémentée" + +msgid "'%s' is not of type \"%s\" or \"%s\"" +msgstr "" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' contains NA" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' has elements less than %d" msgstr "" #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol' doit être >= 0" +msgid "'%s' is not a non-negative number" +msgstr "la longueur doit être un nombre non négatif" + +msgid "'%s' has elements exceeding '%s'" +msgstr "" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' is not %d or %d" msgstr "" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol' n'est pas un factor de length(x)" + +#, fuzzy +msgid "matrix must have exactly one entry in each row or column" msgstr "doit avoir exactement une entrée non zéro par ligne" #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" -msgstr "méthode kronecker doit utiliser une 'FUN' par défaut" +msgid "attempt to coerce non-square matrix to %s" +msgstr "" +"impossible de convertir automatiquement des \"dgMAtrix\" non symétriques en " +"classe \"dsCMatrix\"" -msgid "number of nonzero entries cannot exceed 2^31-1" +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "doit avoir exactement une entrée non zéro par ligne" + +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "conversion automatique rcond(.) via sparse -> dense" + +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "nargs()= %d incorrect" + +msgid "norm" msgstr "" +#, fuzzy +msgid "'%s' method must use default %s=\"%s\"" +msgstr "méthode kronecker doit utiliser une 'FUN' par défaut" + +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "nombre incompatible de lignes pour %s" + msgid "Matrix seems negative semi-definite" msgstr "La matrice semble négative et semi-définie" @@ -642,61 +621,49 @@ msgstr "'nearPD()' n'a pas converti en %d itérations" #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "conversion automatique rcond(.) via sparse -> dense" - -msgid "invalid 'type'" -msgstr "'type' invalide" +msgid "'cl' is not a character string" +msgstr "'V' n'est pas une matrice *carrée*" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "" -"impossible de convertir automatiquement des \"dgMAtrix\" non symétriques en " -"classe \"dsCMatrix\"" +msgid "'%s' is not a square numeric matrix" +msgstr "'V' n'est pas une matrice *carrée*" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "doit avoir exactement une entrée non zéro par ligne" - -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "méthode pas encore implémentée pour <%s> %%*%% <%s>" +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "diag(.) avait 0 ou NA données ; un résultat non fini est douteux" msgid "non-conformable arguments" msgstr "matrices de dimensions incompatibles dans les arguments" -msgid "'boolArith = %d' not yet implemented" -msgstr "'boolArith = %d' n'est pas encore implémenté" - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" #, fuzzy -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "Le membre droit 'b' est de longueur incorrecte" #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "chaîne de caractères 'col.names' incorrecte : %s" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "qr2rankMatrix(.): QR avec seulement %d de %d entrées finies de diag(R)" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "qr2rankMatrix(.): QR a des entrées négatives dans diag(R)" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -708,28 +675,48 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr') : calcul de t(x) comme nrow(x) < ncol(x)" -msgid "rcond(x) is undefined: 'x' has length 0" +#, fuzzy +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ suppression de %d noms de colonnes %s … ]]" + +msgid "invalid 'col.names' string: %s" +msgstr "chaîne de caractères 'col.names' incorrecte : %s" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgstr "uniDiag=TRUE, mais pas toutes les entrées diagonales sont à 1" + +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" msgstr "" +"uniDiag=TRUE, toutes les entrées de la diagonale ne sont pas encodées à 1" #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "conversion automatique rcond(.) via sparse -> dense" +msgid "in show(); maybe adjust options(max.print=, width=)" +msgstr "dans show() ; ajustez peut-être 'options(max.print= *, width = *)'" -#, fuzzy -msgid "invalid 'norm'" -msgstr "'data' incorrect" +msgid "suppressing %d columns and %d rows" +msgstr "suppression de %d colonnes et %d lignes" + +msgid "suppressing %d rows" +msgstr "suppression de %d lignes" + +msgid "suppressing %d columns" +msgstr "suppression de %d colonnes" + +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "" +"erreur logique de programmation dans printSpMAtrix2(), veuillez reporter ceci" #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V' n'est pas une matrice carrée" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -741,14 +728,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" +msgid "cannot coerce from %s to %s" msgstr "" -"impossible de convertir automatiquement des 'NA's en modèle \"ngCMatrix\"" - -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "impossible de convertir automatiquement les 'NA's en \"nsparseVector\"" #, fuzzy msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -766,148 +747,173 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "la variable '%s' est absente, ses contrastes seront ignorés" -#, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" msgstr "" -"exactement une valeur parmi 'i', 'j' ou 'p' doit être manquante dans l'appel" +"une sparseMatrix doit rarement être centrée : elle ne sera plus éparse " +"ensuite" -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "la longueur de 'center' doit être égale au nombre de colonnes de 'x'" + +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "la longueur de 'scale' doit être égale au nombre de colonnes de 'x'" + +msgid "trimmed means are not defined for complex data" +msgstr "" + +msgid "first element used of '%s' argument" msgstr "" #, fuzzy -msgid "'giveCsparse' is deprecated; using 'repr' instead" -msgstr "‘giveCsparse’ est obsolète ; utilisation de 'repr' à la place" +msgid "invalid '%s' argument" +msgstr "'data' incorrect" + +msgid "should never happen ..." +msgstr "" #, fuzzy -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" -msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"T\"' pour vous" +msgid "'%s' is deprecated; using '%s' instead" +msgstr "‘giveCsparse’ est obsolète ; utilisation de 'repr' à la place" #, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p' doit être un vecteur non décroissant (0, ...)" +msgid "'%s' is deprecated; setting %s=\"%s\"" +msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"T\"' pour vous" -msgid "'i' and 'j' must not contain NA" +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col() : 'i' n'a\tpas un nombre entier de colonnes ;\n" +" ceci ne devrait pas se produite. Veuillez envoyer un rapport de bogue" -msgid "'i' and 'j' must be" +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" +"un tel indiçage doit être réalisé avec un vecteur booléen ou une matrice " +"numérique à deux colonnes" -msgid "positive" -msgstr "" +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col() : cas 'matrix' non traité ..." -msgid "non-negative" +msgid "negative values are not allowed in a matrix subscript" msgstr "" +"les valeurs négatives ne sont pas permises dans les indices de matrices" -#, fuzzy -msgid "invalid 'dims'" -msgstr "'data' incorrect" +msgid "NAs are not allowed in subscripted assignments" +msgstr "Les NAs ne sont pas autorisés dans les assignations avec indices" -msgid "'dims' must contain all (i,j) pairs" +msgid "number of items to replace is not a multiple of replacement length" msgstr "" +"le nombre d'éléments à remplacer n'est pas un multiple de la longueur de " +"remplacement" -msgid "symmetric matrix must be square" -msgstr "la matrice symétrique doit être carrée" - -msgid "triangular matrix must be square" -msgstr "la matrice triangulaire doit être carrée" +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v : traitement inefficace d'éléments uniques" -msgid "p[length(p)]" -msgstr "" +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. Arguments supplémentaires dans '[ .. ]' illégaux ?" -msgid "length(i)" +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"La 'value' du membre gauche de l'équation (classe %s) correspond à 'ANY', " +"mais doit correspondre à la classe de matrice %s" -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "length(i) n'est pas un multiple de length(x)" - -msgid "length(x) must not exceed" -msgstr "" +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "méthode 'Matrix[<-' non encore implémentée" -#, fuzzy -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" -msgstr "'repr' incorrect ; il doit être \"C\", \"T\", ou \"R\"" +msgid "invalid nargs()= %d" +msgstr "nargs()= %d incorrect" -msgid "invalid 'col.names' string: %s" -msgstr "chaîne de caractères 'col.names' incorrecte : %s" +msgid "nothing to replace with" +msgstr "rien à remplacer avec" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "uniDiag=TRUE, mais pas toutes les entrées diagonales sont à 1" +msgid "too many replacement values" +msgstr "trop de valeurs de remplacement" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" msgstr "" -"uniDiag=TRUE, toutes les entrées de la diagonale ne sont pas encodées à 1" +"i1[1] == 0 ==> au niveau C, aucune information détaillée ne sera affichée !" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" -msgstr "dans show() ; ajustez peut-être 'options(max.print= *, width = *)'" +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "" +"utilisation d'une partie\t d'\"ancien code\" dans une sous-assignation " +"Csparse" -msgid "suppressing %d columns and %d rows" -msgstr "suppression de %d colonnes et %d lignes" +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" +msgstr "" +"utilisation d'une partie d'\"ancien code\" dans une sous-assignation " +"Csparse\n" +" >>> veuillez envoyer un rapport à Matrix-authors@r-project.org" -msgid "suppressing %d rows" -msgstr "suppression de %d lignes" +msgid "you cannot mix negative and positive indices" +msgstr "vous ne pouvez pas mélanger des indices négatifs et positifs" -msgid "suppressing %d columns" -msgstr "suppression de %d colonnes" +msgid "index larger than maximal %d" +msgstr "indice plus grand que la valeur maximale %d" -msgid "logic programming error in printSpMatrix2(), please report" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" msgstr "" -"erreur logique de programmation dans printSpMAtrix2(), veuillez reporter ceci" - -msgid "'V' is not a *square* matrix" -msgstr "'V' n'est pas une matrice *carrée*" +"les indices 'NA' ne sont pas (encore?) supportés pour les Matrices éparses" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" -msgstr "diag(.) avait 0 ou NA données ; un résultat non fini est douteux" +msgid "logical subscript too long (%d, should be %d)" +msgstr "indice logique trop long (%d, devrait être %d)" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +msgid "no 'dimnames[[.]]': cannot use character indexing" msgstr "" -"le nombre de valeurs non nulles est plus petit que 'nnz' à cause de (i,j) " -"dupliqués" +"pas de 'dimnames[[.]]' : impossible d'utiliser un indiçage de chaîne de " +"caractères" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" -msgstr "" -"une sparseMatrix doit rarement être centrée : elle ne sera plus éparse " -"ensuite" +msgid "invalid character indexing" +msgstr "indiçage de chaînes de caractères incorrect" -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "la longueur de 'center' doit être égale au nombre de colonnes de 'x'" +msgid "internal bug: missing 'i' in replTmat(): please report" +msgstr "bogue interne : 'i' manquant dans replTmat() : veuillez reporter ceci" -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "la longueur de 'scale' doit être égale au nombre de colonnes de 'x'" +msgid "[ ] indexing not allowed: forgot a \",\" ?" +msgstr "" +"indiçage [ ] non permis : n'avez-vous pas oublié une \",\" ?" -msgid "'x' must inherit from \"sparseVector\"" -msgstr "'x' doit hériter de \"sparseVector\"" +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "bogue interne : matrice 'i' dans replTmat() : veuillez reporter ceci" -msgid "'ncol' must be >= 0" -msgstr "'ncol' doit être >= 0" +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " +"convertis ; NA |--> TRUE." -msgid "'nrow' must be >= 0" -msgstr "'nrow' doit être >= 0" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " +"convertis." -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "Il faut spécifier 'nrow' lorsque 'symmetric' est vrai" +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." +msgstr "" +"x[.,.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " +"convertis NA |--> TRUE." -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" -msgstr "'now' et 'ncol' doivent être les mêmes lorsque 'symmetric' est vrai" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.,.] <- val: x vaut %s, val qui ne sont pas dans {TRUE, FALSE} sont " +"convertis." -msgid "'x' must have length nrow^2 when 'symmetric' is true" -msgstr "'x' doit avoir une longueur nrow^2 lorsque 'symmetric' est vrai" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgstr "" +"x[.,.] <- val: x est converti automatiquement de Tsparse* vers CsparseMatrix" -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol' n'est pas un factor de length(x)" +msgid "nargs() = %d should never happen; please report." +msgstr "nargs() = %d ne devrait jamais se produire ; veuillez reporter ceci." -msgid "'nrow' is not a factor of length(x)" -msgstr "'nrow' n'est pas un factor de length(x)" +msgid "row indices must be <= nrow(.) which is %d" +msgstr "les indices de lignes doivent être <= nrow(.) qui est %d" -msgid "Class %s is not yet implemented" -msgstr "La classe %s n'est pas encore implémentée" +msgid "column indices must be <= ncol(.) which is %d" +msgstr "les indices de colonnes doivent être <= ncol(.) qui est %d" -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +msgid "Internal bug: nargs()=%d; please report" +msgstr "Bogue interne : nargs()=%d ; veuillez reporter ceci" msgid "" "index must be numeric, logical or sparseVector for indexing sparseVectors" @@ -915,12 +921,6 @@ "les indices doivent être numériques, booléens ou sparseVector pour " "l'indiçage sparseVectors" -msgid "'times >= 0' is required" -msgstr "'times >= 0' est requis" - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"%s\"' pour vous" - #, fuzzy msgid "invalid subscript class \"%s\"" msgstr "classe incorrecte : %s" @@ -929,10 +929,10 @@ msgid "invalid subscript type \"%s\"" msgstr "Type de stockage incorrect : %s" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -946,25 +946,135 @@ msgid "incorrect number of dimensions" msgstr "dimensions incompatibles des matrices" -#, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x' n'est ni symétrique ni triangulaire" +msgid "only zeros may be mixed with negative subscripts" +msgstr "" -#, fuzzy -msgid "matrix is not symmetric" -msgstr "la matrice n'est pas triangulaire" +msgid "'%s' has length 0 but '%s' does not" +msgstr "" #, fuzzy -msgid "matrix is not triangular" -msgstr "'x' n'est ni symétrique ni triangulaire" - -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" +"impossible de convertir automatiquement des \"dgMAtrix\" non symétriques en " +"classe \"dsCMatrix\"" #, fuzzy msgid "invalid 'Class2'" msgstr "'data' incorrect" +#~ msgid "qr2rankMatrix(.): QR has negative diag(R) entries" +#~ msgstr "qr2rankMatrix(.): QR a des entrées négatives dans diag(R)" + +#, fuzzy +#~ msgid "invalid 'each' argument" +#~ msgstr "signe incorrect dans l'argument 'by'" + +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "'data' incorrect" + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "méthode non encore implémentée pour %s(<%s>).\n" +#~ " ->> Demandez aux auteurs du package d'implémenter cette fonction " +#~ "manquante." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "méthode non encore implémentée pour %s(<%s>, <%s>).\n" +#~ " ->> Demandez aux auteurs du package d'implémenter cette fonction " +#~ "manquante." + +#, fuzzy +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "classe Matrix générale pas encore implémentée pour %s" + +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "pas encore implémenté pour la classe %s" + +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "'type' invalide" + +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag' et 'differences' doivent être des entiers >= 1" + +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "" +#~ "erreur de programmation : min() aurait dû être dispatché avec le 1er arg " +#~ "bien plus tôt" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "dans Summary() : %s(<%s>, <%s>, …)" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "dans Summary(, ) : %s(<%s>, <%s>)" + +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "nombre incompatible de lignes pour %s" + +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "nombre incompatible de lignes pour %s" + +#~ msgid "resulting x-slot has different type than x's or y's" +#~ msgstr "le slot x résultant a un type différent que celui des x ou des y" + +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "la valeur de dim(.) doit être numérique de longueur 2" + +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A' doit être une matrice carrée" + +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol' doit être >= 0" + +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "méthode pas encore implémentée pour <%s> %%*%% <%s>" + +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "'boolArith = %d' n'est pas encore implémenté" + +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "conversion automatique rcond(.) via sparse -> dense" + +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "'data' incorrect" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "" +#~ "impossible de convertir automatiquement des 'NA's en modèle \"ngCMatrix\"" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "" +#~ "impossible de convertir automatiquement les 'NA's en \"nsparseVector\"" + +#~ msgid "" +#~ "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +#~ msgstr "" +#~ "le nombre de valeurs non nulles est plus petit que 'nnz' à cause de (i,j) " +#~ "dupliqués" + +#~ msgid "'times >= 0' is required" +#~ msgstr "'times >= 0' est requis" + +#~ msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" +#~ msgstr "'giveCsparse' est obsolète ; j’ai mis 'repr = \"%s\"' pour vous" + #~ msgid "Matrices must have same number of rows in %s" #~ msgstr "Les matrices doivent avoir le même nombre de lignes dans %s" diff -Nru rmatrix-1.6-1.1/po/R-it.po rmatrix-1.6-5/po/R-it.po --- rmatrix-1.6-1.1/po/R-it.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-it.po 2023-11-03 01:34:40.000000000 +0000 @@ -7,7 +7,7 @@ msgstr "" "Project-Id-Version: R-Matrix 1.3-3\n" "Report-Msgid-Bugs-To: bugs.r-project.org\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2021-04-14 12:18+0200\n" "Last-Translator: Daniele Medri \n" "Language-Team: Italian https://github.com/dmedri/R-italian-lang\n" @@ -18,82 +18,35 @@ "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Poedit 2.2.1\n" -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "'mod' non valido: %s" msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"metodo non ancora implementato per %s(<%s>).\n" -" - >> Chiedi agli autori del pacchetto di implementare la funzionalità " -"assente." - -msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"metodo non ancora implementato per %s(<%s>, <%s>).\n" -" - >> Chiedi agli autori del pacchetto di implementare la funzionalità " -"assente." - -msgid "non-conformable matrix dimensions in %s" -msgstr "dimensioni matrice non conformi in %s" #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "classe generale Matrix non ancora implementata per %s" +msgid "complex %s not yet implemented" +msgstr "La classe %s non è ancora implementata" #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "non è possibile la coercizione degli 'NA' in \"nsparseMatrix\"" #, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ suppressing %d column names %s ... ]]" - -#, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "non ancora implementato per la classe %s" -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "non ancora implementato per la classe %s" - -#, fuzzy -msgid "invalid 'uplo'" -msgstr "'type' non valido" - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "nothing to replace with" -msgstr "niente da sostituire" - -msgid "number of items to replace is not a multiple of replacement length" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"il numero di articoli da sostituire non è un multiplo della lunghezza di " -"sostituzione" - -msgid "too many replacement values" -msgstr "troppi valori di sostituzione" - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "i1[1] == 0 ==> la verbosità a livello C non accadrà!" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "" -"si utilizza\t una parte di \"vecchio codice\" nel sotto-assegnamento Csparse" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" -msgstr "" -"si utilizza una parte di \"vecchio codice\" nel sotto-assegnamento Csparse\n" -" >>> per piacere, riportatelo agli autori Matrix-authors@r-project.org" msgid "Not a valid format" msgstr "Non è un formato valido" @@ -158,58 +111,28 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "'%s()' non è ancora implementato per la rappresentazione '%s'" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" -msgstr "" - -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "invalid 'data'" -msgstr "'data' non valido" - -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "'nrow', 'ncol' e gli altri, sono ignorati dai dati della matrice" - -msgid "data is too long" -msgstr "" - -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag' e 'differences' devono essere interi >= 1" - msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -".M.repl.i.2col(): 'i' non ha un numero di colonna intero;\n" -" non dovrebbe mai accadere; per piacere, segnalatelo" -msgid "such indexing must be by logical or 2-column numeric matrix" +msgid "longer object length is not a multiple of shorter object length" msgstr "" -"tale indicizzazione dev'essere per matrice logica o numerica a 2 colonne" - -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col(): si elimina il caso 'matrix' ..." - -msgid "negative values are not allowed in a matrix subscript" -msgstr "valori negativi non ammessi in subscript di matrice" - -msgid "NAs are not allowed in subscripted assignments" -msgstr "NA non ammessi nelle assegnazioni subscript" - -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v: trattamento inefficiente dei singoli elementi" +"la lunghezza più lunga dell'oggetto non è un multiplo della lunghezza più " +"corta dell'oggetto" -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. Argomenti illegali estranei all'interno di '[ .. ]' ?" +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "stringa 'col.names' non valida: %s" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"RHS 'value' (classe %s) corrisponde a 'ANY', ma deve corrispondere ad una " -"classe di matrice %s" -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "metodo 'Matrix[<-' non ancora implementato" +msgid "non-conformable matrix dimensions in %s" +msgstr "dimensioni matrice non conformi in %s" msgid "dimnames [%d] mismatch in %s" msgstr "dimnames [%d] non corrisponde in %s" @@ -260,81 +183,11 @@ "la lunghezza dell'oggetto più lungo\n" "\tnon è un multiplo di lunghezza di quello più corto" -msgid "longer object length is not a multiple of shorter object length" -msgstr "" -"la lunghezza più lunga dell'oggetto non è un multiplo della lunghezza più " -"corta dell'oggetto" - -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "" -"errore di programmazione: min() dovrebbe aver fatto il dispatch con il primo " -"argomento molto prima" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "in Summary(, .): %s(<%s>, <%s>,...)" - -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "in Summary(, .): %s(<%s>, <%s>)" - -msgid "you cannot mix negative and positive indices" -msgstr "non è possibile mischiare indici negativi e positivi" - -msgid "index larger than maximal %d" -msgstr "indice più largo del massimo %d" - -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "gli indici 'NA' non sono (ancora?) supportati per le matrici sparse" - -msgid "logical subscript too long (%d, should be %d)" -msgstr "subscript logico troppo lungo (%d, dovrebbe essere %d)" - -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "" -"nessuna 'dimnames[[.]]': non è possibile utilizzare l'indicizzazione dei " -"caratteri" - -msgid "invalid character indexing" -msgstr "indicizzazione carattere non valida" - -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "bug interno: manca 'i' in replTmat(): per piacere, riportatelo" - -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "" -"[ ] indicizzazione non ammessa: si è dimenticato un \",\" ?" - -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "bug interno: matrix 'i' in replTmat(): per piacere, riportatelo" - -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito; NA |--> " -"TRUE." - -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "x[.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito." - -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[.,.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito; NA |--" -"> TRUE." - -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "x[.,.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito." - -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "x[.,.] <- val : x è stato convertito da Tsparse* a CsparseMatrix" - -msgid "nargs() = %d should never happen; please report." -msgstr "nargs() = %d non dovrebbe accadere; per piacere riportalo." - -msgid "row indices must be <= nrow(.) which is %d" -msgstr "gli indici riga devono essere <= nrow(.) e sono %d" +msgid "intermediate 'r' is of type %s" +msgstr "la 'r' intermedia è di tipo %s" -msgid "column indices must be <= ncol(.) which is %d" -msgstr "gli indici di colonna devono essere <= ncol(.) e sono %d" +msgid "not yet implemented .. please report" +msgstr "non ancora implementato .. per piacere riportalo" msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "'force' dev'essere (coercibile in) TRUE o FALSE" @@ -385,66 +238,21 @@ msgid " --> is not yet implemented" msgstr " --> non è ancora implementato" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"T\"'" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "'giveCsparse' è stato deprecato; si utilizzerà 'repr'" - -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "la matrice 'diagonals' deve avere %d colonne (= length(k) )" - -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagonals' deve avere la medesima lunghezza (%d) di 'k'" - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "la matrice può essere unicamente simmetrica se quadrata, ma n != m" - -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"per la matrice di bande simmetriche, specificare solo il triangolo superiore " -"o inferiore\n" -" poi, tutti i k devono avere lo stesso segno" - -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "la %d' (sotto)-diagonale (k = %d) è troppo corta; si riempie con NA" - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "'repr' non valido; dev'essere \"C\", \"T\", o \"R\"" - -#, fuzzy -msgid "number of rows of matrices must match" -msgstr "il numero di righe non sono compatibili per %s" - #, fuzzy -msgid "number of columns of matrices must match" -msgstr "il numero di righe non sono compatibili per %s" - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "lo x-slot risultante ha un tipo diverso da quelli di x o y" - -#, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "chol() non è definito per una matrice diagonale con voci negative" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - #, fuzzy msgid "matrix is not square" msgstr "la matrice non è diagonale" msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "'x' deve ereditare da \"sparseVector\"" msgid "D[i,i] is NA, i=%d" @@ -453,7 +261,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" #, fuzzy @@ -468,16 +276,22 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "'type' non valido" -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "Tipo di archiviazione non valido: %s" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "stringa 'col.names' non valida: %s" + +msgid "%s length cannot exceed %s" msgstr "" msgid "'A' must be a square matrix" @@ -501,29 +315,83 @@ msgid "not enough new vecs -- stop iterations" msgstr "non ci sono abbastanza nuovi vettori -- si interrompono le iterazioni" +msgid "invalid 'data'" +msgstr "'data' non valido" + +#, fuzzy +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "'nrow', 'ncol' e gli altri, sono ignorati dai dati della matrice" + +msgid "data is too long" +msgstr "" + #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "il valore di dim(.) dev'essere numerico di lunghezza 2" +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgstr "uno tra 'i', 'j' o 'p' non deve essere presente nella chiamata" -msgid "dimensions cannot contain NA" +msgid "" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" msgstr "" -msgid "dimensions cannot contain negative values" +#, fuzzy +msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgstr "'giveCsparse' è stato deprecato; si utilizzerà 'repr'" + +#, fuzzy +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"T\"'" + +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p' dev'essere un vettore non decrescente (0, ...)" + +msgid "dimensions cannot exceed 2^31-1" msgstr "" -msgid "invalid nargs()= %d" -msgstr "nargs()= %d non valido" +msgid "'i' and 'j' must not contain NA" +msgstr "" -msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +msgid "'i' and 'j' must be" msgstr "" -msgid "determinant of non-square matrix is undefined" +msgid "positive" +msgstr "" + +msgid "non-negative" msgstr "" #, fuzzy +msgid "invalid 'dims'" +msgstr "'data' non valido" + +msgid "'dims' must contain all (i,j) pairs" +msgstr "" + +msgid "symmetric matrix must be square" +msgstr "la matrice simmetrica dev'esser quadrata" + +msgid "triangular matrix must be square" +msgstr "la matrice triangolare dev'esser quadrata" + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "length(i) non è un multiplo di length(x)" + +msgid "length(x) must not exceed" +msgstr "" + +#, fuzzy +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgstr "'repr' non valido; dev'essere \"C\", \"T\", o \"R\"" + +#, fuzzy msgid "'n' must be a non-negative integer" msgstr "la lunghezza dev'essere un numero non negativo" @@ -561,29 +429,116 @@ msgid "'lst' must be a list" msgstr "'ncol' dev'essere >= 0" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"T\"'" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "'giveCsparse' è stato deprecato; si utilizzerà 'repr'" + +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "la matrice 'diagonals' deve avere %d colonne (= length(k) )" + +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagonals' deve avere la medesima lunghezza (%d) di 'k'" + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "la matrice può essere unicamente simmetrica se quadrata, ma n != m" + +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"per la matrice di bande simmetriche, specificare solo il triangolo superiore " +"o inferiore\n" +" poi, tutti i k devono avere lo stesso segno" + +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "la %d' (sotto)-diagonale (k = %d) è troppo corta; si riempie con NA" + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "'repr' non valido; dev'essere \"C\", \"T\", o \"R\"" + +msgid "'x' must inherit from \"sparseVector\"" +msgstr "'x' deve ereditare da \"sparseVector\"" + +msgid "'ncol' must be >= 0" +msgstr "'ncol' dev'essere >= 0" + +msgid "'nrow' must be >= 0" +msgstr "'nrow' dev'essere >= 0" + +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "Bisogna specificare 'nrow' quando 'symmetric' è true" + +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "'nrow' e 'ncol' dev'essere uguali quando 'symmetric' è true" + +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "'x' deve avere lunghezza nrow^2 quando 'symmetric' è true" + +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol' non è un fattore di length(x)" + +msgid "'nrow' is not a factor of length(x)" +msgstr "'nrow' non è un fattore di length(x)" + +msgid "Class %s is not yet implemented" +msgstr "La classe %s non è ancora implementata" + +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "la lunghezza dev'essere un numero non negativo" + +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x' non è simmetrica ne triangolare" + +#, fuzzy +msgid "matrix is not symmetric" +msgstr "la matrice non è triangolare" + +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x' non è simmetrica ne triangolare" + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" -msgstr "Bug interno: nargs()=%d; per piacere riportalo" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -msgid "intermediate 'r' is of type %s" -msgstr "la 'r' intermedia è di tipo %s" +msgid "assigned dimensions do not have length %d" +msgstr "" -msgid "not yet implemented .. please report" -msgstr "non ancora implementato .. per piacere riportalo" +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "dim [product %d] non corrisponde con la lunghezza dell'oggetto [%d]" + +msgid "'%s' has non-finite values" +msgstr "" + +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" #, fuzzy @@ -596,33 +551,65 @@ msgstr "'lwd' dev'essere NULL o un numerico non negativo" #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A' dev'essere una matrice quadrata" +msgid "%s(<%s>) is not yet implemented" +msgstr "La classe %s non è ancora implementata" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" +msgstr "" + +msgid "'%s' has elements less than %d" msgstr "" #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol' dev'essere >= 0" +msgid "'%s' is not a non-negative number" +msgstr "la lunghezza dev'essere un numero non negativo" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' has elements exceeding '%s'" +msgstr "" + +msgid "'%s' is not %d or %d" msgstr "" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol' non è un fattore di length(x)" + +#, fuzzy +msgid "matrix must have exactly one entry in each row or column" msgstr "deve avere esattamente una voce non zero per riga" #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" -msgstr "il metodo di kronecker deve utilizzare in maniera predefinita 'FUN'" +msgid "attempt to coerce non-square matrix to %s" +msgstr "" +"non è possibile convertire la classe \"dgTMatrix\" non simmetrica nella " +"classe \"dsCMatrix\"" + +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "deve avere esattamente una voce non zero per riga" + +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "rcond (.) con coercizione sparsa -> densa" -msgid "number of nonzero entries cannot exceed 2^31-1" +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "nargs()= %d non valido" + +msgid "norm" msgstr "" +#, fuzzy +msgid "'%s' method must use default %s=\"%s\"" +msgstr "il metodo di kronecker deve utilizzare in maniera predefinita 'FUN'" + +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "il numero di righe non sono compatibili per %s" + msgid "Matrix seems negative semi-definite" msgstr "Matrix sembra semi-definito negativo" @@ -630,62 +617,50 @@ msgstr "'nearPD()' non converge in %d iterazioni" #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "rcond (.) con coercizione sparsa -> densa" - -msgid "invalid 'type'" -msgstr "'type' non valido" +msgid "'cl' is not a character string" +msgstr "'V' non è una matrice quadrata" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "" -"non è possibile convertire la classe \"dgTMatrix\" non simmetrica nella " -"classe \"dsCMatrix\"" +msgid "'%s' is not a square numeric matrix" +msgstr "'V' non è una matrice quadrata" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "deve avere esattamente una voce non zero per riga" - -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "metodo non ancora implementato per <%s> %%*%% <%s>" +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "diag(.) ha 0 o voci NA; un risultato non-finito è incerto" msgid "non-conformable arguments" msgstr "gli argomenti non sono compatibili" -msgid "'boolArith = %d' not yet implemented" -msgstr "'boolArith = %d' non ancora implementato" - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" #, fuzzy -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "RHS 'b' ha una lunghezza errata" #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "stringa 'col.names' non valida: %s" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "" "qr2rankMatrix(.): QR con solo %d elementi fuori dai %d finiti di diag(R)" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "qr2rankMatrix(.): QR ha elementi diag(R) negativi" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -697,28 +672,47 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr'): calcolando t(x) come nrow(x) < ncol(x)" -msgid "rcond(x) is undefined: 'x' has length 0" -msgstr "" - #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "rcond (.) con coercizione sparsa -> densa" +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ suppressing %d column names %s ... ]]" + +msgid "invalid 'col.names' string: %s" +msgstr "stringa 'col.names' non valida: %s" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgstr "uniDiag=TRUE, ma non tutte le voci diagonali sono 1" + +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgstr "uniDiag=TRUE, non tutte le voci in diagonale codificate come 1" #, fuzzy -msgid "invalid 'norm'" -msgstr "'data' non valido" +msgid "in show(); maybe adjust options(max.print=, width=)" +msgstr "in show(); si dovrebbe aggiustare 'options(max.print= *, width = *)'" + +msgid "suppressing %d columns and %d rows" +msgstr "soppresse %d colonne e %d righe" + +msgid "suppressing %d rows" +msgstr "soppresse %d righe" + +msgid "suppressing %d columns" +msgstr "soppresse %d colonne" + +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "" +"errore di programmazione logica in printSpMatrix2(), per piacere, riportatelo" #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V' non è una matrice quadrata" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -730,14 +724,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" +msgid "cannot coerce from %s to %s" msgstr "" -"non è possibile la coercizione dei valori 'NA' nel pattern \"ngCMatrix\"" - -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "non è possibile la coercizione degli 'NA' in \"nsparseVector\"" #, fuzzy msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -754,144 +742,161 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "variabile '%s' assente, i suoi contrasti saranno ignorati" +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgstr "" +"una sparseMatrix dovrebbe essere raramente centrata: non sarà più sparsa." + +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "la lunghezza di 'center' deve eguagliare il numero di colonne di 'x'" + +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "la lunghezza di 'scale' deve eguagliare il numero di colonne di 'x'" + +msgid "trimmed means are not defined for complex data" +msgstr "" + +msgid "first element used of '%s' argument" +msgstr "" + #, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "uno tra 'i', 'j' o 'p' non deve essere presente nella chiamata" +msgid "invalid '%s' argument" +msgstr "'data' non valido" -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" +msgid "should never happen ..." msgstr "" #, fuzzy -msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgid "'%s' is deprecated; using '%s' instead" msgstr "'giveCsparse' è stato deprecato; si utilizzerà 'repr'" #, fuzzy -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgid "'%s' is deprecated; setting %s=\"%s\"" msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"T\"'" -#, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p' dev'essere un vettore non decrescente (0, ...)" - -msgid "'i' and 'j' must not contain NA" +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col(): 'i' non ha un numero di colonna intero;\n" +" non dovrebbe mai accadere; per piacere, segnalatelo" -msgid "'i' and 'j' must be" +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" +"tale indicizzazione dev'essere per matrice logica o numerica a 2 colonne" -msgid "positive" -msgstr "" +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col(): si elimina il caso 'matrix' ..." -msgid "non-negative" -msgstr "" +msgid "negative values are not allowed in a matrix subscript" +msgstr "valori negativi non ammessi in subscript di matrice" -#, fuzzy -msgid "invalid 'dims'" -msgstr "'data' non valido" +msgid "NAs are not allowed in subscripted assignments" +msgstr "NA non ammessi nelle assegnazioni subscript" -msgid "'dims' must contain all (i,j) pairs" +msgid "number of items to replace is not a multiple of replacement length" msgstr "" +"il numero di articoli da sostituire non è un multiplo della lunghezza di " +"sostituzione" -msgid "symmetric matrix must be square" -msgstr "la matrice simmetrica dev'esser quadrata" +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v: trattamento inefficiente dei singoli elementi" -msgid "triangular matrix must be square" -msgstr "la matrice triangolare dev'esser quadrata" +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. Argomenti illegali estranei all'interno di '[ .. ]' ?" -msgid "p[length(p)]" +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"RHS 'value' (classe %s) corrisponde a 'ANY', ma deve corrispondere ad una " +"classe di matrice %s" -msgid "length(i)" -msgstr "" +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "metodo 'Matrix[<-' non ancora implementato" -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "length(i) non è un multiplo di length(x)" +msgid "invalid nargs()= %d" +msgstr "nargs()= %d non valido" -msgid "length(x) must not exceed" -msgstr "" +msgid "nothing to replace with" +msgstr "niente da sostituire" -#, fuzzy -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" -msgstr "'repr' non valido; dev'essere \"C\", \"T\", o \"R\"" +msgid "too many replacement values" +msgstr "troppi valori di sostituzione" -msgid "invalid 'col.names' string: %s" -msgstr "stringa 'col.names' non valida: %s" +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" +msgstr "i1[1] == 0 ==> la verbosità a livello C non accadrà!" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "uniDiag=TRUE, ma non tutte le voci diagonali sono 1" +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "" +"si utilizza\t una parte di \"vecchio codice\" nel sotto-assegnamento Csparse" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" -msgstr "uniDiag=TRUE, non tutte le voci in diagonale codificate come 1" +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" +msgstr "" +"si utilizza una parte di \"vecchio codice\" nel sotto-assegnamento Csparse\n" +" >>> per piacere, riportatelo agli autori Matrix-authors@r-project.org" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" -msgstr "in show(); si dovrebbe aggiustare 'options(max.print= *, width = *)'" +msgid "you cannot mix negative and positive indices" +msgstr "non è possibile mischiare indici negativi e positivi" -msgid "suppressing %d columns and %d rows" -msgstr "soppresse %d colonne e %d righe" +msgid "index larger than maximal %d" +msgstr "indice più largo del massimo %d" -msgid "suppressing %d rows" -msgstr "soppresse %d righe" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" +msgstr "gli indici 'NA' non sono (ancora?) supportati per le matrici sparse" -msgid "suppressing %d columns" -msgstr "soppresse %d colonne" +msgid "logical subscript too long (%d, should be %d)" +msgstr "subscript logico troppo lungo (%d, dovrebbe essere %d)" -msgid "logic programming error in printSpMatrix2(), please report" +msgid "no 'dimnames[[.]]': cannot use character indexing" msgstr "" -"errore di programmazione logica in printSpMatrix2(), per piacere, riportatelo" - -msgid "'V' is not a *square* matrix" -msgstr "'V' non è una matrice quadrata" +"nessuna 'dimnames[[.]]': non è possibile utilizzare l'indicizzazione dei " +"caratteri" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" -msgstr "diag(.) ha 0 o voci NA; un risultato non-finito è incerto" +msgid "invalid character indexing" +msgstr "indicizzazione carattere non valida" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" -msgstr "" -"il numero di valori non-zero è inferiore a 'nnz' a causa di duplicati (i,j)s" +msgid "internal bug: missing 'i' in replTmat(): please report" +msgstr "bug interno: manca 'i' in replTmat(): per piacere, riportatelo" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgid "[ ] indexing not allowed: forgot a \",\" ?" msgstr "" -"una sparseMatrix dovrebbe essere raramente centrata: non sarà più sparsa." - -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "la lunghezza di 'center' deve eguagliare il numero di colonne di 'x'" - -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "la lunghezza di 'scale' deve eguagliare il numero di colonne di 'x'" +"[ ] indicizzazione non ammessa: si è dimenticato un \",\" ?" -msgid "'x' must inherit from \"sparseVector\"" -msgstr "'x' deve ereditare da \"sparseVector\"" +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "bug interno: matrix 'i' in replTmat(): per piacere, riportatelo" -msgid "'ncol' must be >= 0" -msgstr "'ncol' dev'essere >= 0" +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito; NA |--> " +"TRUE." -msgid "'nrow' must be >= 0" -msgstr "'nrow' dev'essere >= 0" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "x[.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito." -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "Bisogna specificare 'nrow' quando 'symmetric' è true" +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." +msgstr "" +"x[.,.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito; NA |--" +"> TRUE." -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" -msgstr "'nrow' e 'ncol' dev'essere uguali quando 'symmetric' è true" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "x[.,.] <- val: x è %s, il valore esterno a {TRUE, FALSE} è convertito." -msgid "'x' must have length nrow^2 when 'symmetric' is true" -msgstr "'x' deve avere lunghezza nrow^2 quando 'symmetric' è true" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgstr "x[.,.] <- val : x è stato convertito da Tsparse* a CsparseMatrix" -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol' non è un fattore di length(x)" +msgid "nargs() = %d should never happen; please report." +msgstr "nargs() = %d non dovrebbe accadere; per piacere riportalo." -msgid "'nrow' is not a factor of length(x)" -msgstr "'nrow' non è un fattore di length(x)" +msgid "row indices must be <= nrow(.) which is %d" +msgstr "gli indici riga devono essere <= nrow(.) e sono %d" -msgid "Class %s is not yet implemented" -msgstr "La classe %s non è ancora implementata" +msgid "column indices must be <= ncol(.) which is %d" +msgstr "gli indici di colonna devono essere <= ncol(.) e sono %d" -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +msgid "Internal bug: nargs()=%d; please report" +msgstr "Bug interno: nargs()=%d; per piacere riportalo" msgid "" "index must be numeric, logical or sparseVector for indexing sparseVectors" @@ -899,12 +904,6 @@ "l'indice dev'essere numerico, logico o sparseVector per l'indicizzazione di " "sparseVector" -msgid "'times >= 0' is required" -msgstr "'times >= 0' è richiesto" - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"%s\"'" - #, fuzzy msgid "invalid subscript class \"%s\"" msgstr "classe non valida: %s" @@ -913,10 +912,10 @@ msgid "invalid subscript type \"%s\"" msgstr "Tipo di archiviazione non valido: %s" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -930,25 +929,134 @@ msgid "incorrect number of dimensions" msgstr "dimensioni matrice non compatibili" -#, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x' non è simmetrica ne triangolare" +msgid "only zeros may be mixed with negative subscripts" +msgstr "" -#, fuzzy -msgid "matrix is not symmetric" -msgstr "la matrice non è triangolare" +msgid "'%s' has length 0 but '%s' does not" +msgstr "" #, fuzzy -msgid "matrix is not triangular" -msgstr "'x' non è simmetrica ne triangolare" - -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" +"non è possibile convertire la classe \"dgTMatrix\" non simmetrica nella " +"classe \"dsCMatrix\"" #, fuzzy msgid "invalid 'Class2'" msgstr "'data' non valido" +#~ msgid "qr2rankMatrix(.): QR has negative diag(R) entries" +#~ msgstr "qr2rankMatrix(.): QR ha elementi diag(R) negativi" + +#, fuzzy +#~ msgid "invalid 'each' argument" +#~ msgstr "segno errato nell'argomento 'by'" + +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "'data' non valido" + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "metodo non ancora implementato per %s(<%s>).\n" +#~ " - >> Chiedi agli autori del pacchetto di implementare la funzionalità " +#~ "assente." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "metodo non ancora implementato per %s(<%s>, <%s>).\n" +#~ " - >> Chiedi agli autori del pacchetto di implementare la funzionalità " +#~ "assente." + +#, fuzzy +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "classe generale Matrix non ancora implementata per %s" + +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "non ancora implementato per la classe %s" + +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "'type' non valido" + +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag' e 'differences' devono essere interi >= 1" + +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "" +#~ "errore di programmazione: min() dovrebbe aver fatto il dispatch con il " +#~ "primo argomento molto prima" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>,...)" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>)" + +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "il numero di righe non sono compatibili per %s" + +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "il numero di righe non sono compatibili per %s" + +#~ msgid "resulting x-slot has different type than x's or y's" +#~ msgstr "lo x-slot risultante ha un tipo diverso da quelli di x o y" + +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "il valore di dim(.) dev'essere numerico di lunghezza 2" + +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A' dev'essere una matrice quadrata" + +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol' dev'essere >= 0" + +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "metodo non ancora implementato per <%s> %%*%% <%s>" + +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "'boolArith = %d' non ancora implementato" + +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "rcond (.) con coercizione sparsa -> densa" + +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "'data' non valido" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "" +#~ "non è possibile la coercizione dei valori 'NA' nel pattern \"ngCMatrix\"" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "non è possibile la coercizione degli 'NA' in \"nsparseVector\"" + +#~ msgid "" +#~ "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +#~ msgstr "" +#~ "il numero di valori non-zero è inferiore a 'nnz' a causa di duplicati (i," +#~ "j)s" + +#~ msgid "'times >= 0' is required" +#~ msgstr "'times >= 0' è richiesto" + +#~ msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" +#~ msgstr "'giveCsparse' è stato deprecato; viene impostato 'repr = \"%s\"'" + #~ msgid "Matrices must have same number of rows in %s" #~ msgstr "Le matrici devono avere il medesimo numero di righe in %s" diff -Nru rmatrix-1.6-1.1/po/R-ko.po rmatrix-1.6-5/po/R-ko.po --- rmatrix-1.6-1.1/po/R-ko.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-ko.po 2023-11-03 01:34:40.000000000 +0000 @@ -14,7 +14,7 @@ msgid "" msgstr "" "Project-Id-Version: Matrix 1.1-3\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2015-07-15 17:14-0600\n" "Last-Translator:Chel Hee Lee \n" "Language-Team: Chel Hee Lee \n" @@ -24,78 +24,35 @@ "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "사용할 수 있는 'mod'(%s)가 아닙니다." msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"%s(<%s>)의 경우에 대하여 아직 구현되지 않은 메소드(method)입니다.\n" -" ->> 이 기능에 대한 구현을 패키지 관리자에게 문의해 주셨으면 합니다." - -msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"%s(<%s>, <%s>)의 경우에 대하여 아직 구현되지 않은 메소드(method)입니다.\n" -" ->> 이 기능에 대한 구현을 패키지 관리자에게 문의해 주시길 바랍니다." - -msgid "non-conformable matrix dimensions in %s" -msgstr "%s에 입력된 행렬의 차원이 정합(conformable)하지 않습니다." #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "%s의 경우에는 아직 구현되지 않은 일반적인 Matrix 클래스입니다." +msgid "complex %s not yet implemented" +msgstr "클래스 %s는 아직 구현되지 않았습니다." #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "'NA'를 \"nsparseMatrix\"으로 강제변환(coerce)할 수 없습니다." #, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ %d개의 열이름 %s ...를 제거합니다 ]]" - -#, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "클래스 %s의 경우에 아직 구현되지 않았습니다." -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "클래스 %s의 경우에 아직 구현되지 않았습니다." - -#, fuzzy -msgid "invalid 'uplo'" -msgstr "올바르지 않은 'type'입니다." - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "nothing to replace with" -msgstr "교체(replace)해야 할 것이 아무것도 없습니다." - -msgid "number of items to replace is not a multiple of replacement length" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"교체(replace)할 항목의 개수가 입력된 value가 가지는 길이의 배수가 아닙니다." - -msgid "too many replacement values" -msgstr "교체에 이용될 값이 너무 많이 입력되었습니다." - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "i1[1] == 0 ==> C-레벨에서의 진행과정표시는 나타나지 않을 것입니다!" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "using\t \"old code\" part in Csparse subassignment" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" -msgstr "" -"using\"old code\" part in Csparse subassignment\n" -" >>> Matrix-authors@r-project.org으로 이를 보고해 주시길 바랍니다." msgid "Not a valid format" msgstr "올바른 형식(format)이 아닙니다." @@ -167,60 +124,26 @@ msgstr "" "표현(representation)이 '%2$s'의 경우에 아직 구현되지 않은 '%1$s()'입니다." -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" -msgstr "" - -msgid "invalid 'data'" -msgstr "입력된 'data'는 올바르지 않습니다." - -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "행렬 'data'인 경우에 입력된 'nrow', 'ncol' 등은 사용되지 않습니다." - -msgid "data is too long" -msgstr "" - -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag'과 'differences'는 반드시 1보다 크거나 같은 정수이어야 합니다." - msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" -msgstr "" -".M.repl.i.2col(): 'i'는 정수형 행번호(integer column number)을 가지고 있지 않" -"습니다.\n" -" 이런 경우는 존재할 수 없으므로 패키지 관리자에게 보고해 주시길 부탁드립니다." - -msgid "such indexing must be by logical or 2-column numeric matrix" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -"이와 같은 유형의 인덱싱(indexing)은 반드시 논리형(logical) 또는 2개의 열로 구" -"성된 수치형(numeric) 행렬에 의해서만 이루어져야 합니다." - -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col(): drop 'matrix' case ..." - -msgid "negative values are not allowed in a matrix subscript" -msgstr "음수(negative values)는 행렬의 첨자(subscript)로 사용할 수 없습니다." - -msgid "NAs are not allowed in subscripted assignments" -msgstr "NA는 행렬의 첨자(subscripted assignment)로 사용할 수 없습니다." -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v: inefficiently treating single elements" +msgid "longer object length is not a multiple of shorter object length" +msgstr "객체의 길이(긴 것)이 다른 객체의 길이(짧은 것)의 배수가 아닙니다." -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. 필요이상의 인자들이 '[ .. ]' 내에 이용되었나요?" +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "%s은 올바른 'col.names' 문자열이 아닙니다" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"클래스 %s를 가지는 우변의 'value'는 'ANY'에 매치되지만, 반드시 행렬의 클래스 " -"%s에 매치되어야 합니다." -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "아직 구현되지 않은 'Matrix[<-' 메소드입(method)니다." +msgid "non-conformable matrix dimensions in %s" +msgstr "%s에 입력된 행렬의 차원이 정합(conformable)하지 않습니다." msgid "dimnames [%d] mismatch in %s" msgstr "%2$s에 입력된 dimnames [%1$d]가 일치하지 않습니다." @@ -275,88 +198,11 @@ "객체의 길이(긴 것)가\n" "\t 다른 객체가 가지는 길이(짧은 것)의 배수가 아닙니다." -msgid "longer object length is not a multiple of shorter object length" -msgstr "객체의 길이(긴 것)이 다른 객체의 길이(짧은 것)의 배수가 아닙니다." - -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "" -"programming error: min() should have dispatched w/ 1st arg much earlier" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "in Summary(, .): %s(<%s>, <%s>,...)" - -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "in Summary(, .): %s(<%s>, <%s>)" - -msgid "you cannot mix negative and positive indices" -msgstr "인덱스에 음수와 양수를 혼용하여 사용할 수 없습니다." - -msgid "index larger than maximal %d" -msgstr "인덱스가 %d 보다 큽니다." - -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "'NA'는 sparse Matrices에 (아직은?) 사용할 수 없는 인덱스입니다" - -msgid "logical subscript too long (%d, should be %d)" -msgstr "" -"길이가 너무 긴 논리형 첨자(subscript)입니다 (%2$d이어야 하는데 %1$d입니다)." - -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "no 'dimnames[[.]]': 문자형 인덱싱을 사용할 수 없습니다" - -msgid "invalid character indexing" -msgstr "유효하지 않은 문자형 인덱싱입니다" - -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "" -"내부버그 발견: replTmat()내에서 'i'를 찾을 수 없습니다. 이를 보고해 주시길 부" -"탁드립니다." - -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "" -"[ ]와 같은 인덱싱은 사용할 수 없습니다. \",\"의 사용을 잊었나요?" - -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "" -"내부버그 발견: replTmat()내에서 'i'는 행렬입니다. 이를 보고해 주시길 부탁드립" -"니다." - -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" -"은 TRUE로 강제변환(coerced) 되었습니다." - -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" -"은 강제변환(coerced) 되었습니다." - -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[.,.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" -"은 TRUE로 강제변환(coerced) 되었습니다. " - -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.,.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" -"은 강제변환(coerced) 되었습니다. " - -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "" -"x[.,.] <- val : Tsparse* 에서 CsparseMatrix로 강제변환(coerced)된 x입니다." - -msgid "nargs() = %d should never happen; please report." -msgstr "" -"nargs() = %d 와 같은 경우는 발생할 수 없으므로 꼭 보고해 주시기를 부탁드립니" -"다." - -msgid "row indices must be <= nrow(.) which is %d" -msgstr "행에 사용되는 인덱스는 반드시 %d 보다 같거나 작아야 합니다." +msgid "intermediate 'r' is of type %s" +msgstr "intermediate 'r' is of type %s" -msgid "column indices must be <= ncol(.) which is %d" -msgstr "열에 사용되는 인덱스는 %d 보다 같거나 작아야 합니다. " +msgid "not yet implemented .. please report" +msgstr "아직 구현되지 않았습니다. 보고를 부탁드립니다." msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "'force'는 반드시 (강제변환될 수 있는) TRUE 또는 FALSE 이어야 합니다." @@ -407,67 +253,21 @@ msgid " --> is not yet implemented" msgstr " --> 은 아직 구현되지 않았습니다." -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "" - -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "" -"'diagonals' 행렬은 반드시 %d (=length(k))개의 열을 가지고 있어야 합니다." - -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagnoals'의 길이는 반드시 'k'(=%d)이어야 합니다." - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "" - -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"대칭 띠 행렬(symmetric band matrix)의 경우, 오로지 상삼각(upper triangle) 또" -"는 하삼각(lower)만을 지정합니다. \n" -" 따라서, 모든 k는 반드시 같은 부호(sign)를 가져야 합니다." - -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "%d-번째 (부분)-대각 (k = %d)이 너무 짧아 NA로 채웁니다." - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "" - -#, fuzzy -msgid "number of rows of matrices must match" -msgstr "%s의 경우 행의 개수가 올바르지 않습니다." - -#, fuzzy -msgid "number of columns of matrices must match" -msgstr "%s의 경우 행의 개수가 올바르지 않습니다." - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "" - #, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "chol()은 음의 값을 가진 대각행렬에 대하여 정의되지 않았습니다." -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - #, fuzzy msgid "matrix is not square" msgstr "대각행렬이 아닙니다." msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "'x'는 \"sparseVector\"로부터의 상속(inherit)이어야 합니다." msgid "D[i,i] is NA, i=%d" @@ -476,7 +276,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" #, fuzzy @@ -492,16 +292,22 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "올바르지 않은 'type'입니다." -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "%s는 사용할 수 없는 저장형식(storage format)입니다." -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "%s은 올바른 'col.names' 문자열이 아닙니다" + +msgid "%s length cannot exceed %s" msgstr "" msgid "'A' must be a square matrix" @@ -525,26 +331,78 @@ msgid "not enough new vecs -- stop iterations" msgstr "not enough new vecs -- stop iterations" +msgid "invalid 'data'" +msgstr "입력된 'data'는 올바르지 않습니다." + +#, fuzzy +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "행렬 'data'인 경우에 입력된 'nrow', 'ncol' 등은 사용되지 않습니다." + +msgid "data is too long" +msgstr "" + #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "dim(.)의 값은 반드시 길이가 2인 수치형 벡터이어야 합니다." +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgstr "'i', 'j', 또는 'p' 중 하나가 호출(call)로부터 누락된 것 같습니다. " + +msgid "" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" +msgstr "" -msgid "dimensions cannot contain NA" +msgid "'giveCsparse' is deprecated; using 'repr' instead" msgstr "" -msgid "dimensions cannot contain negative values" +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" msgstr "" -msgid "invalid nargs()= %d" -msgstr "nargs()= %d의 값이 올바르지 않습니다." +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p'는 반드시 감소하지 않는(non-decreasing) 벡터 (0, ...)이어야 합니다." -msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +msgid "dimensions cannot exceed 2^31-1" msgstr "" -msgid "determinant of non-square matrix is undefined" +msgid "'i' and 'j' must not contain NA" +msgstr "" + +msgid "'i' and 'j' must be" +msgstr "" + +msgid "positive" +msgstr "" + +msgid "non-negative" +msgstr "" + +#, fuzzy +msgid "invalid 'dims'" +msgstr "입력된 'data'는 올바르지 않습니다." + +msgid "'dims' must contain all (i,j) pairs" +msgstr "" + +msgid "symmetric matrix must be square" +msgstr "대칭행렬(symmetric matrix)는 반드시 정방(square)이어야 합니다." + +#, fuzzy +msgid "triangular matrix must be square" +msgstr "대칭행렬(symmetric matrix)는 반드시 정방(square)이어야 합니다." + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "length(i)는 length(x)의 배수가 아닙니다." + +msgid "length(x) must not exceed" +msgstr "" + +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" msgstr "" #, fuzzy @@ -583,29 +441,119 @@ msgid "'lst' must be a list" msgstr "'ncol'은 반드시 >= 0 이어야 합니다. " +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "" + +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "" +"'diagonals' 행렬은 반드시 %d (=length(k))개의 열을 가지고 있어야 합니다." + +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagnoals'의 길이는 반드시 'k'(=%d)이어야 합니다." + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "" + +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"대칭 띠 행렬(symmetric band matrix)의 경우, 오로지 상삼각(upper triangle) 또" +"는 하삼각(lower)만을 지정합니다. \n" +" 따라서, 모든 k는 반드시 같은 부호(sign)를 가져야 합니다." + +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "%d-번째 (부분)-대각 (k = %d)이 너무 짧아 NA로 채웁니다." + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "" + +msgid "'x' must inherit from \"sparseVector\"" +msgstr "'x'는 \"sparseVector\"로부터의 상속(inherit)이어야 합니다." + +msgid "'ncol' must be >= 0" +msgstr "'ncol'은 반드시 >= 0 이어야 합니다. " + +msgid "'nrow' must be >= 0" +msgstr "'nrow'는 반드시 >= 0 이어야 합니다." + +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "'symmetric'이 참인 경우에는 반드시 'nrow'를 지정해 주어야 합니다." + +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "" +"'symmetric'이 참인 경우에는 반드시 'nrow'와 'ncol'을 지정해 주어야 합니다." + +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "" +"'symmetric'이 참인 경우에는 'x'의 길이는 반드시 nrow^2와 같아야 합니다." + +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol'는 길이가 length(x)인 요인(factor)가 아닙니다." + +msgid "'nrow' is not a factor of length(x)" +msgstr "'nrow'는 길이가 length(x)인 요인(factor)가 아닙니다." + +msgid "Class %s is not yet implemented" +msgstr "클래스 %s는 아직 구현되지 않았습니다." + +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "길이(length)는 반드시 음이 아닌 수이어야 합니다." + +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x'는 대칭(symmetric)도 아니고 삼각(triangular)도 아닙니다." + +#, fuzzy +msgid "matrix is not symmetric" +msgstr "삼각행렬이 아닙니다." + +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x'는 대칭(symmetric)도 아니고 삼각(triangular)도 아닙니다." + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" -msgstr "내부버그 발견: nargs()=%d. 꼭 보고를 부탁드립니다." +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -msgid "intermediate 'r' is of type %s" -msgstr "intermediate 'r' is of type %s" +msgid "assigned dimensions do not have length %d" +msgstr "" -msgid "not yet implemented .. please report" -msgstr "아직 구현되지 않았습니다. 보고를 부탁드립니다." +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "dim [product %d]의 값이 객체 [%d]의 길이와 일치하지 않습니다." + +msgid "'%s' has non-finite values" +msgstr "" + +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" #, fuzzy @@ -618,34 +566,66 @@ msgstr "'lwd'는 반드시 NULL 또는 음이 아닌 수 이어야 합니다." #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A'는 반드시 정방행렬(square matrix)이어야 합니다." +msgid "%s(<%s>) is not yet implemented" +msgstr "클래스 %s는 아직 구현되지 않았습니다." -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" +msgstr "" + +msgid "'%s' has elements less than %d" msgstr "" #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol'은 반드시 >= 0 이어야 합니다. " +msgid "'%s' is not a non-negative number" +msgstr "길이(length)는 반드시 음이 아닌 수이어야 합니다." + +msgid "'%s' has elements exceeding '%s'" +msgstr "" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' is not %d or %d" msgstr "" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol'는 길이가 length(x)인 요인(factor)가 아닙니다." + +#, fuzzy +msgid "matrix must have exactly one entry in each row or column" msgstr "각 행마다 반드시 정확히 하나의 영이 아닌 항목을 가지고 있어야 합니다." #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" +msgid "attempt to coerce non-square matrix to %s" msgstr "" -"크로넥커 메소드(kronecker method)는 반드시 기본 'FUN'을 사용해야 합니다." +"비대칭(non-symmetric) \"dgTMatrix\"는 \"dsCMatrix\" 클래스로 강제변환" +"(coerce) 할 수 없습니다. " -msgid "number of nonzero entries cannot exceed 2^31-1" +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "각 행마다 반드시 정확히 하나의 영이 아닌 항목을 가지고 있어야 합니다." + +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "rcond(.) via sparse -> dense coercion" + +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "nargs()= %d의 값이 올바르지 않습니다." + +msgid "norm" msgstr "" +#, fuzzy +msgid "'%s' method must use default %s=\"%s\"" +msgstr "" +"크로넥커 메소드(kronecker method)는 반드시 기본 'FUN'을 사용해야 합니다." + +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "%s의 경우 행의 개수가 올바르지 않습니다." + msgid "Matrix seems negative semi-definite" msgstr "음의 반정치(negative semi-definite) 행렬 같습니다." @@ -653,62 +633,51 @@ msgstr "'nearPD()'는 %d 번째 반복에서도 수렴하지 않았습니다." #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "rcond(.) via sparse -> dense coercion" - -msgid "invalid 'type'" -msgstr "올바르지 않은 'type'입니다." +msgid "'cl' is not a character string" +msgstr "'V'는 정방행렬(square matrix)이 아닙니다." -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "" -"비대칭(non-symmetric) \"dgTMatrix\"는 \"dsCMatrix\" 클래스로 강제변환" -"(coerce) 할 수 없습니다. " +msgid "'%s' is not a square numeric matrix" +msgstr "'V'는 정방행렬(square matrix)이 아닙니다." #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "각 행마다 반드시 정확히 하나의 영이 아닌 항목을 가지고 있어야 합니다." - -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "<%s> %%*%% <%s>에 사용할 수 있는 메소드가 아직 구현되지 않았습니다." +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "" +"diag(.)에 0 또는 NA가 존재하므로 유한하지 않은 결과(non-finite result)를 얻" +"을 것으로 생각됩니다." msgid "non-conformable arguments" msgstr "non-conformable arguments" -#, fuzzy -msgid "'boolArith = %d' not yet implemented" -msgstr "아직 구현되지 않은 종류 %s입니다." - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" #, fuzzy -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "우변의 'b'가 올바르지 않은 길이(length)를 가지고 있습니다." #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "%s은 올바른 'col.names' 문자열이 아닙니다" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -717,28 +686,50 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr'): nrow(x) < ncol(x)이므로 t(x)를 계산합니다." -msgid "rcond(x) is undefined: 'x' has length 0" +#, fuzzy +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ %d개의 열이름 %s ...를 제거합니다 ]]" + +msgid "invalid 'col.names' string: %s" +msgstr "%s은 올바른 'col.names' 문자열이 아닙니다" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgstr "" + +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgstr "" + +msgid "in show(); maybe adjust options(max.print=, width=)" msgstr "" #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "rcond(.) via sparse -> dense coercion" +msgid "suppressing %d columns and %d rows" +msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" #, fuzzy -msgid "invalid 'norm'" -msgstr "입력된 'data'는 올바르지 않습니다." +msgid "suppressing %d rows" +msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" + +#, fuzzy +msgid "suppressing %d columns" +msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" + +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "" +"printSpMatrix2()를 이용 도중 논리적 프로그래밍 에러(logic programming error)" +"가 발생했습니다. 이를 꼭 보고를 부탁드립니다." #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V'는 정방행렬(square matrix)이 아닙니다." -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -750,13 +741,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" -msgstr "'NA'를 \"nsparseMatrix\"으로 강제변환(coerce)할 수 없습니다." - -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "'NA'를 \"nsparseVector\"로 강제변환(coerce) 할 수 없습니다." +msgid "cannot coerce from %s to %s" +msgstr "" #, fuzzy msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -775,152 +761,170 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "변수 '%s'를 찾을 수 없어 관련 대비(contrast)는 계산되지 않을 것입니다." +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgstr "" + #, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "'i', 'j', 또는 'p' 중 하나가 호출(call)로부터 누락된 것 같습니다. " +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "%s에 사용된 각 행렬이 가지는 열의 개수는 서로 같아야 합니다." -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" -msgstr "" +#, fuzzy +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "%s에 사용된 각 행렬이 가지는 열의 개수는 서로 같아야 합니다." -msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgid "trimmed means are not defined for complex data" msgstr "" -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgid "first element used of '%s' argument" msgstr "" #, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p'는 반드시 감소하지 않는(non-decreasing) 벡터 (0, ...)이어야 합니다." +msgid "invalid '%s' argument" +msgstr "입력된 'data'는 올바르지 않습니다." -msgid "'i' and 'j' must not contain NA" +msgid "should never happen ..." msgstr "" -msgid "'i' and 'j' must be" +msgid "'%s' is deprecated; using '%s' instead" msgstr "" -msgid "positive" +msgid "'%s' is deprecated; setting %s=\"%s\"" msgstr "" -msgid "non-negative" +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col(): 'i'는 정수형 행번호(integer column number)을 가지고 있지 않" +"습니다.\n" +" 이런 경우는 존재할 수 없으므로 패키지 관리자에게 보고해 주시길 부탁드립니다." -#, fuzzy -msgid "invalid 'dims'" -msgstr "입력된 'data'는 올바르지 않습니다." - -msgid "'dims' must contain all (i,j) pairs" +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" +"이와 같은 유형의 인덱싱(indexing)은 반드시 논리형(logical) 또는 2개의 열로 구" +"성된 수치형(numeric) 행렬에 의해서만 이루어져야 합니다." -msgid "symmetric matrix must be square" -msgstr "대칭행렬(symmetric matrix)는 반드시 정방(square)이어야 합니다." +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col(): drop 'matrix' case ..." -#, fuzzy -msgid "triangular matrix must be square" -msgstr "대칭행렬(symmetric matrix)는 반드시 정방(square)이어야 합니다." +msgid "negative values are not allowed in a matrix subscript" +msgstr "음수(negative values)는 행렬의 첨자(subscript)로 사용할 수 없습니다." -msgid "p[length(p)]" -msgstr "" +msgid "NAs are not allowed in subscripted assignments" +msgstr "NA는 행렬의 첨자(subscripted assignment)로 사용할 수 없습니다." -msgid "length(i)" +msgid "number of items to replace is not a multiple of replacement length" msgstr "" +"교체(replace)할 항목의 개수가 입력된 value가 가지는 길이의 배수가 아닙니다." -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "length(i)는 length(x)의 배수가 아닙니다." +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v: inefficiently treating single elements" -msgid "length(x) must not exceed" -msgstr "" +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. 필요이상의 인자들이 '[ .. ]' 내에 이용되었나요?" -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"클래스 %s를 가지는 우변의 'value'는 'ANY'에 매치되지만, 반드시 행렬의 클래스 " +"%s에 매치되어야 합니다." -msgid "invalid 'col.names' string: %s" -msgstr "%s은 올바른 'col.names' 문자열이 아닙니다" +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "아직 구현되지 않은 'Matrix[<-' 메소드입(method)니다." -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "" +msgid "invalid nargs()= %d" +msgstr "nargs()= %d의 값이 올바르지 않습니다." -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" -msgstr "" +msgid "nothing to replace with" +msgstr "교체(replace)해야 할 것이 아무것도 없습니다." -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" +msgid "too many replacement values" +msgstr "교체에 이용될 값이 너무 많이 입력되었습니다." + +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" +msgstr "i1[1] == 0 ==> C-레벨에서의 진행과정표시는 나타나지 않을 것입니다!" + +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "using\t \"old code\" part in Csparse subassignment" + +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" msgstr "" +"using\"old code\" part in Csparse subassignment\n" +" >>> Matrix-authors@r-project.org으로 이를 보고해 주시길 바랍니다." -#, fuzzy -msgid "suppressing %d columns and %d rows" -msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" +msgid "you cannot mix negative and positive indices" +msgstr "인덱스에 음수와 양수를 혼용하여 사용할 수 없습니다." -#, fuzzy -msgid "suppressing %d rows" -msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" +msgid "index larger than maximal %d" +msgstr "인덱스가 %d 보다 큽니다." -#, fuzzy -msgid "suppressing %d columns" -msgstr "[[ %d개의 열이름 %s를 제거합니다 ]]" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" +msgstr "'NA'는 sparse Matrices에 (아직은?) 사용할 수 없는 인덱스입니다" -msgid "logic programming error in printSpMatrix2(), please report" +msgid "logical subscript too long (%d, should be %d)" msgstr "" -"printSpMatrix2()를 이용 도중 논리적 프로그래밍 에러(logic programming error)" -"가 발생했습니다. 이를 꼭 보고를 부탁드립니다." +"길이가 너무 긴 논리형 첨자(subscript)입니다 (%2$d이어야 하는데 %1$d입니다)." -msgid "'V' is not a *square* matrix" -msgstr "'V'는 정방행렬(square matrix)이 아닙니다." +msgid "no 'dimnames[[.]]': cannot use character indexing" +msgstr "no 'dimnames[[.]]': 문자형 인덱싱을 사용할 수 없습니다" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" -msgstr "" -"diag(.)에 0 또는 NA가 존재하므로 유한하지 않은 결과(non-finite result)를 얻" -"을 것으로 생각됩니다." +msgid "invalid character indexing" +msgstr "유효하지 않은 문자형 인덱싱입니다" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +msgid "internal bug: missing 'i' in replTmat(): please report" msgstr "" -"중복된 (i,j)에 위치한 값들 때문에 영이 아닌 요소의 개수가 'nnz' 보다 작습니" -"다." +"내부버그 발견: replTmat()내에서 'i'를 찾을 수 없습니다. 이를 보고해 주시길 부" +"탁드립니다." -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgid "[ ] indexing not allowed: forgot a \",\" ?" msgstr "" +"[ ]와 같은 인덱싱은 사용할 수 없습니다. \",\"의 사용을 잊었나요?" -#, fuzzy -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "%s에 사용된 각 행렬이 가지는 열의 개수는 서로 같아야 합니다." - -#, fuzzy -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "%s에 사용된 각 행렬이 가지는 열의 개수는 서로 같아야 합니다." - -msgid "'x' must inherit from \"sparseVector\"" -msgstr "'x'는 \"sparseVector\"로부터의 상속(inherit)이어야 합니다." +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "" +"내부버그 발견: replTmat()내에서 'i'는 행렬입니다. 이를 보고해 주시길 부탁드립" +"니다." -msgid "'ncol' must be >= 0" -msgstr "'ncol'은 반드시 >= 0 이어야 합니다. " +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" +"은 TRUE로 강제변환(coerced) 되었습니다." -msgid "'nrow' must be >= 0" -msgstr "'nrow'는 반드시 >= 0 이어야 합니다." +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" +"은 강제변환(coerced) 되었습니다." -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "'symmetric'이 참인 경우에는 반드시 'nrow'를 지정해 주어야 합니다." +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." +msgstr "" +"x[.,.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" +"은 TRUE로 강제변환(coerced) 되었습니다. " -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." msgstr "" -"'symmetric'이 참인 경우에는 반드시 'nrow'와 'ncol'을 지정해 주어야 합니다." +"x[.,.] <- val: x의 클래스는 %s입니다. {TRUE, FALSE}에 해당하지 않는 val의 값" +"은 강제변환(coerced) 되었습니다. " -msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" msgstr "" -"'symmetric'이 참인 경우에는 'x'의 길이는 반드시 nrow^2와 같아야 합니다." +"x[.,.] <- val : Tsparse* 에서 CsparseMatrix로 강제변환(coerced)된 x입니다." -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol'는 길이가 length(x)인 요인(factor)가 아닙니다." +msgid "nargs() = %d should never happen; please report." +msgstr "" +"nargs() = %d 와 같은 경우는 발생할 수 없으므로 꼭 보고해 주시기를 부탁드립니" +"다." -msgid "'nrow' is not a factor of length(x)" -msgstr "'nrow'는 길이가 length(x)인 요인(factor)가 아닙니다." +msgid "row indices must be <= nrow(.) which is %d" +msgstr "행에 사용되는 인덱스는 반드시 %d 보다 같거나 작아야 합니다." -msgid "Class %s is not yet implemented" -msgstr "클래스 %s는 아직 구현되지 않았습니다." +msgid "column indices must be <= ncol(.) which is %d" +msgstr "열에 사용되는 인덱스는 %d 보다 같거나 작아야 합니다. " -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +msgid "Internal bug: nargs()=%d; please report" +msgstr "내부버그 발견: nargs()=%d. 꼭 보고를 부탁드립니다." msgid "" "index must be numeric, logical or sparseVector for indexing sparseVectors" @@ -928,12 +932,6 @@ "sparseVectors를 인덱싱하기 위해서는 인덱스는 반드시 수치형, 논리형 또는 " "sparseVectors이어야 합니다." -msgid "'times >= 0' is required" -msgstr "'times >= 0'이 요구되어집니다." - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "" - #, fuzzy msgid "invalid subscript class \"%s\"" msgstr "%s는 사용가능한 클래스(class)가 아닙니다." @@ -942,10 +940,10 @@ msgid "invalid subscript type \"%s\"" msgstr "%s는 사용할 수 없는 저장형식(storage format)입니다." -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -960,25 +958,122 @@ msgid "incorrect number of dimensions" msgstr "차원(dimensions) 정보가 일치하지 않습니다." -#, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x'는 대칭(symmetric)도 아니고 삼각(triangular)도 아닙니다." +msgid "only zeros may be mixed with negative subscripts" +msgstr "" -#, fuzzy -msgid "matrix is not symmetric" -msgstr "삼각행렬이 아닙니다." +msgid "'%s' has length 0 but '%s' does not" +msgstr "" #, fuzzy -msgid "matrix is not triangular" -msgstr "'x'는 대칭(symmetric)도 아니고 삼각(triangular)도 아닙니다." - -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" +"비대칭(non-symmetric) \"dgTMatrix\"는 \"dsCMatrix\" 클래스로 강제변환" +"(coerce) 할 수 없습니다. " #, fuzzy msgid "invalid 'Class2'" msgstr "입력된 'data'는 올바르지 않습니다." +#, fuzzy +#~ msgid "invalid 'each' argument" +#~ msgstr "'by' 인자에 사용된 부호(sign)가 올바르지 않습니다." + +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "입력된 'data'는 올바르지 않습니다." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "%s(<%s>)의 경우에 대하여 아직 구현되지 않은 메소드(method)입니다.\n" +#~ " ->> 이 기능에 대한 구현을 패키지 관리자에게 문의해 주셨으면 합니다." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "%s(<%s>, <%s>)의 경우에 대하여 아직 구현되지 않은 메소드(method)입니다.\n" +#~ " ->> 이 기능에 대한 구현을 패키지 관리자에게 문의해 주시길 바랍니다." + +#, fuzzy +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "%s의 경우에는 아직 구현되지 않은 일반적인 Matrix 클래스입니다." + +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "클래스 %s의 경우에 아직 구현되지 않았습니다." + +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "올바르지 않은 'type'입니다." + +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag'과 'differences'는 반드시 1보다 크거나 같은 정수이어야 합니다." + +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>,...)" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "in Summary(, .): %s(<%s>, <%s>)" + +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "%s의 경우 행의 개수가 올바르지 않습니다." + +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "%s의 경우 행의 개수가 올바르지 않습니다." + +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "dim(.)의 값은 반드시 길이가 2인 수치형 벡터이어야 합니다." + +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A'는 반드시 정방행렬(square matrix)이어야 합니다." + +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol'은 반드시 >= 0 이어야 합니다. " + +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "<%s> %%*%% <%s>에 사용할 수 있는 메소드가 아직 구현되지 않았습니다." + +#, fuzzy +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "아직 구현되지 않은 종류 %s입니다." + +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "rcond(.) via sparse -> dense coercion" + +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "입력된 'data'는 올바르지 않습니다." + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "'NA'를 \"nsparseMatrix\"으로 강제변환(coerce)할 수 없습니다." + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "'NA'를 \"nsparseVector\"로 강제변환(coerce) 할 수 없습니다." + +#~ msgid "" +#~ "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +#~ msgstr "" +#~ "중복된 (i,j)에 위치한 값들 때문에 영이 아닌 요소의 개수가 'nnz' 보다 작습" +#~ "니다." + +#~ msgid "'times >= 0' is required" +#~ msgstr "'times >= 0'이 요구되어집니다." + #~ msgid "Matrices must have same number of rows in %s" #~ msgstr "%s에 사용된 각 행렬이 가지는 행의 개수는 서로 같아야 합니다." diff -Nru rmatrix-1.6-1.1/po/R-lt.po rmatrix-1.6-5/po/R-lt.po --- rmatrix-1.6-1.1/po/R-lt.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-lt.po 2023-11-03 01:34:40.000000000 +0000 @@ -1,7 +1,7 @@ msgid "" msgstr "" "Project-Id-Version: Matrix 1.3-3\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2021-03-01 20:55+0200\n" "Last-Translator: Gabrielė Stupurienė \n" "Language-Team: none\n" @@ -13,77 +13,35 @@ "Plural-Forms: nplurals=3; plural=(n%10==1 && (n%100<11 || n%100>19) ? 0 : " "n%10>=2 && n%10<=9 && (n%100<11 || n%100>19) ? 1 : 2);\n" -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "negaliojantis 'mod': %s" msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"dar neįgyvendintas metodas dėl %s (<%s>).\n" -" ->> Paprašykite paketo autorių įgyvendinti trūkstamą funkciją." - -msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"dar neįgyvendintas metodas dėl %s (<%s>, <%s>).\n" -" ->> Paprašykite paketo autorių įgyvendinti trūkstamą funkciją." - -msgid "non-conformable matrix dimensions in %s" -msgstr "neatitinkantys matricos matmenys, esantys %s" #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "bendroji Matrix klasė dar neįgyvendinta %s" +msgid "complex %s not yet implemented" +msgstr "Klasės %s dar neįgyvendinta" #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "negalima paversti 'NA' į \"nsparseMatrix\"" #, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ nerodyti %d stulpelių pavadinimų %s ... ]]" - -#, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "dar neįgyvendinta klasei %s" -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "dar neįgyvendinta klasei %s" - -#, fuzzy -msgid "invalid 'uplo'" -msgstr "neleistinas 'type'" - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -msgid "nothing to replace with" -msgstr "nėra nieko pakeisti su" - -msgid "number of items to replace is not a multiple of replacement length" -msgstr "keičiamų elementų skaičius nėra keičiamo ilgio kartotinis" - -msgid "too many replacement values" -msgstr "per daug pakeitimo reikšmių" - -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "i1[1] == 0 ==> C lygio daugiakalbiškumas neįvyks!" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "naudojant\t \"senojo kodo\" dalį Csparse antriniame priskyrime" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"naudojant \"senojo kodo\" dalį Csparse antriniame priskyrime\n" -" >>> prašome pranešti Matrix-authors@r-project.org" msgid "Not a valid format" msgstr "Neleistinas formatas" @@ -147,56 +105,26 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "'%s()' dar neįgyvendinta '%s' atvaizdavimui" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" -msgstr "" - -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" -msgstr "" - -msgid "invalid 'data'" -msgstr "neleistinas 'data'" - -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "matricos 'data' atveju neatsižvelgiama į 'nrow', 'ncol' ir t. t." - -msgid "data is too long" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag' ir 'differences' turi būti sveikieji skaičiai >= 1" - msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -".M.repl.i.2col(): 'i' neturi sveiko skaičiaus stulpelio numerio;\n" -" niekada neturėtų įvykti; prašome pranešti" - -msgid "such indexing must be by logical or 2-column numeric matrix" -msgstr "toks indeksavimas turi būti loginis arba 2 stulpelių skaitinė matrica" - -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col(): išmetė 'matrix' atveją ..." - -msgid "negative values are not allowed in a matrix subscript" -msgstr "matricos apatiniame indekse neigiamos reikšmės neleidžiamos" - -msgid "NAs are not allowed in subscripted assignments" -msgstr "NA neleidžiamos apatinio indekso priskyrimuose" -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v: neefektyviai apdorojant pavienius elementus" +msgid "longer object length is not a multiple of shorter object length" +msgstr "ilgesnis objekto ilgis nėra trumpesnio objekto ilgio kartotinis" -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. Pašaliniai neteisėti argumentai viduje '[ .. ]' ?" +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "neleistina 'col.names' eilutė: %s" -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"RHS 'value' (%s klasė) atitinka 'ANY', tačiau turi atitikti matricos klasę %s" -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "dar neįgyvendintas 'Matrix[<-' method" +msgid "non-conformable matrix dimensions in %s" +msgstr "neatitinkantys matricos matmenys, esantys %s" msgid "dimnames [%d] mismatch in %s" msgstr "dimnames [%d] neatitikimas %s" @@ -241,75 +169,11 @@ "ilgesnis objekto ilgis\n" "\tnėra trumpesnio objekto ilgio kartotinis" -msgid "longer object length is not a multiple of shorter object length" -msgstr "ilgesnis objekto ilgis nėra trumpesnio objekto ilgio kartotinis" - -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "programavimo klaida: min() turėjo išsiųsti w/ 1st arg daug anksčiau" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "esantis Summary(, .): %s(<%s>, <%s>,...)" - -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "esantis Summary(, .): %s(<%s>, <%s>)" - -msgid "you cannot mix negative and positive indices" -msgstr "negalite maišyti neigiamų ir teigiamų indeksų" - -msgid "index larger than maximal %d" -msgstr "indeksas didesnis nei maksimalus %d" - -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "'NA' indeksai nėra (dar?) remiami sparse Matrices" - -msgid "logical subscript too long (%d, should be %d)" -msgstr "loginis apatinis indeksas per ilgas (%d, turėtų būti %d)" - -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "nėra 'dimnames[[.]]': negalima naudoti simbolių indeksavimo" - -msgid "invalid character indexing" -msgstr "neleistinas simbolių indeksavimas" - -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "vidinė klaida: trūksta 'i' replTmat(): prašome pranešti" - -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "[ ] indeksavimas neleidžiamas: pamiršote \",\" ?" - -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "vidinė klaida: matrica 'i', esanti replTmat(): prašome pranešti" - -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas; NA |--" -"> TRUE." - -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "x[.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas." - -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[...] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas NA |--" -"> TRUE." - -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.,.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas." - -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "x[.,.] <- val: x yra paverčiamas iš Tsparse* į CsparseMatrix" - -msgid "nargs() = %d should never happen; please report." -msgstr "nargs() = %d niekada neturėtų įvykti; prašome pranešti." - -msgid "row indices must be <= nrow(.) which is %d" -msgstr "eilučių indeksai turi būti < = nrow(.), kuris yra %d" +msgid "intermediate 'r' is of type %s" +msgstr "tarpinis 'r' yra %s tipo" -msgid "column indices must be <= ncol(.) which is %d" -msgstr "stulpelių indeksai turi būti <= ncol(.), kuris yra %d" +msgid "not yet implemented .. please report" +msgstr "dar neįgyvendinta .. prašome pranešti" msgid "'force' must be (coercable to) TRUE or FALSE" msgstr "'force' turi būti (verčiama į) TRUE arba FALSE" @@ -360,65 +224,21 @@ msgid " --> is not yet implemented" msgstr " --> dar neįgyvendintas" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"T\"' jums" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "'giveCsparse' nebenaudojamas; vietoj to naudos 'repr'" - -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "'diagonals' matricoje turi būti %d stulpeliai (= length(k) )" - -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagonals' turi būti tokio pat ilgio (%d) kaip ir 'k'" - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "matrica gali būti simetriška tik kvadratinė, bet n != m" - -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"simetrinės juostos matricai nurodykite tik viršutinį arba apatinį trikampį\n" -" taigi, visi k turi turėti tą patį ženklą" - -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "%d įstrižainė (k = %d) yra per trumpa; užpildymas su NA" - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "negaliojantis 'repr'; turi būti \"C\", \"T\" arba \"R\"" - -#, fuzzy -msgid "number of rows of matrices must match" -msgstr "eilučių skaičius nesuderinamas su %s" - #, fuzzy -msgid "number of columns of matrices must match" -msgstr "eilučių skaičius nesuderinamas su %s" - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "gautas x-slot turi skirtingą tipą nei x arba y" - -#, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "chol() neapibrėžtas įstrižainei matricai su neigiamais įrašais" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - #, fuzzy msgid "matrix is not square" msgstr "matrica nėra įstrižainė" msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "'x' turi paveldėti iš \"sparseVector\"" msgid "D[i,i] is NA, i=%d" @@ -427,7 +247,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" #, fuzzy @@ -441,16 +261,22 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "neleistinas 'type'" -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "Netinkamas saugyklos tipas: %s" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "neleistina 'col.names' eilutė: %s" + +msgid "%s length cannot exceed %s" msgstr "" msgid "'A' must be a square matrix" @@ -474,29 +300,83 @@ msgid "not enough new vecs -- stop iterations" msgstr "nepakanka naujų vecs -- sustabdyti iteracijas" +msgid "invalid 'data'" +msgstr "neleistinas 'data'" + #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "dim(.) reikšmė turi būti skaitinio ilgio 2" +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "matricos 'data' atveju neatsižvelgiama į 'nrow', 'ncol' ir t. t." -msgid "dimensions cannot contain NA" +msgid "data is too long" msgstr "" -msgid "dimensions cannot contain negative values" +#, fuzzy +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgstr "iškvietimo metu turi trūkti tiksliai vieno iš 'i', 'j' arba 'p'" + +msgid "" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" msgstr "" -msgid "invalid nargs()= %d" -msgstr "neleistini nargs()= %d" +#, fuzzy +msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgstr "'giveCsparse' nebenaudojamas; vietoj to naudos 'repr'" -msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +#, fuzzy +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"T\"' jums" + +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p' turi būti nemažėjantis vektorius (0, ...)" + +msgid "dimensions cannot exceed 2^31-1" msgstr "" -msgid "determinant of non-square matrix is undefined" +msgid "'i' and 'j' must not contain NA" +msgstr "" + +msgid "'i' and 'j' must be" +msgstr "" + +msgid "positive" +msgstr "" + +msgid "non-negative" +msgstr "" + +#, fuzzy +msgid "invalid 'dims'" +msgstr "neleistinas 'data'" + +msgid "'dims' must contain all (i,j) pairs" +msgstr "" + +msgid "symmetric matrix must be square" +msgstr "simetrinė matrica turi būti kvadratinė" + +msgid "triangular matrix must be square" +msgstr "trikampė matrica turi būti kvadratinė" + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "length(i) nėra length(x) kartotinis" + +msgid "length(x) must not exceed" msgstr "" #, fuzzy +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +msgstr "negaliojantis 'repr'; turi būti \"C\", \"T\" arba \"R\"" + +#, fuzzy msgid "'n' must be a non-negative integer" msgstr "ilgis turi būti ne neigiamas skaičius" @@ -534,29 +414,115 @@ msgid "'lst' must be a list" msgstr "'ncol' turi būti >= 0" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"T\"' jums" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "'giveCsparse' nebenaudojamas; vietoj to naudos 'repr'" + +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "'diagonals' matricoje turi būti %d stulpeliai (= length(k) )" + +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagonals' turi būti tokio pat ilgio (%d) kaip ir 'k'" + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "matrica gali būti simetriška tik kvadratinė, bet n != m" + +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"simetrinės juostos matricai nurodykite tik viršutinį arba apatinį trikampį\n" +" taigi, visi k turi turėti tą patį ženklą" + +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "%d įstrižainė (k = %d) yra per trumpa; užpildymas su NA" + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "negaliojantis 'repr'; turi būti \"C\", \"T\" arba \"R\"" + +msgid "'x' must inherit from \"sparseVector\"" +msgstr "'x' turi paveldėti iš \"sparseVector\"" + +msgid "'ncol' must be >= 0" +msgstr "'ncol' turi būti >= 0" + +msgid "'nrow' must be >= 0" +msgstr "'nrow' turi būti >= 0" + +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "Turi nurodyti 'nrow', kai 'symmetric' yra teisinga" + +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "'nrow' ir 'ncol' turi būti vienodi, kai 'symmetric' yra teisinga" + +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "'x' turi būti ilgio nrow^2, kai 'symmetric' yra teisingas" + +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol' nėra length(x) faktorius" + +msgid "'nrow' is not a factor of length(x)" +msgstr "\"nrow\" nėra length(x) faktorius" + +msgid "Class %s is not yet implemented" +msgstr "Klasės %s dar neįgyvendinta" + +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "ilgis turi būti ne neigiamas skaičius" + +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x' nėra nei simetriškas, nei trikampis" + +#, fuzzy +msgid "matrix is not symmetric" +msgstr "matrica nėra trikampė" + +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x' nėra nei simetriškas, nei trikampis" + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -msgid "Internal bug: nargs()=%d; please report" -msgstr "Vidinė klaida: nargs()=%d; prašome pranešti" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -msgid "intermediate 'r' is of type %s" -msgstr "tarpinis 'r' yra %s tipo" +msgid "assigned dimensions do not have length %d" +msgstr "" -msgid "not yet implemented .. please report" -msgstr "dar neįgyvendinta .. prašome pranešti" +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" +msgstr "" + +msgid "assigned dimensions exceed %s" msgstr "" -msgid "'x' has non-finite values" +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "dim [product %d] neatitinka objekto ilgio [%d]" + +msgid "'%s' has non-finite values" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" #, fuzzy @@ -569,33 +535,63 @@ msgstr "'lwd' turi būti NULL arba ne neigiamas skaitinis" #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A' turi būti kvadratinė matrica" +msgid "%s(<%s>) is not yet implemented" +msgstr "Klasės %s dar neįgyvendinta" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" +msgstr "" + +msgid "'%s' has elements less than %d" msgstr "" #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol' turi būti >= 0" +msgid "'%s' is not a non-negative number" +msgstr "ilgis turi būti ne neigiamas skaičius" + +msgid "'%s' has elements exceeding '%s'" +msgstr "" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' is not %d or %d" msgstr "" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol' nėra length(x) faktorius" + +#, fuzzy +msgid "matrix must have exactly one entry in each row or column" msgstr "eilutėje turi būti lygiai vienas ne nulinis įrašas" #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" -msgstr "kronecker metodas turi naudoti numatytąjį 'FUN'" +msgid "attempt to coerce non-square matrix to %s" +msgstr "negalima paversti nesimetrinio \"dgTMatrix\" į \"dsCMatrix\" klasę" -msgid "number of nonzero entries cannot exceed 2^31-1" +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "eilutėje turi būti lygiai vienas ne nulinis įrašas" + +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "rcond(.) per sparse -> dense pavertimą" + +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "neleistini nargs()= %d" + +msgid "norm" msgstr "" +#, fuzzy +msgid "'%s' method must use default %s=\"%s\"" +msgstr "kronecker metodas turi naudoti numatytąjį 'FUN'" + +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "eilučių skaičius nesuderinamas su %s" + msgid "Matrix seems negative semi-definite" msgstr "Matrica atrodo pusiau neigiamai apibrėžta" @@ -603,59 +599,49 @@ msgstr "'nearPD()' nekonvergavo %d iteracijose" #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "rcond(.) per sparse -> dense pavertimą" - -msgid "invalid 'type'" -msgstr "neleistinas 'type'" +msgid "'cl' is not a character string" +msgstr "'V' nėra *kvadratinė* matrica" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "negalima paversti nesimetrinio \"dgTMatrix\" į \"dsCMatrix\" klasę" +msgid "'%s' is not a square numeric matrix" +msgstr "'V' nėra *kvadratinė* matrica" #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "eilutėje turi būti lygiai vienas ne nulinis įrašas" - -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "dar neįgyvendintas metodas <%s> %%*%% <%s>" +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "diag(.) turėjo 0 arba NA įrašus; abejotinas ne baigtinis rezultatas" msgid "non-conformable arguments" msgstr "neatitinkantys argumentai" -msgid "'boolArith = %d' not yet implemented" -msgstr "'boolArith = %d' dar neįgyvendintas" - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" #, fuzzy -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "RHS 'b' ilgis neteisingas" #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "neleistina 'col.names' eilutė: %s" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "qr2rankMatrix(.): QR tik su %d iš %d baigtinių diag(R) įrašų" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "qr2rankMatrix(.): QR turi neigiamų diag(R) įrašų" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -667,28 +653,46 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr'): skaičiavimas t(x) kaip nrow(x) < ncol(x)" -msgid "rcond(x) is undefined: 'x' has length 0" -msgstr "" - #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "rcond(.) per sparse -> dense pavertimą" +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ nerodyti %d stulpelių pavadinimų %s ... ]]" + +msgid "invalid 'col.names' string: %s" +msgstr "neleistina 'col.names' eilutė: %s" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" +msgstr "uniDiag=TRUE, bet ne visi įstrižainės įrašai yra 1" + +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgstr "uniDiag=TRUE, ne visi įstrižainės įrašai, koduoti kaip 1" #, fuzzy -msgid "invalid 'norm'" -msgstr "neleistinas 'data'" +msgid "in show(); maybe adjust options(max.print=, width=)" +msgstr "show(); galbūt pritaikyti 'options(max.print= *, width = *)'" + +msgid "suppressing %d columns and %d rows" +msgstr "nerodyti %d stulpelių ir %d eilučių" + +msgid "suppressing %d rows" +msgstr "nerodyti %d eilučių" + +msgid "suppressing %d columns" +msgstr "nerodyti %d stulpelių" + +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "loginio programavimo klaida printSpMatrix2(), prašome pranešti" #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V' nėra kvadratinė matrica" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -700,13 +704,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" -msgstr "negalima paversti NA reikšmes į modelį \"ngCMatrix\"" - -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "negalima paversti 'NA' į \"nsparseVector\"" +msgid "cannot coerce from %s to %s" +msgstr "" #, fuzzy msgid "model frame and formula mismatch in sparse.model.matrix()" @@ -723,141 +722,153 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "kintamojo '%s' nėra, jo kontrastas bus ignoruojamas" -#, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "iškvietimo metu turi trūkti tiksliai vieno iš 'i', 'j' arba 'p'" - -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" -msgstr "" - -#, fuzzy -msgid "'giveCsparse' is deprecated; using 'repr' instead" -msgstr "'giveCsparse' nebenaudojamas; vietoj to naudos 'repr'" +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgstr "sparseMatrix retai turėtų būti centre: daugiau nebus sparse" -#, fuzzy -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" -msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"T\"' jums" +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "'center' ilgis turi būti lygus stulpelių skaičiui 'x'" -#, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p' turi būti nemažėjantis vektorius (0, ...)" +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "'scale' ilgis turi būti lygus stulpelių skaičiui 'x'" -msgid "'i' and 'j' must not contain NA" +msgid "trimmed means are not defined for complex data" msgstr "" -msgid "'i' and 'j' must be" +msgid "first element used of '%s' argument" msgstr "" -msgid "positive" -msgstr "" +#, fuzzy +msgid "invalid '%s' argument" +msgstr "neleistinas 'data'" -msgid "non-negative" +msgid "should never happen ..." msgstr "" #, fuzzy -msgid "invalid 'dims'" -msgstr "neleistinas 'data'" +msgid "'%s' is deprecated; using '%s' instead" +msgstr "'giveCsparse' nebenaudojamas; vietoj to naudos 'repr'" -msgid "'dims' must contain all (i,j) pairs" +#, fuzzy +msgid "'%s' is deprecated; setting %s=\"%s\"" +msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"T\"' jums" + +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col(): 'i' neturi sveiko skaičiaus stulpelio numerio;\n" +" niekada neturėtų įvykti; prašome pranešti" -msgid "symmetric matrix must be square" -msgstr "simetrinė matrica turi būti kvadratinė" +msgid "such indexing must be by logical or 2-column numeric matrix" +msgstr "toks indeksavimas turi būti loginis arba 2 stulpelių skaitinė matrica" -msgid "triangular matrix must be square" -msgstr "trikampė matrica turi būti kvadratinė" +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col(): išmetė 'matrix' atveją ..." -msgid "p[length(p)]" -msgstr "" +msgid "negative values are not allowed in a matrix subscript" +msgstr "matricos apatiniame indekse neigiamos reikšmės neleidžiamos" -msgid "length(i)" -msgstr "" +msgid "NAs are not allowed in subscripted assignments" +msgstr "NA neleidžiamos apatinio indekso priskyrimuose" -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "length(i) nėra length(x) kartotinis" +msgid "number of items to replace is not a multiple of replacement length" +msgstr "keičiamų elementų skaičius nėra keičiamo ilgio kartotinis" -msgid "length(x) must not exceed" +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v: neefektyviai apdorojant pavienius elementus" + +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. Pašaliniai neteisėti argumentai viduje '[ .. ]' ?" + +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"RHS 'value' (%s klasė) atitinka 'ANY', tačiau turi atitikti matricos klasę %s" -#, fuzzy -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" -msgstr "negaliojantis 'repr'; turi būti \"C\", \"T\" arba \"R\"" +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "dar neįgyvendintas 'Matrix[<-' method" -msgid "invalid 'col.names' string: %s" -msgstr "neleistina 'col.names' eilutė: %s" +msgid "invalid nargs()= %d" +msgstr "neleistini nargs()= %d" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "uniDiag=TRUE, bet ne visi įstrižainės įrašai yra 1" +msgid "nothing to replace with" +msgstr "nėra nieko pakeisti su" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" -msgstr "uniDiag=TRUE, ne visi įstrižainės įrašai, koduoti kaip 1" +msgid "too many replacement values" +msgstr "per daug pakeitimo reikšmių" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" -msgstr "show(); galbūt pritaikyti 'options(max.print= *, width = *)'" +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" +msgstr "i1[1] == 0 ==> C lygio daugiakalbiškumas neįvyks!" -msgid "suppressing %d columns and %d rows" -msgstr "nerodyti %d stulpelių ir %d eilučių" +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "naudojant\t \"senojo kodo\" dalį Csparse antriniame priskyrime" -msgid "suppressing %d rows" -msgstr "nerodyti %d eilučių" +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" +msgstr "" +"naudojant \"senojo kodo\" dalį Csparse antriniame priskyrime\n" +" >>> prašome pranešti Matrix-authors@r-project.org" -msgid "suppressing %d columns" -msgstr "nerodyti %d stulpelių" +msgid "you cannot mix negative and positive indices" +msgstr "negalite maišyti neigiamų ir teigiamų indeksų" -msgid "logic programming error in printSpMatrix2(), please report" -msgstr "loginio programavimo klaida printSpMatrix2(), prašome pranešti" +msgid "index larger than maximal %d" +msgstr "indeksas didesnis nei maksimalus %d" -msgid "'V' is not a *square* matrix" -msgstr "'V' nėra *kvadratinė* matrica" +msgid "'NA' indices are not (yet?) supported for sparse Matrices" +msgstr "'NA' indeksai nėra (dar?) remiami sparse Matrices" -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" -msgstr "diag(.) turėjo 0 arba NA įrašus; abejotinas ne baigtinis rezultatas" +msgid "logical subscript too long (%d, should be %d)" +msgstr "loginis apatinis indeksas per ilgas (%d, turėtų būti %d)" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" -msgstr "ne nulių skaičius yra mažesnis už 'nnz' dėl dubliuotų (i,j)s" +msgid "no 'dimnames[[.]]': cannot use character indexing" +msgstr "nėra 'dimnames[[.]]': negalima naudoti simbolių indeksavimo" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" -msgstr "sparseMatrix retai turėtų būti centre: daugiau nebus sparse" +msgid "invalid character indexing" +msgstr "neleistinas simbolių indeksavimas" -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "'center' ilgis turi būti lygus stulpelių skaičiui 'x'" +msgid "internal bug: missing 'i' in replTmat(): please report" +msgstr "vidinė klaida: trūksta 'i' replTmat(): prašome pranešti" -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "'scale' ilgis turi būti lygus stulpelių skaičiui 'x'" +msgid "[ ] indexing not allowed: forgot a \",\" ?" +msgstr "[ ] indeksavimas neleidžiamas: pamiršote \",\" ?" -msgid "'x' must inherit from \"sparseVector\"" -msgstr "'x' turi paveldėti iš \"sparseVector\"" +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "vidinė klaida: matrica 'i', esanti replTmat(): prašome pranešti" -msgid "'ncol' must be >= 0" -msgstr "'ncol' turi būti >= 0" +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas; NA |--" +"> TRUE." -msgid "'nrow' must be >= 0" -msgstr "'nrow' turi būti >= 0" +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "x[.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas." -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "Turi nurodyti 'nrow', kai 'symmetric' yra teisinga" +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." +msgstr "" +"x[...] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas NA |--" +"> TRUE." -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" -msgstr "'nrow' ir 'ncol' turi būti vienodi, kai 'symmetric' yra teisinga" +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.,.] <- val: x yra %s, val, kurio nėra {TRUE, FALSE} yra paverčiamas." -msgid "'x' must have length nrow^2 when 'symmetric' is true" -msgstr "'x' turi būti ilgio nrow^2, kai 'symmetric' yra teisingas" +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgstr "x[.,.] <- val: x yra paverčiamas iš Tsparse* į CsparseMatrix" -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol' nėra length(x) faktorius" +msgid "nargs() = %d should never happen; please report." +msgstr "nargs() = %d niekada neturėtų įvykti; prašome pranešti." -msgid "'nrow' is not a factor of length(x)" -msgstr "\"nrow\" nėra length(x) faktorius" +msgid "row indices must be <= nrow(.) which is %d" +msgstr "eilučių indeksai turi būti < = nrow(.), kuris yra %d" -msgid "Class %s is not yet implemented" -msgstr "Klasės %s dar neįgyvendinta" +msgid "column indices must be <= ncol(.) which is %d" +msgstr "stulpelių indeksai turi būti <= ncol(.), kuris yra %d" -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +msgid "Internal bug: nargs()=%d; please report" +msgstr "Vidinė klaida: nargs()=%d; prašome pranešti" msgid "" "index must be numeric, logical or sparseVector for indexing sparseVectors" @@ -865,12 +876,6 @@ "indeksas turi būti skaitinis, loginis arba sparseVector, sparseVectors " "indeksavimui" -msgid "'times >= 0' is required" -msgstr "'times >= 0' yra būtinas" - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"%s\"' jums" - #, fuzzy msgid "invalid subscript class \"%s\"" msgstr "netinkama klasė: %s" @@ -879,10 +884,10 @@ msgid "invalid subscript type \"%s\"" msgstr "Netinkamas saugyklos tipas: %s" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -896,24 +901,124 @@ msgid "incorrect number of dimensions" msgstr "nesuderinamos matricos dimensijos" +msgid "only zeros may be mixed with negative subscripts" +msgstr "" + +msgid "'%s' has length 0 but '%s' does not" +msgstr "" + #, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x' nėra nei simetriškas, nei trikampis" +msgid "attempt to coerce matrix with NA to %s" +msgstr "negalima paversti nesimetrinio \"dgTMatrix\" į \"dsCMatrix\" klasę" #, fuzzy -msgid "matrix is not symmetric" -msgstr "matrica nėra trikampė" +msgid "invalid 'Class2'" +msgstr "neleistinas 'data'" + +#~ msgid "qr2rankMatrix(.): QR has negative diag(R) entries" +#~ msgstr "qr2rankMatrix(.): QR turi neigiamų diag(R) įrašų" #, fuzzy -msgid "matrix is not triangular" -msgstr "'x' nėra nei simetriškas, nei trikampis" +#~ msgid "invalid 'each' argument" +#~ msgstr "neteisingas ženklas 'by' argumente" -msgid "attempt to coerce matrix with NA to ngCMatrix" -msgstr "" +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "neleistinas 'data'" + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "dar neįgyvendintas metodas dėl %s (<%s>).\n" +#~ " ->> Paprašykite paketo autorių įgyvendinti trūkstamą funkciją." + +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "dar neįgyvendintas metodas dėl %s (<%s>, <%s>).\n" +#~ " ->> Paprašykite paketo autorių įgyvendinti trūkstamą funkciją." #, fuzzy -msgid "invalid 'Class2'" -msgstr "neleistinas 'data'" +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "bendroji Matrix klasė dar neįgyvendinta %s" + +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "dar neįgyvendinta klasei %s" + +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "neleistinas 'type'" + +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag' ir 'differences' turi būti sveikieji skaičiai >= 1" + +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "programavimo klaida: min() turėjo išsiųsti w/ 1st arg daug anksčiau" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "esantis Summary(, .): %s(<%s>, <%s>,...)" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "esantis Summary(, .): %s(<%s>, <%s>)" + +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "eilučių skaičius nesuderinamas su %s" + +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "eilučių skaičius nesuderinamas su %s" + +#~ msgid "resulting x-slot has different type than x's or y's" +#~ msgstr "gautas x-slot turi skirtingą tipą nei x arba y" + +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "dim(.) reikšmė turi būti skaitinio ilgio 2" + +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A' turi būti kvadratinė matrica" + +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol' turi būti >= 0" + +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "dar neįgyvendintas metodas <%s> %%*%% <%s>" + +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "'boolArith = %d' dar neįgyvendintas" + +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "rcond(.) per sparse -> dense pavertimą" + +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "neleistinas 'data'" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "negalima paversti NA reikšmes į modelį \"ngCMatrix\"" + +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "negalima paversti 'NA' į \"nsparseVector\"" + +#~ msgid "" +#~ "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" +#~ msgstr "ne nulių skaičius yra mažesnis už 'nnz' dėl dubliuotų (i,j)s" + +#~ msgid "'times >= 0' is required" +#~ msgstr "'times >= 0' yra būtinas" + +#~ msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" +#~ msgstr "'giveCsparse' nebenaudojamas; nustatymas 'repr = \"%s\"' jums" #~ msgid "Matrices must have same number of rows in %s" #~ msgstr "Matricos turi turėti tą patį eilučių skaičių %s" diff -Nru rmatrix-1.6-1.1/po/R-pl.po rmatrix-1.6-5/po/R-pl.po --- rmatrix-1.6-1.1/po/R-pl.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/R-pl.po 2023-11-03 01:34:40.000000000 +0000 @@ -2,7 +2,7 @@ msgstr "" "Project-Id-Version: Matrix 1.1-2-2\n" "Report-Msgid-Bugs-To: bugs.r-project.org\n" -"POT-Creation-Date: 2023-08-03 13:24\n" +"POT-Creation-Date: 2023-11-02 21:33\n" "PO-Revision-Date: 2014-03-27 14:47+0100\n" "Last-Translator: Łukasz Daniel \n" "Language-Team: Łukasz Daniel \n" @@ -19,125 +19,41 @@ # stop(gettextf("invalid 'mod': %s", mod), domain = "R-Matrix") # Matrix/R/Auxiliaries.R: 26 # stop(gettextf("invalid 'mod': %s", mod), domain = "R-Matrix") -msgid "invalid 'mod': %s" +#, fuzzy +msgid "invalid mode \"%s\"" msgstr "niepoprawne 'mod': %s" -# Matrix/R/Auxiliaries.R: 65 -# stop(gettextf("not-yet-implemented method for %s(<%s>).\n ->> Ask the package authors to implement the missing feature.", fun, cl), call. = FALSE, domain = "R-Matrix") -msgid "" -"not-yet-implemented method for %s(<%s>).\n" -" ->> Ask the package authors to implement the missing feature." -msgstr "" -"metoda jeszcze niezaimplementowana dla %s(<%s>).\n" -" ->> Poproś autorów pakietu o zaimplementowanie brakującej funkcjonalności." - -# Matrix/R/Auxiliaries.R: 68 -# stop(gettextf("not-yet-implemented method for %s(<%s>, <%s>).\n ->> Ask the package authors to implement the missing feature.", fun, cl1, cl2), call. = FALSE, domain = "R-Matrix") msgid "" -"not-yet-implemented method for %s(<%s>, <%s>).\n" -" ->> Ask the package authors to implement the missing feature." +"%s(<%s>, <%s>) is not yet implemented; ask maintainer(\"%s\") to implement " +"the missing method" msgstr "" -"metoda jeszcze niezaimplementowana dla %s(<%s>, <%s>).\n" -" ->> Poproś autorów pakietu o zaimplementowanie brakującej funkcjonalności." - -# Matrix/R/Auxiliaries.R: 273 -# stop(gettextf("non-conformable matrix dimensions in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") -msgid "non-conformable matrix dimensions in %s" -msgstr "niezgodne wymiary macierzy w %s" -# Matrix/R/Auxiliaries.R: 906 -# stop(gettextf("general Matrix class not yet implemented for %s", dQuote(class(x))), domain = "R-Matrix") +# Matrix/R/sparseVector.R: 278 +# stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), domain = "R-Matrix") #, fuzzy -msgid "complex \"diagonalMatrix\" not yet implemented" -msgstr "ogólna klasa 'Matrix' jeszcze nie jest zaimplementowana dla %s" +msgid "complex %s not yet implemented" +msgstr "Klasa %s nie jest jeszcze zaimplementowana" # Matrix/R/ngTMatrix.R: 24 # stop("cannot coerce 'NA's to \"nsparseMatrix\"") #, fuzzy -msgid "cannot coerce matrix of type \"%s\" to \"diagonalMatrix\"" +msgid "cannot coerce matrix of type \"%s\" to %s" msgstr "nie można przekształcić wartości 'NA' na 'nsparseMatrix'" -# Matrix/R/Auxiliaries.R: 373 -# message(sprintf(gettext(" [[ suppressing %d column names %s... ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:3]), collapse = ", ")), domain = NA) -#, fuzzy -msgid "[[ suppressing %d column name%s %s ... ]]" -msgstr "[[ zmniejszanie %d nazw kolumn %s ... ]]" - # Matrix/R/Auxiliaries.R: 641 # stop(gettextf("not yet implemented for class %s", dQuote(class.x)), domain = "R-Matrix") #, fuzzy msgid "non0.i() not yet implemented for class %s" msgstr "jeszcze niezaimplementowane dla klasy %s" -# Matrix/R/Auxiliaries.R: 641 -# stop(gettextf("not yet implemented for class %s", dQuote(class.x)), domain = "R-Matrix") -#, fuzzy -msgid "not yet implemented for class \"%s\"" -msgstr "jeszcze niezaimplementowane dla klasy %s" - -# Matrix/R/sparseMatrix.R: 731 -# stop("invalid 'type'") -#, fuzzy -msgid "invalid 'uplo'" -msgstr "niepoprawny 'type'" - -msgid "which=\"%s\" invalid for x@uplo=\"%s\"" +msgid "%s=\"%s\" invalid for %s@uplo=\"%s\"" msgstr "" -msgid "'which' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" +msgid "'%s' is not \"%1$s\", \"D%1$s\", or \"%1$s.\"" msgstr "" -# Matrix/R/Csparse.R: 240 -# stop("nothing to replace with") -# Matrix/R/Tsparse.R: 400 -# stop("nothing to replace with") -# Matrix/R/Tsparse.R: 653 -# stop("nothing to replace with") -# Matrix/R/sparseVector.R: 525 -# stop("nothing to replace with") -msgid "nothing to replace with" -msgstr "nic do zastąpienia" - -# Matrix/R/Matrix.R: 713 -# warning("number of items to replace is not a multiple of replacement length") -# Matrix/R/Csparse.R: 245 -# stop("number of items to replace is not a multiple of replacement length") -# Matrix/R/Tsparse.R: 366 -# warning("number of items to replace is not a multiple of replacement length") -# Matrix/R/Tsparse.R: 405 -# stop("number of items to replace is not a multiple of replacement length") -# Matrix/R/Tsparse.R: 657 -# warning("number of items to replace is not a multiple of replacement length") -# Matrix/R/sparseVector.R: 530 -# stop("number of items to replace is not a multiple of replacement length") -msgid "number of items to replace is not a multiple of replacement length" +msgid "unexpected %s=\"%s\" in '%s' method" msgstr "" -"liczba pozycji do zastąpienia nie jest wielokrotnością długości elementu " -"zastępującego" - -# Matrix/R/Csparse.R: 247 -# stop("too many replacement values") -# Matrix/R/Tsparse.R: 495 -# stop("too many replacement values") -# Matrix/R/sparseVector.R: 557 -# stop("too many replacement values") -msgid "too many replacement values" -msgstr "zbyt dużo wartości zamieniających" - -# Matrix/R/Csparse.R: 284 -# warning("i1[1] == 0 ==> C-level verbosity will not happen!") -msgid "i1[1] == 0 ==> C-level verbosity will not happen!" -msgstr "i1[1] == 0 ==> tryb 'verbose' poziomu C nie zostanie wykonany!" - -msgid "using\t \"old code\" part in Csparse subassignment" -msgstr "używanie\t części 'old code' w przypisaniu w 'Csparse'" - -msgid "" -"using\"old code\" part in Csparse subassignment\n" -" >>> please report to Matrix-authors@r-project.org" -msgstr "" -"używanie części 'old code' w przypisaniu w 'Csparse'\n" -">>> proszę zgłosić raport na adres 'Matrix-authors@r-project.org'" # Matrix/R/HBMM.R: 13 # stop("Not a valid format") @@ -249,91 +165,39 @@ msgid "'%s()' is not yet implemented for representation '%s'" msgstr "'%s()' nie jest jeszcze zaimplementowane dla reprezentacji '%s'" -msgid "'which' is not \"P1\", \"P1.\", \"L\", or \"U\"" -msgstr "" - -msgid "'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"L\", or \"U\"" +msgid "'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", or \"%4$s\"" msgstr "" -# Matrix/R/Matrix.R: 206 -# stop("invalid 'data'") -msgid "invalid 'data'" -msgstr "niepoprawne 'data'" - -# Matrix/R/Matrix.R: 224 -# warning("'nrow', 'ncol', etc, are disregarded for matrix 'data'") -#, fuzzy -msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" -msgstr "'nrow', 'ncol', itd., są nieuwzględniane dla 'data' typu macierzowego" - -msgid "data is too long" -msgstr "" - -# Matrix/R/Matrix.R: 400 -# stop("'lag' and 'differences' must be integers >= 1") -msgid "'lag' and 'differences' must be integers >= 1" -msgstr "'lag' oraz 'differences' muszą być liczbami całkowitymi >= 1" - -# Matrix/R/Matrix.R: 694 -# stop(".M.repl.i.2col(): 'i' has no integer column number;\n should never happen; please report") msgid "" -".M.repl.i.2col(): 'i' has no integer column number;\n" -" should never happen; please report" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", or " +"\"%4$s\"" msgstr "" -".M.repl.i.2col(): 'i' posiada niecałkowitą liczbę kolumn;\n" -"to nie powinno się nigdy wydarzyć; proszę zgłosić raport" -# Matrix/R/Matrix.R: 667 -# stop("such indexing must be by logical or 2-column numeric matrix") -# Matrix/R/Matrix.R: 696 -# stop("such indexing must be by logical or 2-column numeric matrix") -# Matrix/R/Tsparse.R: 638 -# stop("such indexing must be by logical or 2-column numeric matrix") -msgid "such indexing must be by logical or 2-column numeric matrix" +# Matrix/R/Ops.R: 1117 +# warning("longer object length\n\tis not a multiple of shorter object length") +# Matrix/R/Ops.R: 1512 +# warning("longer object length\n\tis not a multiple of shorter object length") +# Matrix/R/Ops.R: 1604 +# warning("longer object length\n\tis not a multiple of shorter object length") +# Matrix/R/Ops.R: 1630 +# warning("longer object length\n\tis not a multiple of shorter object length") +msgid "longer object length is not a multiple of shorter object length" msgstr "" -"takie indeksowanie musi być wykonane poprzez macierz logiczną lub 2-" -"kolumnową macierz liczbową" - -# Matrix/R/Matrix.R: 698 -# message(".M.repl.i.2col(): drop 'matrix' case ...") -msgid ".M.repl.i.2col(): drop 'matrix' case ..." -msgstr ".M.repl.i.2col(): zrzuć przypadek 'matrix' ..." - -# Matrix/R/Matrix.R: 704 -# stop("negative values are not allowed in a matrix subscript") -# Matrix/R/Tsparse.R: 641 -# stop("negative values are not allowed in a matrix subscript") -msgid "negative values are not allowed in a matrix subscript" -msgstr "ujemne wartości nie są dozwolone w indeksach macierzy" - -# Matrix/R/Matrix.R: 706 -# stop("NAs are not allowed in subscripted assignments") -# Matrix/R/Tsparse.R: 643 -# stop("NAs are not allowed in subscripted assignments") -msgid "NAs are not allowed in subscripted assignments" -msgstr "wartości NA nie są dozwolone w indeksowanych przypisaniach" - -# Matrix/R/Matrix.R: 719 -# message("m[ ] <- v: inefficiently treating single elements") -msgid "m[ ] <- v: inefficiently treating single elements" -msgstr "m[ ] <- v: nieefektywne traktowanie pojedynczych elementów" +"długość dłuższego obiektu nie jest wielokrotnością długości krótszego obiektu" -# Matrix/R/Matrix.R: 725 -# stop(gettextf("nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?", nA), domain = "R-Matrix") -msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" -msgstr "nargs() = %d. Obce nielegalne argumenty wewnątrz '[ .. ]' ?" +# Matrix/R/sparseMatrix.R: 372 +# stop(gettextf("invalid 'col.names' string: %s", cn), domain = "R-Matrix") +#, fuzzy +msgid "invalid class \"%s\" in '%s' method" +msgstr "niepoprawny łańcuch 'col.names': %s" -# Matrix/R/Matrix.R: 796 -# stop(gettextf("RHS 'value' (class %s) matches 'ANY', but must match matrix class %s", class(value), class(x)), domain = "R-Matrix") -msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" +msgid "invalid type \"%s\" in '%s' method" msgstr "" -"prawa strona 'value' (klasa %s) pasuje do 'ANY', a musi pasować do klasy " -"macierzy '%s'" -# Matrix/R/Matrix.R: 797 -# stop("not-yet-implemented 'Matrix[<-' method") -msgid "not-yet-implemented 'Matrix[<-' method" -msgstr "jeszcze niezaimplementowana metoda 'Matrix[<-'" +# Matrix/R/Auxiliaries.R: 273 +# stop(gettextf("non-conformable matrix dimensions in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") +msgid "non-conformable matrix dimensions in %s" +msgstr "niezgodne wymiary macierzy w %s" # Matrix/R/Auxiliaries.R: 292 # warning(gettextf("dimnames [%d] mismatch in %s", j, deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") @@ -424,148 +288,15 @@ "długość dłuższego obiektu\n" "\tnie jest wielokrotnością długości krótszego obiektu" -# Matrix/R/Ops.R: 1117 -# warning("longer object length\n\tis not a multiple of shorter object length") -# Matrix/R/Ops.R: 1512 -# warning("longer object length\n\tis not a multiple of shorter object length") -# Matrix/R/Ops.R: 1604 -# warning("longer object length\n\tis not a multiple of shorter object length") -# Matrix/R/Ops.R: 1630 -# warning("longer object length\n\tis not a multiple of shorter object length") -msgid "longer object length is not a multiple of shorter object length" -msgstr "" -"długość dłuższego obiektu nie jest wielokrotnością długości krótszego obiektu" - -# Matrix/R/Matrix.R: 459 -# stop("programming error: min() should have dispatched w/ 1st arg much earlier") -msgid "programming error: min() should have dispatched w/ 1st arg much earlier" -msgstr "" -"błąd programistyczny: 'min()' powinno zostać wysłane z pierwszym argumentem " -"znacznie wcześniej" - -msgid "in Summary(, .): %s(<%s>, <%s>,...)" -msgstr "w funkcji 'Summary(, .): %s(<%s>, <%s>,...)'" - -#, fuzzy -msgid "in Summary(, .): %s(<%s>, <%s>)" -msgstr "w funkcji 'Summary(, .): %s(<%s>, <%s>,...)'" - -# Matrix/R/Tsparse.R: 126 -# stop("you cannot mix negative and positive indices") -# Matrix/R/sparseVector.R: 395 -# stop("you cannot mix negative and positive indices") -# Matrix/R/sparseVector.R: 462 -# stop("you cannot mix negative and positive indices") -msgid "you cannot mix negative and positive indices" -msgstr "nie można mieszać ujemnych oraz dodatnich indeksów" - -# Matrix/R/Tsparse.R: 130 -# stop(gettextf("index larger than maximal %d", n), domain = "R-Matrix") -msgid "index larger than maximal %d" -msgstr "indeks dłuższy niż maksymalny możliwy %d" - -# Matrix/R/Tsparse.R: 123 -# stop("'NA' indices are not (yet?) supported for sparse Matrices") -msgid "'NA' indices are not (yet?) supported for sparse Matrices" -msgstr "indeksy 'NA' nie są (jeszcze?) wspierane dla rzadkich macierzy" - -# Matrix/R/Tsparse.R: 138 -# stop(gettextf("logical subscript too long (%d, should be %d)", length(i), n), domain = "R-Matrix") -msgid "logical subscript too long (%d, should be %d)" -msgstr "indeks logiczny jest zbyt długi (%d, powinien być %d)" - -# Matrix/R/Tsparse.R: 143 -# stop("no 'dimnames[[.]]': cannot use character indexing") -msgid "no 'dimnames[[.]]': cannot use character indexing" -msgstr "brak 'dimnames[[.]]': nie można używać indeksowania tekstowego" - -# Matrix/R/Tsparse.R: 145 -# stop("invalid character indexing") -msgid "invalid character indexing" -msgstr "niepoprawne tekstowe indeksowanie" - -# Matrix/R/Tsparse.R: 309 -# stop("internal bug: missing 'i' in replTmat(): please report") -msgid "internal bug: missing 'i' in replTmat(): please report" -msgstr "błąd wewnętrzny: brakuje 'i' w 'replTmat()': proszę zgłosić raport" - -# Matrix/R/Tsparse.R: 311 -# stop("[ ] indexing not allowed: forgot a \",\" ?") -msgid "[ ] indexing not allowed: forgot a \",\" ?" -msgstr "indeksowanie [ ] nie jest dozwolone: zapomniałeś ',' ?" - -# Matrix/R/Tsparse.R: 313 -# stop("internal bug: matrix 'i' in replTmat(): please report") -msgid "internal bug: matrix 'i' in replTmat(): please report" -msgstr "wewnętrzny błąd: macierz 'i' w 'replTmat()': proszę zgłosić raport" - -# Matrix/R/Tsparse.R: 342 -# 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 = "R-Matrix") -msgid "" -"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." -msgstr "" -"x[.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " -"przekształcona; NA |--> TRUE." - -# Matrix/R/Tsparse.R: 342 -# 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 = "R-Matrix") -msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " -"przekształcona." - -# Matrix/R/Tsparse.R: 500 -# 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 = "R-Matrix") -msgid "" -"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." -msgstr "" -"x[.,.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " -"przekształcona NA |--> TRUE." - -# Matrix/R/Tsparse.R: 500 -# 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 = "R-Matrix") -msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." -msgstr "" -"x[.,.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " -"przekształcona." - -# Matrix/R/Tsparse.R: 529 -# message(gettextf("x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix"), domain = "R-Matrix") -msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" -msgstr "" -"x[.,.] <- wartość : 'x' zostaje przekształcone z 'Tsparse*' na " -"'CsparseMatrix'" - -# Matrix/R/Matrix.R: 769 -# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") -# Matrix/R/Matrix.R: 781 -# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") -# Matrix/R/Tsparse.R: 624 -# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") -msgid "nargs() = %d should never happen; please report." -msgstr "'nargs() = %d' nie powinno się wydarzyć; proszę zgłosić raport." - -# Matrix/R/Tsparse.R: 669 -# stop(gettextf("row indices must be <= nrow(.) which is %d", nr), domain = "R-Matrix") -msgid "row indices must be <= nrow(.) which is %d" -msgstr "indeksy wiersza muszą być <= 'nrow(.)' który wynosi %d" +# Matrix/R/diagMatrix.R: 779 +# stop(gettextf("intermediate 'r' is of type %s", typeof(r)), domain = "R-Matrix") +msgid "intermediate 'r' is of type %s" +msgstr "pośrednie 'r' jest typu %s" -# Matrix/R/Tsparse.R: 670 -# stop(gettextf("column indices must be <= ncol(.) which is %d", nc), domain = "R-Matrix") -msgid "column indices must be <= ncol(.) which is %d" -msgstr "indeksy kolumn muszą być <= 'ncol(.)' który wynosi %d" +# Matrix/R/diagMatrix.R: 796 +# stop("not yet implemented .. please report") +msgid "not yet implemented .. please report" +msgstr "jeszcze niezaimplementowane .. proszę zgłosić raport" # Matrix/R/abIndex.R: 13 # stop("'force' must be (coercable to) TRUE or FALSE") @@ -649,72 +380,13 @@ msgid " --> is not yet implemented" msgstr " --> nie jest jeszcze zaimplementowane" -msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" -msgstr "" - -msgid "'giveCsparse' has been deprecated; will use 'repr' instead" -msgstr "" - -# Matrix/R/bandSparse.R: 26 -# stop(sprintf(ngettext(len.k, "'diagonals' matrix must have %d column (= length(k) )", "'diagonals' matrix must have %d columns (= length(k) )", domain = "R-Matrix"), len.k), domain = NA) -msgid "'diagonals' matrix must have %d columns (= length(k) )" -msgstr "macierz 'diagonals' musi mieć %d kolumnę (= length(k) )" - -# Matrix/R/bandSparse.R: 31 -# stop(gettextf("'diagonals' must have the same length (%d) as 'k'", len.k), domain = "R-Matrix") -msgid "'diagonals' must have the same length (%d) as 'k'" -msgstr "'diagonals' musi mieć tę samą długość (%d) co 'k'" - -msgid "matrix can only be symmetric if square, but n != m" -msgstr "" - -# Matrix/R/bandSparse.R: 36 -# stop("for symmetric band matrix, only specify upper or lower triangle\n hence, all k must have the same sign") -msgid "" -"for symmetric band matrix, only specify upper or lower triangle\n" -" hence, all k must have the same sign" -msgstr "" -"dla symetrycznej macierzy wstęgowej, określ jedynie górny oraz dolny " -"trójkąt\n" -"tak więc, wszystkie k muszą mieć ten sam znak" - -# Matrix/R/bandSparse.R: 64 -# warning(gettextf("the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's", s, kk), domain = "R-Matrix") -msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" -msgstr "" -"(pod)-diagonala %d (k = %d) jest zbyt krótkal wypełnianie wartościami NA" - -msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" -msgstr "" - -# Matrix/R/Ops.R: 438 -# stop(gettextf("number of rows are not compatible for %s", .Generic), domain = "R-Matrix") -#, fuzzy -msgid "number of rows of matrices must match" -msgstr "liczba wierszy nie jest zgodna dla %s" - -# Matrix/R/Ops.R: 438 -# stop(gettextf("number of rows are not compatible for %s", .Generic), domain = "R-Matrix") -#, fuzzy -msgid "number of columns of matrices must match" -msgstr "liczba wierszy nie jest zgodna dla %s" - -msgid "dimensions cannot exceed 2^31-1" -msgstr "" - -msgid "resulting x-slot has different type than x's or y's" -msgstr "" - # Matrix/R/diagMatrix.R: 528 # stop("chol() is undefined for diagonal matrix with negative entries") #, fuzzy -msgid "chol(x) is undefined: 'x' is not positive semidefinite" +msgid "%1$s(%2$s) is undefined: '%2$s' is not positive semidefinite" msgstr "" "'chol()' jest nieokreślona dla macierzy diagonalnych z ujemnymi wpisami" -msgid "Cholesky(A) is undefined: 'A' is not positive semidefinite" -msgstr "" - # Matrix/R/diagMatrix.R: 358 # stop("matrix is not diagonal") #, fuzzy @@ -722,13 +394,14 @@ msgstr "macierz nie jest diagonalna" msgid "" -"'which' is not \"P1\", \"P1.\", \"L\", \"L.\", \"L1\", \"L1.\", or \"D\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%3$s\", \"%3$s.\", \"%3$s1\", \"%3$s1." +"\", or \"%4$s\"" msgstr "" # Matrix/R/sparseVector.R: 235 # stop("'x' must inherit from \"sparseVector\"") #, fuzzy -msgid "'x' does not inherit from virtual class CHMfactor" +msgid "'%s' does not inherit from virtual class %s" msgstr "argument 'x' musi być obiektem klasy \"sparseVector\"" msgid "D[i,i] is NA, i=%d" @@ -737,7 +410,7 @@ msgid "D[i,i] is negative, i=%d" msgstr "" -msgid "'parent' is not formally sparse" +msgid "'%1$s' is not formally symmetric; factorizing tcrossprod(%1$s)" msgstr "" # Matrix/R/ndenseMatrix.R: 77 @@ -764,16 +437,28 @@ msgid "matrix is not diagonal; consider Diagonal(x=diag(.))" msgstr "" -msgid "matrix of invalid type \"%s\" to .m2dense.checking()" -msgstr "" +# Matrix/R/sparseMatrix.R: 731 +# stop("invalid 'type'") +#, fuzzy +msgid "invalid type \"%s\" in '%s'" +msgstr "niepoprawny 'type'" -msgid "invalid kind \"%s\" to .m2dense.checking()" -msgstr "" +# Matrix/R/HBMM.R: 47 +# stop(gettextf("Invalid storage type: %s", t1), domain = "R-Matrix") +#, fuzzy +msgid "invalid %s=\"%s\" to '%s'" +msgstr "Niepoprawny typ przechowywania: %s" -msgid "matrix of invalid type \"%s\" to .m2sparse.checking()" +msgid "dimensions cannot exceed %s" msgstr "" -msgid "invalid kind \"%s\" to .m2sparse.checking()" +# Matrix/R/sparseMatrix.R: 372 +# stop(gettextf("invalid 'col.names' string: %s", cn), domain = "R-Matrix") +#, fuzzy +msgid "invalid class \"%s\" in '%s'" +msgstr "niepoprawny łańcuch 'col.names': %s" + +msgid "%s length cannot exceed %s" msgstr "" # Matrix/R/condest.R: 74 @@ -813,36 +498,94 @@ msgid "not enough new vecs -- stop iterations" msgstr "zbyt mało nowych wektorów -- zatrzymywanie iteracji" -# Matrix/R/denseMatrix.R: 71 -# stop("dim(.) value must be numeric of length 2") -# Matrix/R/sparseVector.R: 317 -# stop("dim(.) value must be numeric of length 2") -# Matrix/R/sparseMatrix.R: 711 -# stop("dim(.) value must be numeric of length 2") +# Matrix/R/Matrix.R: 206 +# stop("invalid 'data'") +msgid "invalid 'data'" +msgstr "niepoprawne 'data'" + +# Matrix/R/Matrix.R: 224 +# warning("'nrow', 'ncol', etc, are disregarded for matrix 'data'") #, fuzzy -msgid "dimensions must be numeric of length 2" -msgstr "wartości 'dim(.)' muszą być liczbami o długości 2" +msgid "'nrow', 'ncol', 'byrow' disregarded for [mM]atrix 'data'" +msgstr "'nrow', 'ncol', itd., są nieuwzględniane dla 'data' typu macierzowego" -msgid "dimensions cannot contain NA" +msgid "data is too long" msgstr "" -msgid "dimensions cannot contain negative values" +# Matrix/R/sparseMatrix.R: 44 +# stop("exactly one of 'i', 'j', or 'p' must be missing from call") +#, fuzzy +msgid "exactly one of 'i', 'j', and 'p' must be missing from call" +msgstr "dokłanie jeden z 'i', 'j', lub 'p' musi być nieobecny w wywołaniu" + +msgid "" +"use Diagonal() to construct diagonal (symmetric && triangular) sparse " +"matrices" msgstr "" -# Matrix/R/denseMatrix.R: 101 -# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") -# Matrix/R/denseMatrix.R: 164 -# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") -msgid "invalid nargs()= %d" -msgstr "niepoprawne nargs()=%d" +msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgstr "" -msgid "" -"the default value of argument 'sqrt' of method 'determinant(, " -")' may change from TRUE to FALSE as soon as the next release of " -"Matrix; set 'sqrt' when programming" +msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" msgstr "" -msgid "determinant of non-square matrix is undefined" +# Matrix/R/sparseMatrix.R: 48 +# stop("'p' must be a non-decreasing vector (0, ...)") +#, fuzzy +msgid "'p' must be a nondecreasing vector c(0, ...)" +msgstr "'p' musi być niemalejącym wektorem (0, ...)" + +msgid "dimensions cannot exceed 2^31-1" +msgstr "" + +msgid "'i' and 'j' must not contain NA" +msgstr "" + +msgid "'i' and 'j' must be" +msgstr "" + +msgid "positive" +msgstr "" + +msgid "non-negative" +msgstr "" + +# Matrix/R/Matrix.R: 206 +# stop("invalid 'data'") +#, fuzzy +msgid "invalid 'dims'" +msgstr "niepoprawne 'data'" + +msgid "'dims' must contain all (i,j) pairs" +msgstr "" + +# Matrix/R/sparseMatrix.R: 67 +# stop("symmetric matrix must be square") +msgid "symmetric matrix must be square" +msgstr "macierz symetryczna musi być kwadratowa" + +# Matrix/R/sparseMatrix.R: 67 +# stop("symmetric matrix must be square") +#, fuzzy +msgid "triangular matrix must be square" +msgstr "macierz symetryczna musi być kwadratowa" + +msgid "p[length(p)]" +msgstr "" + +msgid "length(i)" +msgstr "" + +# Matrix/R/sparseMatrix.R: 79 +# warning("length(i) is not a multiple of length(x)") +#, fuzzy +msgid "is not an integer multiple of length(x)" +msgstr "'length(i)' nie jest wielokrotnością 'length(x)'" + +msgid "length(x) must not exceed" +msgstr "" + +msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" msgstr "" # Matrix/R/abIndex.R: 177 @@ -887,35 +630,160 @@ msgid "'lst' must be a list" msgstr "'ncol' musi być >= 0" +msgid "'giveCsparse' has been deprecated; setting 'repr = \"T\"' for you" +msgstr "" + +msgid "'giveCsparse' has been deprecated; will use 'repr' instead" +msgstr "" + +# Matrix/R/bandSparse.R: 26 +# stop(sprintf(ngettext(len.k, "'diagonals' matrix must have %d column (= length(k) )", "'diagonals' matrix must have %d columns (= length(k) )", domain = "R-Matrix"), len.k), domain = NA) +msgid "'diagonals' matrix must have %d columns (= length(k) )" +msgstr "macierz 'diagonals' musi mieć %d kolumnę (= length(k) )" + +# Matrix/R/bandSparse.R: 31 +# stop(gettextf("'diagonals' must have the same length (%d) as 'k'", len.k), domain = "R-Matrix") +msgid "'diagonals' must have the same length (%d) as 'k'" +msgstr "'diagonals' musi mieć tę samą długość (%d) co 'k'" + +msgid "matrix can only be symmetric if square, but n != m" +msgstr "" + +# Matrix/R/bandSparse.R: 36 +# stop("for symmetric band matrix, only specify upper or lower triangle\n hence, all k must have the same sign") +msgid "" +"for symmetric band matrix, only specify upper or lower triangle\n" +" hence, all k must have the same sign" +msgstr "" +"dla symetrycznej macierzy wstęgowej, określ jedynie górny oraz dolny " +"trójkąt\n" +"tak więc, wszystkie k muszą mieć ten sam znak" + +# Matrix/R/bandSparse.R: 64 +# warning(gettextf("the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's", s, kk), domain = "R-Matrix") +msgid "the %d-th (sub)-diagonal (k = %d) is too short; filling with NA's" +msgstr "" +"(pod)-diagonala %d (k = %d) jest zbyt krótkal wypełnianie wartościami NA" + +msgid "invalid 'repr'; must be \"C\", \"T\", or \"R\"" +msgstr "" + +# Matrix/R/sparseVector.R: 235 +# stop("'x' must inherit from \"sparseVector\"") +msgid "'x' must inherit from \"sparseVector\"" +msgstr "argument 'x' musi być obiektem klasy \"sparseVector\"" + +# Matrix/R/sparseVector.R: 237 +# stop("'ncol' must be >= 0") +msgid "'ncol' must be >= 0" +msgstr "'ncol' musi być >= 0" + +# Matrix/R/sparseVector.R: 239 +# stop("'nrow' must be >= 0") +msgid "'nrow' must be >= 0" +msgstr "'nrow' musi być >= 0" + +# Matrix/R/sparseVector.R: 242 +# stop("Must specify 'nrow' when 'symmetric' is true") +msgid "Must specify 'nrow' when 'symmetric' is true" +msgstr "'nrow' musi być określone, gdy 'symmetric' ma wartość TRUE" + +# Matrix/R/sparseVector.R: 244 +# stop("'nrow' and 'ncol' must be the same when 'symmetric' is true") +msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +msgstr "" +"'nrow' oraz 'ncol' muszą mieć tę samą wartość gdy 'symmetric' ma wartość TRUE" + +# Matrix/R/sparseVector.R: 247 +# stop("'x' must have length nrow^2 when 'symmetric' is true") +msgid "'x' must have length nrow^2 when 'symmetric' is true" +msgstr "'x' musi mieć długość równą 'nrow'^2 gdy 'symmetric' ma wartość TRUE" + +# Matrix/R/sparseVector.R: 255 +# warning("'ncol' is not a factor of length(x)") +msgid "'ncol' is not a factor of length(x)" +msgstr "'ncol' nie jest czynnikiem długości 'length(x)'" + +# Matrix/R/sparseVector.R: 260 +# warning("'nrow' is not a factor of length(x)") +msgid "'nrow' is not a factor of length(x)" +msgstr "'nrow' nie jest czynnikiem długości 'length(x)'" + +# Matrix/R/sparseVector.R: 278 +# stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), domain = "R-Matrix") +msgid "Class %s is not yet implemented" +msgstr "Klasa %s nie jest jeszcze zaimplementowana" + +# Matrix/R/abIndex.R: 177 +# stop("length must be non-negative number") +#, fuzzy +msgid "'%s' and '%s' must be positive integers" +msgstr "długość musi być nieujemną liczbą" + +# Matrix/R/symmetricMatrix.R: 114 +# stop("'x' is not symmetric nor triangular") +#, fuzzy +msgid "matrix is not symmetric or triangular" +msgstr "'x' nie jest macierzą symetryczną ani trójkątną" + +# Matrix/R/dgTMatrix.R: 44 +# stop("the matrix is not triangular") +#, fuzzy +msgid "matrix is not symmetric" +msgstr "macierz nie jest trójkątna" + +# Matrix/R/symmetricMatrix.R: 114 +# stop("'x' is not symmetric nor triangular") +#, fuzzy +msgid "matrix is not triangular" +msgstr "'x' nie jest macierzą symetryczną ani trójkątną" + +msgid "" +"the default value of argument '%s' of method '%s(<%s>, <%s>)' may change " +"from %s to %s as soon as the next release of Matrix; set '%s' when " +"programming" +msgstr "" + +msgid "determinant of non-square matrix is undefined" +msgstr "" + msgid "replacement diagonal has wrong length" msgstr "" msgid "replacement diagonal has incompatible type \"%s\"" msgstr "" -# Matrix/R/diagMatrix.R: 418 -# stop(gettextf("Internal bug: nargs()=%d; please report", na), domain = "R-Matrix") -msgid "Internal bug: nargs()=%d; please report" -msgstr "Błąd wewnętrzny: nargs()=%d; proszę zgłosić raport" +msgid "assigned dimensions are not of type \"%s\" or \"%s\"" +msgstr "" -# Matrix/R/diagMatrix.R: 779 -# stop(gettextf("intermediate 'r' is of type %s", typeof(r)), domain = "R-Matrix") -msgid "intermediate 'r' is of type %s" -msgstr "pośrednie 'r' jest typu %s" +msgid "assigned dimensions do not have length %d" +msgstr "" -# Matrix/R/diagMatrix.R: 796 -# stop("not yet implemented .. please report") -msgid "not yet implemented .. please report" -msgstr "jeszcze niezaimplementowane .. proszę zgłosić raport" +msgid "assigned dimensions are NA" +msgstr "" -msgid "" -"not a positive definite matrix (and positive semidefiniteness is not checked)" +msgid "assigned dimensions are negative" msgstr "" -msgid "'x' has non-finite values" +msgid "assigned dimensions exceed %s" +msgstr "" + +# Matrix/R/Ops.R: 1595 +# stop(sprintf( +# "dim [product %d] do not match the length of object [%d]", +# n1, n2)) +# Matrix/R/Ops.R: 1621 +# stop(sprintf( +# "dim [product %d] do not match the length of object [%d]", +# n2, n1)) +#, fuzzy +msgid "assigned dimensions [product %.0f] do not match object length [%.0f]" +msgstr "wymiar [produkt %d] nie zgadza się z długością obiektu [%d]" + +msgid "'%s' has non-finite values" msgstr "" -msgid "'which' is not \"Q\", \"T\", or \"Q.\"" +msgid "'%1$s' is not \"%2$s\", \"%3$s\", or \"%2$s.\"" msgstr "" # Matrix/R/sparseMatrix.R: 198 @@ -931,37 +799,80 @@ msgid "'lwd' must be NULL or non-negative numeric" msgstr "'lwd' musi mieć wartość NULL lub być nieujemną liczbą" -# Matrix/R/condest.R: 74 -# stop("'A' must be a square matrix") -# Matrix/R/condest.R: 194 -# stop("'A' must be a square matrix") +# Matrix/R/sparseVector.R: 278 +# stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), domain = "R-Matrix") #, fuzzy -msgid "'perm' must be numeric" -msgstr "'A' musi być macierzą kwadratową" +msgid "%s(<%s>) is not yet implemented" +msgstr "Klasa %s nie jest jeszcze zaimplementowana" -msgid "elements of 'perm' must be positive integers" +msgid "'%s' is not of type \"%s\" or \"%s\"" msgstr "" -msgid "elements of 'perm' cannot exceed 'n'" +msgid "'%s' contains NA" msgstr "" -# Matrix/R/sparseVector.R: 237 -# stop("'ncol' must be >= 0") +msgid "'%s' has elements less than %d" +msgstr "" + +# Matrix/R/abIndex.R: 177 +# stop("length must be non-negative number") #, fuzzy -msgid "'margin' must be 1 or 2" -msgstr "'ncol' musi być >= 0" +msgid "'%s' is not a non-negative number" +msgstr "długość musi być nieujemną liczbą" -msgid "elements of 'perm' slot must be positive integers" +msgid "'%s' has elements exceeding '%s'" msgstr "" +msgid "'%s' is not %d or %d" +msgstr "" + +# Matrix/R/sparseVector.R: 255 +# warning("'ncol' is not a factor of length(x)") +#, fuzzy +msgid "'%s' is not a permutation of seq_len(%s)" +msgstr "'ncol' nie jest czynnikiem długości 'length(x)'" + # Matrix/R/indMatrix.R: 71 # stop("must have exactly one non-zero entry per row") # Matrix/R/pMatrix.R: 33 # stop("must have exactly one non-zero entry per row") #, fuzzy -msgid "matrix must have exactly one nonzero element in each row or column" +msgid "matrix must have exactly one entry in each row or column" msgstr "potrzeba mieć dokładnie jeden niezerowy wpis na wiersz" +# Matrix/R/dgTMatrix.R: 20 +# stop("cannot coerce non-symmetric \"dgTMatrix\" to \"dsCMatrix\" class") +#, fuzzy +msgid "attempt to coerce non-square matrix to %s" +msgstr "" +"nie można przekształcić niesymetrycznej macierzy klasy \"dgTMatrix\" na " +"klasę \"dsCMatrix\"" + +# Matrix/R/indMatrix.R: 71 +# stop("must have exactly one non-zero entry per row") +# Matrix/R/pMatrix.R: 33 +# stop("must have exactly one non-zero entry per row") +#, fuzzy +msgid "matrix must have exactly one entry in each row and column" +msgstr "potrzeba mieć dokładnie jeden niezerowy wpis na wiersz" + +# Matrix/R/sparseMatrix.R: 748 +# warning("rcond(.) via sparse -> dense coercion") +#, fuzzy +msgid "'%s' via sparse -> dense coercion" +msgstr "'rcond(.)' poprzez przekształcenie rzadkie -> gęste" + +# Matrix/R/denseMatrix.R: 101 +# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") +# Matrix/R/denseMatrix.R: 164 +# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") +#, fuzzy +msgid "invalid %s=\"%s\"" +msgstr "niepoprawne nargs()=%d" + +msgid "norm" +msgstr "" + # Matrix/R/indMatrix.R: 133 # stop("kronecker method must use default 'FUN'") # Matrix/R/kronecker.R: 33 @@ -969,11 +880,14 @@ # Matrix/R/kronecker.R: 51 # stop("kronecker method must use default 'FUN'") #, fuzzy -msgid "method for kronecker() must use default FUN=\"*\"" +msgid "'%s' method must use default %s=\"%s\"" msgstr "metoda kroneckera musi użyć domyślnej 'FUN'" -msgid "number of nonzero entries cannot exceed 2^31-1" -msgstr "" +# Matrix/R/Ops.R: 438 +# stop(gettextf("number of rows are not compatible for %s", .Generic), domain = "R-Matrix") +#, fuzzy +msgid "number of nonzero entries cannot exceed %s" +msgstr "liczba wierszy nie jest zgodna dla %s" # Matrix/R/nearPD.R: 52 # stop("Matrix seems negative semi-definite") @@ -985,40 +899,30 @@ msgid "'nearPD()' did not converge in %d iterations" msgstr "funkcja 'nearPD()' nie uzbieżniła się w %d iteracjach" -# Matrix/R/sparseMatrix.R: 748 -# warning("rcond(.) via sparse -> dense coercion") +# Matrix/R/sparseMatrix.R: 759 +# stop("'V' is not a *square* matrix") #, fuzzy -msgid "'norm' via sparse -> dense coercion" -msgstr "'rcond(.)' poprzez przekształcenie rzadkie -> gęste" - -# Matrix/R/sparseMatrix.R: 731 -# stop("invalid 'type'") -msgid "invalid 'type'" -msgstr "niepoprawny 'type'" +msgid "'cl' is not a character string" +msgstr "'V' nie jest macierzą *kwadratową*" -msgid "'perm' slot must be a permutation of seq_along(perm)" +msgid "" +"not a positive definite matrix (and positive semidefiniteness is not checked)" msgstr "" -# Matrix/R/dgTMatrix.R: 20 -# stop("cannot coerce non-symmetric \"dgTMatrix\" to \"dsCMatrix\" class") +# Matrix/R/sparseMatrix.R: 759 +# stop("'V' is not a *square* matrix") #, fuzzy -msgid "attempt to coerce non-square matrix to pMatrix" -msgstr "" -"nie można przekształcić niesymetrycznej macierzy klasy \"dgTMatrix\" na " -"klasę \"dsCMatrix\"" +msgid "'%s' is not a square numeric matrix" +msgstr "'V' nie jest macierzą *kwadratową*" -# Matrix/R/indMatrix.R: 71 -# stop("must have exactly one non-zero entry per row") -# Matrix/R/pMatrix.R: 33 -# stop("must have exactly one non-zero entry per row") +# Matrix/R/Matrix.R: 94 +# warning("diag(.) had 0 or NA entries; non-finite result is doubtful") +# Matrix/R/sparseMatrix.R: 764 +# warning("diag(.) had 0 or NA entries; non-finite result is doubtful") #, fuzzy -msgid "matrix must have exactly one nonzero element in each row and column" -msgstr "potrzeba mieć dokładnie jeden niezerowy wpis na wiersz" - -# Matrix/R/products.R: 186 -# stop(gettextf("not-yet-implemented method for <%s> %%*%% <%s>", class(x), class(y)), domain = "R-Matrix") -msgid "not-yet-implemented method for <%s> %%*%% <%s>" -msgstr "jeszcze niezaimplementowana metoda dla <%s> %%*%% <%s>" +msgid "" +"diag(%s) has non-positive or non-finite entries; finite result is doubtful" +msgstr "'diag(.)' posiadało wpisy 0 lub NA; nieskończony wynik jest wątpliwy" # Matrix/R/Auxiliaries.R: 273 # stop(gettextf("non-conformable matrix dimensions in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") @@ -1026,40 +930,31 @@ msgid "non-conformable arguments" msgstr "niezgodne wymiary macierzy w %s" -# Matrix/R/diagMatrix.R: 225 -# stop(gettextf("%s kind not yet implemented", sQuote(kind)), domain = "R-Matrix") -#, fuzzy -msgid "'boolArith = %d' not yet implemented" -msgstr "rodzaj %s nie jest jeszcze zaimplementowany" - msgid "" "matrix is structurally rank deficient; using augmented matrix with " "additional %d row(s) of zeros" msgstr "" msgid "" -"'which' is not \"P1\", \"P1.\", \"P2\", \"P2.\", \"Q\", \"Q1\", \"R\", or " -"\"R1\"" +"'%1$s' is not \"%2$s1\", \"%2$s1.\", \"%2$s2\", \"%2$s2.\", \"%3$s\", " +"\"%3$s1\", \"%4$s\", or \"%4$s1\"" msgstr "" -msgid "'Dvec' has the wrong length" +msgid "'%s' has the wrong length" msgstr "" # Matrix/R/sparseMatrix.R: 372 # stop(gettextf("invalid 'col.names' string: %s", cn), domain = "R-Matrix") #, fuzzy -msgid "invalid 'ncol': not in 0:%d" +msgid "invalid '%s': not in %d:%d" msgstr "niepoprawny łańcuch 'col.names': %s" -msgid "need larger value of 'ncol' as pivoting occurred" +msgid "need greater '%s' as pivoting occurred" msgstr "" msgid "qr2rankMatrix(.): QR with only %d out of %d finite diag(R) entries" msgstr "" -msgid "qr2rankMatrix(.): QR has negative diag(R) entries" -msgstr "" - msgid "" "rankMatrix(, method = '%s') coerces to dense matrix.\n" " Probably should rather use method = 'qr' !?" @@ -1073,34 +968,62 @@ msgid "rankMatrix(x, method='qr'): computing t(x) as nrow(x) < ncol(x)" msgstr "rankMatrix(x, method='qr'): obliczanie t(x) jako nrow(x) < ncol(x)" -msgid "rcond(x) is undefined: 'x' has length 0" +# Matrix/R/Auxiliaries.R: 373 +# message(sprintf(gettext(" [[ suppressing %d column names %s... ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:3]), collapse = ", ")), domain = NA) +#, fuzzy +msgid "[[ suppressing %d column name%s %s ... ]]" +msgstr "[[ zmniejszanie %d nazw kolumn %s ... ]]" + +# Matrix/R/sparseMatrix.R: 372 +# stop(gettextf("invalid 'col.names' string: %s", cn), domain = "R-Matrix") +msgid "invalid 'col.names' string: %s" +msgstr "niepoprawny łańcuch 'col.names': %s" + +msgid "uniDiag=TRUE, but not all diagonal entries are 1" msgstr "" -# Matrix/R/sparseMatrix.R: 748 -# warning("rcond(.) via sparse -> dense coercion") +msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" +msgstr "" + +msgid "in show(); maybe adjust options(max.print=, width=)" +msgstr "" + +# Matrix/R/Auxiliaries.R: 375 +# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) #, fuzzy -msgid "'rcond' via sparse -> dense coercion" -msgstr "'rcond(.)' poprzez przekształcenie rzadkie -> gęste" +msgid "suppressing %d columns and %d rows" +msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" -# Matrix/R/Matrix.R: 206 -# stop("invalid 'data'") +# Matrix/R/Auxiliaries.R: 375 +# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) #, fuzzy -msgid "invalid 'norm'" -msgstr "niepoprawne 'data'" +msgid "suppressing %d rows" +msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" + +# Matrix/R/Auxiliaries.R: 375 +# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) +#, fuzzy +msgid "suppressing %d columns" +msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" + +# Matrix/R/sparseMatrix.R: 599 +# stop("logic programming error in printSpMatrix2(), please report") +msgid "logic programming error in printSpMatrix2(), please report" +msgstr "błąd logiczny programu w 'printSpMatrix2()', proszę zgłosić raport" # Matrix/R/Matrix.R: 91 # stop("'V' is not a square matrix") #, fuzzy -msgid "'a' is not square" +msgid "'%s' is not square" msgstr "'V' nie jest macierzą kwadratową" -msgid "dimensions of 'a' and 'b' are inconsistent" +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "" -msgid "'a' is computationally singular, rcond(a)=%g" +msgid "'%1$s' is computationally singular, rcond(%1$s)=%2$g" msgstr "" -msgid "'a' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" +msgid "'%s' is computationally singular, min(d)/max(d)=%g, d=abs(diag(U))" msgstr "" msgid "matrix is exactly singular, D[i,i]=0, i=%d" @@ -1112,17 +1035,8 @@ msgid "matrix exactly singular, J[i,]=0, i=%d" msgstr "" -# Matrix/R/ngTMatrix.R: 24 -# stop("cannot coerce 'NA's to \"nsparseMatrix\"") -#, fuzzy -msgid "cannot coerce zsparseVector to dgCMatrix" -msgstr "nie można przekształcić wartości 'NA' na 'nsparseMatrix'" - -# Matrix/R/sparseVector.R: 53 -# stop("cannot coerce 'NA's to \"nsparseVector\"") -#, fuzzy -msgid "cannot coerce zsparseVector to dgeMatrix" -msgstr "nie można przekształcić wartości NA na obiekt klasy \"nsparseVector\"" +msgid "cannot coerce from %s to %s" +msgstr "" # Matrix/R/spModels.R: 113 # stop("model frame and formula mismatch in model.matrix()") @@ -1147,199 +1061,287 @@ msgid "variable '%s' is absent, its contrast will be ignored" msgstr "zmienna '%s' jest nieobecna, jej kontrast zostanie zignorowany" -# Matrix/R/sparseMatrix.R: 44 -# stop("exactly one of 'i', 'j', or 'p' must be missing from call") +msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" +msgstr "" + +# Matrix/R/bind2.R: 395 +# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") +# Matrix/R/Auxiliaries.R: 314 +# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") #, fuzzy -msgid "exactly one of 'i', 'j', and 'p' must be missing from call" -msgstr "dokłanie jeden z 'i', 'j', lub 'p' musi być nieobecny w wywołaniu" +msgid "length of 'center' must equal the number of columns of 'x'" +msgstr "Macierze muszą mieć tę samą liczbę kolumn w %s" -msgid "" -"use Diagonal() to construct diagonal (symmetric && triangular) sparse " -"matrices" -msgstr "" +# Matrix/R/bind2.R: 395 +# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") +# Matrix/R/Auxiliaries.R: 314 +# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") +#, fuzzy +msgid "length of 'scale' must equal the number of columns of 'x'" +msgstr "Macierze muszą mieć tę samą liczbę kolumn w %s" -msgid "'giveCsparse' is deprecated; using 'repr' instead" +msgid "trimmed means are not defined for complex data" msgstr "" -msgid "'giveCsparse' is deprecated; setting repr=\"T\" for you" +msgid "first element used of '%s' argument" msgstr "" -# Matrix/R/sparseMatrix.R: 48 -# stop("'p' must be a non-decreasing vector (0, ...)") +# Matrix/R/Matrix.R: 206 +# stop("invalid 'data'") #, fuzzy -msgid "'p' must be a nondecreasing vector c(0, ...)" -msgstr "'p' musi być niemalejącym wektorem (0, ...)" +msgid "invalid '%s' argument" +msgstr "niepoprawne 'data'" -msgid "'i' and 'j' must not contain NA" +msgid "should never happen ..." msgstr "" -msgid "'i' and 'j' must be" +msgid "'%s' is deprecated; using '%s' instead" msgstr "" -msgid "positive" +msgid "'%s' is deprecated; setting %s=\"%s\"" msgstr "" -msgid "non-negative" +# Matrix/R/Matrix.R: 694 +# stop(".M.repl.i.2col(): 'i' has no integer column number;\n should never happen; please report") +msgid "" +".M.repl.i.2col(): 'i' has no integer column number;\n" +" should never happen; please report" msgstr "" +".M.repl.i.2col(): 'i' posiada niecałkowitą liczbę kolumn;\n" +"to nie powinno się nigdy wydarzyć; proszę zgłosić raport" -# Matrix/R/Matrix.R: 206 -# stop("invalid 'data'") -#, fuzzy -msgid "invalid 'dims'" -msgstr "niepoprawne 'data'" - -msgid "'dims' must contain all (i,j) pairs" +# Matrix/R/Matrix.R: 667 +# stop("such indexing must be by logical or 2-column numeric matrix") +# Matrix/R/Matrix.R: 696 +# stop("such indexing must be by logical or 2-column numeric matrix") +# Matrix/R/Tsparse.R: 638 +# stop("such indexing must be by logical or 2-column numeric matrix") +msgid "such indexing must be by logical or 2-column numeric matrix" msgstr "" +"takie indeksowanie musi być wykonane poprzez macierz logiczną lub 2-" +"kolumnową macierz liczbową" -# Matrix/R/sparseMatrix.R: 67 -# stop("symmetric matrix must be square") -msgid "symmetric matrix must be square" -msgstr "macierz symetryczna musi być kwadratowa" +# Matrix/R/Matrix.R: 698 +# message(".M.repl.i.2col(): drop 'matrix' case ...") +msgid ".M.repl.i.2col(): drop 'matrix' case ..." +msgstr ".M.repl.i.2col(): zrzuć przypadek 'matrix' ..." -# Matrix/R/sparseMatrix.R: 67 -# stop("symmetric matrix must be square") -#, fuzzy -msgid "triangular matrix must be square" -msgstr "macierz symetryczna musi być kwadratowa" +# Matrix/R/Matrix.R: 704 +# stop("negative values are not allowed in a matrix subscript") +# Matrix/R/Tsparse.R: 641 +# stop("negative values are not allowed in a matrix subscript") +msgid "negative values are not allowed in a matrix subscript" +msgstr "ujemne wartości nie są dozwolone w indeksach macierzy" -msgid "p[length(p)]" -msgstr "" +# Matrix/R/Matrix.R: 706 +# stop("NAs are not allowed in subscripted assignments") +# Matrix/R/Tsparse.R: 643 +# stop("NAs are not allowed in subscripted assignments") +msgid "NAs are not allowed in subscripted assignments" +msgstr "wartości NA nie są dozwolone w indeksowanych przypisaniach" -msgid "length(i)" +# Matrix/R/Matrix.R: 713 +# warning("number of items to replace is not a multiple of replacement length") +# Matrix/R/Csparse.R: 245 +# stop("number of items to replace is not a multiple of replacement length") +# Matrix/R/Tsparse.R: 366 +# warning("number of items to replace is not a multiple of replacement length") +# Matrix/R/Tsparse.R: 405 +# stop("number of items to replace is not a multiple of replacement length") +# Matrix/R/Tsparse.R: 657 +# warning("number of items to replace is not a multiple of replacement length") +# Matrix/R/sparseVector.R: 530 +# stop("number of items to replace is not a multiple of replacement length") +msgid "number of items to replace is not a multiple of replacement length" msgstr "" +"liczba pozycji do zastąpienia nie jest wielokrotnością długości elementu " +"zastępującego" -# Matrix/R/sparseMatrix.R: 79 -# warning("length(i) is not a multiple of length(x)") -#, fuzzy -msgid "is not an integer multiple of length(x)" -msgstr "'length(i)' nie jest wielokrotnością 'length(x)'" +# Matrix/R/Matrix.R: 719 +# message("m[ ] <- v: inefficiently treating single elements") +msgid "m[ ] <- v: inefficiently treating single elements" +msgstr "m[ ] <- v: nieefektywne traktowanie pojedynczych elementów" -msgid "length(x) must not exceed" -msgstr "" +# Matrix/R/Matrix.R: 725 +# stop(gettextf("nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?", nA), domain = "R-Matrix") +msgid "nargs() = %d. Extraneous illegal arguments inside '[ .. ]' ?" +msgstr "nargs() = %d. Obce nielegalne argumenty wewnątrz '[ .. ]' ?" -msgid "invalid 'repr'; must be \"C\", \"R\", or \"T\"" +# Matrix/R/Matrix.R: 796 +# stop(gettextf("RHS 'value' (class %s) matches 'ANY', but must match matrix class %s", class(value), class(x)), domain = "R-Matrix") +msgid "RHS 'value' (class %s) matches 'ANY', but must match matrix class %s" msgstr "" +"prawa strona 'value' (klasa %s) pasuje do 'ANY', a musi pasować do klasy " +"macierzy '%s'" -# Matrix/R/sparseMatrix.R: 372 -# stop(gettextf("invalid 'col.names' string: %s", cn), domain = "R-Matrix") -msgid "invalid 'col.names' string: %s" -msgstr "niepoprawny łańcuch 'col.names': %s" +# Matrix/R/Matrix.R: 797 +# stop("not-yet-implemented 'Matrix[<-' method") +msgid "not-yet-implemented 'Matrix[<-' method" +msgstr "jeszcze niezaimplementowana metoda 'Matrix[<-'" -msgid "uniDiag=TRUE, but not all diagonal entries are 1" -msgstr "" +# Matrix/R/denseMatrix.R: 101 +# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") +# Matrix/R/denseMatrix.R: 164 +# stop(gettextf("invalid nargs()= %d", na), domain = "R-Matrix") +msgid "invalid nargs()= %d" +msgstr "niepoprawne nargs()=%d" -msgid "uniDiag=TRUE, not all entries in diagonal coded as 1" -msgstr "" +# Matrix/R/Csparse.R: 240 +# stop("nothing to replace with") +# Matrix/R/Tsparse.R: 400 +# stop("nothing to replace with") +# Matrix/R/Tsparse.R: 653 +# stop("nothing to replace with") +# Matrix/R/sparseVector.R: 525 +# stop("nothing to replace with") +msgid "nothing to replace with" +msgstr "nic do zastąpienia" -msgid "in show(); maybe adjust 'options(max.print= *, width = *)'" -msgstr "" +# Matrix/R/Csparse.R: 247 +# stop("too many replacement values") +# Matrix/R/Tsparse.R: 495 +# stop("too many replacement values") +# Matrix/R/sparseVector.R: 557 +# stop("too many replacement values") +msgid "too many replacement values" +msgstr "zbyt dużo wartości zamieniających" -# Matrix/R/Auxiliaries.R: 375 -# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) -#, fuzzy -msgid "suppressing %d columns and %d rows" -msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" +# Matrix/R/Csparse.R: 284 +# warning("i1[1] == 0 ==> C-level verbosity will not happen!") +msgid "i1[1] == 0 ==> C-level verbosity will not happen!" +msgstr "i1[1] == 0 ==> tryb 'verbose' poziomu C nie zostanie wykonany!" -# Matrix/R/Auxiliaries.R: 375 -# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) -#, fuzzy -msgid "suppressing %d rows" -msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" +msgid "using\t \"old code\" part in Csparse subassignment" +msgstr "używanie\t części 'old code' w przypisaniu w 'Csparse'" -# Matrix/R/Auxiliaries.R: 375 -# message(sprintf(gettext(" [[ suppressing %d column names %s ]]", domain = "R-Matrix"), nc, paste(sQuote(cn[1:lc]), collapse = ", ")), domain = NA) -#, fuzzy -msgid "suppressing %d columns" -msgstr "[[ zmniejszanie %d nazw kolumn %s ]]" +msgid "" +"using\"old code\" part in Csparse subassignment\n" +" >>> please report to Matrix-authors@r-project.org" +msgstr "" +"używanie części 'old code' w przypisaniu w 'Csparse'\n" +">>> proszę zgłosić raport na adres 'Matrix-authors@r-project.org'" -# Matrix/R/sparseMatrix.R: 599 -# stop("logic programming error in printSpMatrix2(), please report") -msgid "logic programming error in printSpMatrix2(), please report" -msgstr "błąd logiczny programu w 'printSpMatrix2()', proszę zgłosić raport" +# Matrix/R/Tsparse.R: 126 +# stop("you cannot mix negative and positive indices") +# Matrix/R/sparseVector.R: 395 +# stop("you cannot mix negative and positive indices") +# Matrix/R/sparseVector.R: 462 +# stop("you cannot mix negative and positive indices") +msgid "you cannot mix negative and positive indices" +msgstr "nie można mieszać ujemnych oraz dodatnich indeksów" -# Matrix/R/sparseMatrix.R: 759 -# stop("'V' is not a *square* matrix") -msgid "'V' is not a *square* matrix" -msgstr "'V' nie jest macierzą *kwadratową*" +# Matrix/R/Tsparse.R: 130 +# stop(gettextf("index larger than maximal %d", n), domain = "R-Matrix") +msgid "index larger than maximal %d" +msgstr "indeks dłuższy niż maksymalny możliwy %d" -# Matrix/R/Matrix.R: 94 -# warning("diag(.) had 0 or NA entries; non-finite result is doubtful") -# Matrix/R/sparseMatrix.R: 764 -# warning("diag(.) had 0 or NA entries; non-finite result is doubtful") -msgid "diag(.) had 0 or NA entries; non-finite result is doubtful" -msgstr "'diag(.)' posiadało wpisy 0 lub NA; nieskończony wynik jest wątpliwy" +# Matrix/R/Tsparse.R: 123 +# stop("'NA' indices are not (yet?) supported for sparse Matrices") +msgid "'NA' indices are not (yet?) supported for sparse Matrices" +msgstr "indeksy 'NA' nie są (jeszcze?) wspierane dla rzadkich macierzy" -msgid "number of non zeros is smaller than 'nnz' because of duplicated (i,j)s" -msgstr "" +# Matrix/R/Tsparse.R: 138 +# stop(gettextf("logical subscript too long (%d, should be %d)", length(i), n), domain = "R-Matrix") +msgid "logical subscript too long (%d, should be %d)" +msgstr "indeks logiczny jest zbyt długi (%d, powinien być %d)" -msgid "a sparseMatrix should rarely be centered: will not be sparse anymore" -msgstr "" +# Matrix/R/Tsparse.R: 143 +# stop("no 'dimnames[[.]]': cannot use character indexing") +msgid "no 'dimnames[[.]]': cannot use character indexing" +msgstr "brak 'dimnames[[.]]': nie można używać indeksowania tekstowego" -# Matrix/R/bind2.R: 395 -# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") -# Matrix/R/Auxiliaries.R: 314 -# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") -#, fuzzy -msgid "length of 'center' must equal the number of columns of 'x'" -msgstr "Macierze muszą mieć tę samą liczbę kolumn w %s" +# Matrix/R/Tsparse.R: 145 +# stop("invalid character indexing") +msgid "invalid character indexing" +msgstr "niepoprawne tekstowe indeksowanie" -# Matrix/R/bind2.R: 395 -# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") -# Matrix/R/Auxiliaries.R: 314 -# stop(gettextf("Matrices must have same number of columns in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") -#, fuzzy -msgid "length of 'scale' must equal the number of columns of 'x'" -msgstr "Macierze muszą mieć tę samą liczbę kolumn w %s" +# Matrix/R/Tsparse.R: 309 +# stop("internal bug: missing 'i' in replTmat(): please report") +msgid "internal bug: missing 'i' in replTmat(): please report" +msgstr "błąd wewnętrzny: brakuje 'i' w 'replTmat()': proszę zgłosić raport" -# Matrix/R/sparseVector.R: 235 -# stop("'x' must inherit from \"sparseVector\"") -msgid "'x' must inherit from \"sparseVector\"" -msgstr "argument 'x' musi być obiektem klasy \"sparseVector\"" +# Matrix/R/Tsparse.R: 311 +# stop("[ ] indexing not allowed: forgot a \",\" ?") +msgid "[ ] indexing not allowed: forgot a \",\" ?" +msgstr "indeksowanie [ ] nie jest dozwolone: zapomniałeś ',' ?" -# Matrix/R/sparseVector.R: 237 -# stop("'ncol' must be >= 0") -msgid "'ncol' must be >= 0" -msgstr "'ncol' musi być >= 0" +# Matrix/R/Tsparse.R: 313 +# stop("internal bug: matrix 'i' in replTmat(): please report") +msgid "internal bug: matrix 'i' in replTmat(): please report" +msgstr "wewnętrzny błąd: macierz 'i' w 'replTmat()': proszę zgłosić raport" -# Matrix/R/sparseVector.R: 239 -# stop("'nrow' must be >= 0") -msgid "'nrow' must be >= 0" -msgstr "'nrow' musi być >= 0" +# Matrix/R/Tsparse.R: 342 +# 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 = "R-Matrix") +msgid "" +"x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced; NA |--> TRUE." +msgstr "" +"x[.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " +"przekształcona; NA |--> TRUE." -# Matrix/R/sparseVector.R: 242 -# stop("Must specify 'nrow' when 'symmetric' is true") -msgid "Must specify 'nrow' when 'symmetric' is true" -msgstr "'nrow' musi być określone, gdy 'symmetric' ma wartość TRUE" +# Matrix/R/Tsparse.R: 342 +# 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 = "R-Matrix") +msgid "x[.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " +"przekształcona." -# Matrix/R/sparseVector.R: 244 -# stop("'nrow' and 'ncol' must be the same when 'symmetric' is true") -msgid "'nrow' and 'ncol' must be the same when 'symmetric' is true" +# Matrix/R/Tsparse.R: 500 +# 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 = "R-Matrix") +msgid "" +"x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced NA |--> TRUE." msgstr "" -"'nrow' oraz 'ncol' muszą mieć tę samą wartość gdy 'symmetric' ma wartość TRUE" +"x[.,.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " +"przekształcona NA |--> TRUE." -# Matrix/R/sparseVector.R: 247 -# stop("'x' must have length nrow^2 when 'symmetric' is true") -msgid "'x' must have length nrow^2 when 'symmetric' is true" -msgstr "'x' musi mieć długość równą 'nrow'^2 gdy 'symmetric' ma wartość TRUE" +# Matrix/R/Tsparse.R: 500 +# 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 = "R-Matrix") +msgid "x[.,.] <- val: x is %s, val not in {TRUE, FALSE} is coerced." +msgstr "" +"x[.,.] <- wartość: 'x' to %s, wartość nie w zakresie {TRUE, FALSE} zostaje " +"przekształcona." -# Matrix/R/sparseVector.R: 255 -# warning("'ncol' is not a factor of length(x)") -msgid "'ncol' is not a factor of length(x)" -msgstr "'ncol' nie jest czynnikiem długości 'length(x)'" +# Matrix/R/Tsparse.R: 529 +# message(gettextf("x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix"), domain = "R-Matrix") +msgid "x[.,.] <- val : x being coerced from Tsparse* to CsparseMatrix" +msgstr "" +"x[.,.] <- wartość : 'x' zostaje przekształcone z 'Tsparse*' na " +"'CsparseMatrix'" -# Matrix/R/sparseVector.R: 260 -# warning("'nrow' is not a factor of length(x)") -msgid "'nrow' is not a factor of length(x)" -msgstr "'nrow' nie jest czynnikiem długości 'length(x)'" +# Matrix/R/Matrix.R: 769 +# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") +# Matrix/R/Matrix.R: 781 +# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") +# Matrix/R/Tsparse.R: 624 +# stop(gettextf("nargs() = %d should never happen; please report.", nA), domain = "R-Matrix") +msgid "nargs() = %d should never happen; please report." +msgstr "'nargs() = %d' nie powinno się wydarzyć; proszę zgłosić raport." -# Matrix/R/sparseVector.R: 278 -# stop(gettextf("Class %s is not yet implemented", dQuote(cNam)), domain = "R-Matrix") -msgid "Class %s is not yet implemented" -msgstr "Klasa %s nie jest jeszcze zaimplementowana" +# Matrix/R/Tsparse.R: 669 +# stop(gettextf("row indices must be <= nrow(.) which is %d", nr), domain = "R-Matrix") +msgid "row indices must be <= nrow(.) which is %d" +msgstr "indeksy wiersza muszą być <= 'nrow(.)' który wynosi %d" -msgid "" -"suboptimally using as.numeric(x) to compute trimmed mean of sparseVector 'x'" -msgstr "" +# Matrix/R/Tsparse.R: 670 +# stop(gettextf("column indices must be <= ncol(.) which is %d", nc), domain = "R-Matrix") +msgid "column indices must be <= ncol(.) which is %d" +msgstr "indeksy kolumn muszą być <= 'ncol(.)' który wynosi %d" + +# Matrix/R/diagMatrix.R: 418 +# stop(gettextf("Internal bug: nargs()=%d; please report", na), domain = "R-Matrix") +msgid "Internal bug: nargs()=%d; please report" +msgstr "Błąd wewnętrzny: nargs()=%d; proszę zgłosić raport" # Matrix/R/sparseVector.R: 415 # stop("index must be numeric, logical or sparseVector for indexing sparseVectors") @@ -1349,14 +1351,6 @@ "indeks musi być typem liczbowym, logicznym lub obiektem klasy 'sparseVector' " "na potrzeby indeksowania obiektów klasy 'sparseVector'" -# Matrix/R/sparseVector.R: 740 -# stop("'times >= 0' is required") -msgid "'times >= 0' is required" -msgstr "wymagane jest 'times >= 0'" - -msgid "'giveCsparse' has been deprecated; setting 'repr = \"%s\"' for you" -msgstr "" - # Matrix/R/Rsparse.R: 32 # stop(gettextf("invalid class: %s", dQuote(cl)), domain = "R-Matrix") # Matrix/R/Rsparse.R: 59 @@ -1371,10 +1365,10 @@ msgid "invalid subscript type \"%s\"" msgstr "Niepoprawny typ przechowywania: %s" -msgid "recycled [nl]sparseVector would have maximal index exceeding 2^53" +msgid "recycled %s would have maximal index exceeding %s" msgstr "" -msgid "subscripts exceeding 2^53 replaced with NA" +msgid "subscripts exceeding %s replaced with NA" msgstr "" msgid "subscript out of bounds" @@ -1392,26 +1386,19 @@ msgid "incorrect number of dimensions" msgstr "niezgodne wymiary macierzy" -# Matrix/R/symmetricMatrix.R: 114 -# stop("'x' is not symmetric nor triangular") -#, fuzzy -msgid "matrix is not symmetric or triangular" -msgstr "'x' nie jest macierzą symetryczną ani trójkątną" +msgid "only zeros may be mixed with negative subscripts" +msgstr "" -# Matrix/R/dgTMatrix.R: 44 -# stop("the matrix is not triangular") -#, fuzzy -msgid "matrix is not symmetric" -msgstr "macierz nie jest trójkątna" +msgid "'%s' has length 0 but '%s' does not" +msgstr "" -# Matrix/R/symmetricMatrix.R: 114 -# stop("'x' is not symmetric nor triangular") +# Matrix/R/dgTMatrix.R: 20 +# stop("cannot coerce non-symmetric \"dgTMatrix\" to \"dsCMatrix\" class") #, fuzzy -msgid "matrix is not triangular" -msgstr "'x' nie jest macierzą symetryczną ani trójkątną" - -msgid "attempt to coerce matrix with NA to ngCMatrix" +msgid "attempt to coerce matrix with NA to %s" msgstr "" +"nie można przekształcić niesymetrycznej macierzy klasy \"dgTMatrix\" na " +"klasę \"dsCMatrix\"" # Matrix/R/Matrix.R: 206 # stop("invalid 'data'") @@ -1419,6 +1406,153 @@ msgid "invalid 'Class2'" msgstr "niepoprawne 'data'" +# Matrix/R/abIndex.R: 165 +# stop("wrong sign in 'by' argument") +#, fuzzy +#~ msgid "invalid 'each' argument" +#~ msgstr "niepoprawny znak w argumencie 'by'" + +# Matrix/R/Matrix.R: 206 +# stop("invalid 'data'") +#, fuzzy +#~ msgid "invalid 'times' argument" +#~ msgstr "niepoprawne 'data'" + +# Matrix/R/Auxiliaries.R: 65 +# stop(gettextf("not-yet-implemented method for %s(<%s>).\n ->> Ask the package authors to implement the missing feature.", fun, cl), call. = FALSE, domain = "R-Matrix") +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "metoda jeszcze niezaimplementowana dla %s(<%s>).\n" +#~ " ->> Poproś autorów pakietu o zaimplementowanie brakującej " +#~ "funkcjonalności." + +# Matrix/R/Auxiliaries.R: 68 +# stop(gettextf("not-yet-implemented method for %s(<%s>, <%s>).\n ->> Ask the package authors to implement the missing feature.", fun, cl1, cl2), call. = FALSE, domain = "R-Matrix") +#~ msgid "" +#~ "not-yet-implemented method for %s(<%s>, <%s>).\n" +#~ " ->> Ask the package authors to implement the missing feature." +#~ msgstr "" +#~ "metoda jeszcze niezaimplementowana dla %s(<%s>, <%s>).\n" +#~ " ->> Poproś autorów pakietu o zaimplementowanie brakującej " +#~ "funkcjonalności." + +# Matrix/R/Auxiliaries.R: 906 +# stop(gettextf("general Matrix class not yet implemented for %s", dQuote(class(x))), domain = "R-Matrix") +#, fuzzy +#~ msgid "complex \"diagonalMatrix\" not yet implemented" +#~ msgstr "ogólna klasa 'Matrix' jeszcze nie jest zaimplementowana dla %s" + +# Matrix/R/Auxiliaries.R: 641 +# stop(gettextf("not yet implemented for class %s", dQuote(class.x)), domain = "R-Matrix") +#, fuzzy +#~ msgid "not yet implemented for class \"%s\"" +#~ msgstr "jeszcze niezaimplementowane dla klasy %s" + +# Matrix/R/sparseMatrix.R: 731 +# stop("invalid 'type'") +#, fuzzy +#~ msgid "invalid 'uplo'" +#~ msgstr "niepoprawny 'type'" + +# Matrix/R/Matrix.R: 400 +# stop("'lag' and 'differences' must be integers >= 1") +#~ msgid "'lag' and 'differences' must be integers >= 1" +#~ msgstr "'lag' oraz 'differences' muszą być liczbami całkowitymi >= 1" + +# Matrix/R/Matrix.R: 459 +# stop("programming error: min() should have dispatched w/ 1st arg much earlier") +#~ msgid "" +#~ "programming error: min() should have dispatched w/ 1st arg much earlier" +#~ msgstr "" +#~ "błąd programistyczny: 'min()' powinno zostać wysłane z pierwszym " +#~ "argumentem znacznie wcześniej" + +#~ msgid "in Summary(, .): %s(<%s>, <%s>,...)" +#~ msgstr "w funkcji 'Summary(, .): %s(<%s>, <%s>,...)'" + +#, fuzzy +#~ msgid "in Summary(, .): %s(<%s>, <%s>)" +#~ msgstr "w funkcji 'Summary(, .): %s(<%s>, <%s>,...)'" + +# Matrix/R/Ops.R: 438 +# stop(gettextf("number of rows are not compatible for %s", .Generic), domain = "R-Matrix") +#, fuzzy +#~ msgid "number of rows of matrices must match" +#~ msgstr "liczba wierszy nie jest zgodna dla %s" + +# Matrix/R/Ops.R: 438 +# stop(gettextf("number of rows are not compatible for %s", .Generic), domain = "R-Matrix") +#, fuzzy +#~ msgid "number of columns of matrices must match" +#~ msgstr "liczba wierszy nie jest zgodna dla %s" + +# Matrix/R/denseMatrix.R: 71 +# stop("dim(.) value must be numeric of length 2") +# Matrix/R/sparseVector.R: 317 +# stop("dim(.) value must be numeric of length 2") +# Matrix/R/sparseMatrix.R: 711 +# stop("dim(.) value must be numeric of length 2") +#, fuzzy +#~ msgid "dimensions must be numeric of length 2" +#~ msgstr "wartości 'dim(.)' muszą być liczbami o długości 2" + +# Matrix/R/condest.R: 74 +# stop("'A' must be a square matrix") +# Matrix/R/condest.R: 194 +# stop("'A' must be a square matrix") +#, fuzzy +#~ msgid "'perm' must be numeric" +#~ msgstr "'A' musi być macierzą kwadratową" + +# Matrix/R/sparseVector.R: 237 +# stop("'ncol' must be >= 0") +#, fuzzy +#~ msgid "'margin' must be 1 or 2" +#~ msgstr "'ncol' musi być >= 0" + +# Matrix/R/products.R: 186 +# stop(gettextf("not-yet-implemented method for <%s> %%*%% <%s>", class(x), class(y)), domain = "R-Matrix") +#~ msgid "not-yet-implemented method for <%s> %%*%% <%s>" +#~ msgstr "jeszcze niezaimplementowana metoda dla <%s> %%*%% <%s>" + +# Matrix/R/diagMatrix.R: 225 +# stop(gettextf("%s kind not yet implemented", sQuote(kind)), domain = "R-Matrix") +#, fuzzy +#~ msgid "'boolArith = %d' not yet implemented" +#~ msgstr "rodzaj %s nie jest jeszcze zaimplementowany" + +# Matrix/R/sparseMatrix.R: 748 +# warning("rcond(.) via sparse -> dense coercion") +#, fuzzy +#~ msgid "'rcond' via sparse -> dense coercion" +#~ msgstr "'rcond(.)' poprzez przekształcenie rzadkie -> gęste" + +# Matrix/R/Matrix.R: 206 +# stop("invalid 'data'") +#, fuzzy +#~ msgid "invalid 'norm'" +#~ msgstr "niepoprawne 'data'" + +# Matrix/R/ngTMatrix.R: 24 +# stop("cannot coerce 'NA's to \"nsparseMatrix\"") +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgCMatrix" +#~ msgstr "nie można przekształcić wartości 'NA' na 'nsparseMatrix'" + +# Matrix/R/sparseVector.R: 53 +# stop("cannot coerce 'NA's to \"nsparseVector\"") +#, fuzzy +#~ msgid "cannot coerce zsparseVector to dgeMatrix" +#~ msgstr "" +#~ "nie można przekształcić wartości NA na obiekt klasy \"nsparseVector\"" + +# Matrix/R/sparseVector.R: 740 +# stop("'times >= 0' is required") +#~ msgid "'times >= 0' is required" +#~ msgstr "wymagane jest 'times >= 0'" + # Matrix/R/Auxiliaries.R: 305 # stop(gettextf("Matrices must have same number of rows in %s", deparse(sys.call(sys.parent()))), call. = FALSE, domain = "R-Matrix") #~ msgid "Matrices must have same number of rows in %s" diff -Nru rmatrix-1.6-1.1/po/de.po rmatrix-1.6-5/po/de.po --- rmatrix-1.6-1.1/po/de.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/de.po 2023-11-03 01:34:40.000000000 +0000 @@ -7,7 +7,7 @@ msgstr "" "Project-Id-Version: R 4.0.4 / Matrix 1.3-3\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2021-02-11 13:00+0100\n" "Last-Translator: Detlef Steuer \n" "Language-Team: R Core \n" @@ -17,899 +17,634 @@ "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" -# http://www.matheboard.de/archive/160705/thread.html -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "Diagonalelement %d des Choleskyfaktors fehlt" - -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "cholmod_factorize_p fehlgeschlagen: Status %d, Minor %d von ncol %d" - -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "cholmod_change_factor fehlgeschlagen" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "" -"Csparse_sort(x): x ist keine gültige (abgesehen vom Sortieren) CsparseMatrix" +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "cs_qr fehlgeschlagen" -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "Unmögliche Rk_x/Rk_y in Csparse_%s(). Bitte dem Entwickler melden!" +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "" -"chm_MOD_xtype() nicht erfolgreich in Csparse_%s(). Bitte dem Entwickler " -"melden!" +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "ungültiges '%s' Argument" -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "Öffnen von Datei '%s' zum Schreiben fehlgeschlagen" -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "cholmod_write_sparse gab Fehlerkode zurück" - -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (zurückgetauscht) ist experimentell" - -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC(): 'resultKind' ungültig" - -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "ungültiges '%s' Argument" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "ungültiger Zeilenindex an Position %d" - -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "Dim-Slot ist nicht ganzzahlig" - -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "Slot '%s' muss die Länge 1 haben" - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "Dim-Slot ist nicht ganzzahlig" - -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "Slot '%s' muss die Länge 1 haben" - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "Argument ij muss eine zweispaltige ganzzahlige Matrix sein" - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "Subskript 'i' außerhalb des Bereichs in M[ij]" - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "Subskript 'j' außerhalb des Bereichs in M[ij]" - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" -msgstr "i und j müssen Ganzzahlvektoren mit der gleichen Länge sein" - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data' muss ein Vektortyp sein" - -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "ungültiges '%s' Argument" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "nicht-numerische Matrix-Ausdehnung" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "unzulässiger Wert für 'nrow' (zu groß oder NA)" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." +msgstr "" -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "unzulässiger Wert für 'nrow' (< 0)" +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "Dim-Slot ist nicht ganzzahlig" -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "unzulässiger Wert für 'ncol' (zu groß oder NA)" +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "Dim-Slot muss die Länge 2 haben" -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "unzulässiger Wert für 'ncol' (< 0)" +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "erstes Element von Slot p muss Null sein" -#: Mutils.c:1444 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgid "'%s' slot contains NA" msgstr "" -"Datenlänge [%d] ist kein Teilvielfaches oder Vielfaches der Zahl der Zeilen " -"[%d]" -#: Mutils.c:1449 +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "Slot p darf nicht abnehmend sein" + +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" +msgid "first differences of '%s' slot exceed %s" msgstr "" -"Datenlänge [%d] ist kein Teilvielfaches oder Vielfaches der Zahl der Spalten " -"[%d]" -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "Datenlänge überschreitet Größe der Matrix" +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "zu viele Elemente angegeben" +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: Mutils.c:1530 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" -msgstr "die Anzahl der Spalten untescheidet sich in R_rbind2_vector: %d != %d" - -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "Argument muss zahl-ähnlich atomar sein" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" +msgid "wrong '%s'" msgstr "" -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" -msgstr "" +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "Dim-Slot ist nicht ganzzahlig" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:481 cholmod-etc.c:190 #, c-format -msgid "dimensions cannot exceed %s" -msgstr "" - -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" - -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" +msgid "n+1 would overflow type \"%s\"" msgstr "" -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "Kode für komplexe dünn besetzte Matrizen noch nicht geschrieben" +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 -#, c-format -msgid "%s cannot exceed %s" -msgstr "" +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" -#: bind.c:848 -msgid "should never happen ..." +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "Argument rho muss eine Umgebung sein" - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "ungültige Klasse des Objektes zu as_cholmod_sparse" - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "ungültiges Objekt an as_cholmod_sparse übergeben" - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "in_place cholmod_sort gab einen Fehlerkode zurück" - -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "cholmod_sort gab einen Fehlerkode zurück" - -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" -msgstr "chm_sparse_to_SEXP(, *): ungültiges 'Rkind' (echter Artkode)" - -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "unbekannter xtype in Objekt cholmod_sparse" - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "Kode für komplexe dünn besetzte Matrizen noch nicht geschrieben" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Symmetrisch und dreieckig sind beide gesetzt" - -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "ungültige Klasse des Objektes zu as_cholmod_triplet" - -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" -msgstr "as_cholmod_triplet(): konnte für internes diagU2N() nicht reallozieren" - -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "unbekannter xtype in Objekt cholmod_triplet" - -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "ungültige Klasse des Objektes zu as_cholmod_dense" - -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" -"chm_transpose_dense(ans, x) noch nicht implementiert für %s verschieden von " -"%s" -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Cholmod-Fehler '%s' bei Datei %s, Zeile %d" -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Cholmod-Warnung '%s' bei Datei %s, Zeile %d" -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "cholmod kann nicht initialisiert werden: Fehlerkode %d" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "'Rkind' unbekannt" - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "unbekannter xtype" - -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "Kode für cholmod_dense mit Löchern noch nicht geschrieben" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "es ist nicht klar, ob eine dicht besetzte Mustermatrix sinnvoll ist" +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "Determinante benötigt eine quadratische Matrix" -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "ungültige Klasse des Objektes zu as_cholmod_factor" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" +msgstr "" -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "Misserfolg in as_cholmod_factor" +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s' muss in '%s' sein" -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "CHOLMOD-Faktorzerlegung war nicht erfolgreich" +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s' muss in '%s' sein" -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "f->xtype von %d nicht erkannt" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U(dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "Determinante benötigt eine quadratische Matrix" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "Determinante benötigt eine quadratische Matrix" -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "csp_eye-Argument n muss positiv sein" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s' muss in '%s' sein" -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "ungültige Klasse von 'x' in Matrix_as_cs(a, x)" +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, fuzzy, c-format +msgid "'%s' must be an integer from %s to %s" +msgstr "'%s' muss in '%s' sein" -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "ungültige Klasse des Objektes zu %s" +#: dense.c:218 sparse.c:598 +#, fuzzy, c-format +msgid "'%s' must be less than or equal to '%s'" +msgstr "'%s' muss in '%s' sein" -#: cs_utils.c:147 -#, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "cs-Matrix nicht kompatibel mit Klasse '%s'" +#: dense.c:428 sparse.c:1069 +#, fuzzy, c-format +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "Diagonale zur Ersetzung hat die falsche Länge" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" -msgstr "Unangemessene Klasse cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" +msgstr "Diagonale zur Ersetzung hat die falsche Länge" -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" -msgstr "Unangemessene Klasse cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "Determinante benötigt eine quadratische Matrix" -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, fuzzy, c-format -msgid "'%s' must be an integer from %s to %s" -msgstr "'%s' muss in '%s' sein" +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" + +#: dense.c:1678 sparse.c:3135 #, fuzzy, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "'%s' muss in '%s' sein" -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "falsches zyklisches Linksverschieben, j (%d) < 0" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "falsches zyklisches Linksverschieben, j (%d) >= k (%d)" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "falsches zyklisches Linksverschieben, k (%d) > ldx (%d)" -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "Unbekannter Fehler in getGivens" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "X muss eine numerische (doppelte Genauigkeit) Matrix sein" -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "y muss eine numerische (doppelte Genauigkeit) Matrix sein" -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "" "Anzahl der Zeilen in y (%d) passt nicht zur Anzahl der Zeilen in X (%d)" # http://de.wikipedia.org/wiki/LAPACK -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "Lapack-Routine dposv gab Fehlerkode %d zurück" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "Lapack-Routine %s gab einen Fehlerkode %d zurück" -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "X muss eine echte (numerische) Matrix sein" -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "tol, als %g gegeben, muss <= 1 sein" -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "tol, als %g gegeben, muss <= 1 sein" -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "Erster Aufruf von dgeqrf gab Fehlerkode %d zurück" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "Lapack-Routine dtrcon gab Fehlerkode %d zurück" -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "dgCMatrix_lusol benötigt eine quadratische, nicht leere Matrix" +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "Determinante benötigt eine quadratische Matrix" -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "Dimensionen des Systems, das gelöst werden soll, sind inkonsistent" +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" +msgstr "%s(): Fall mit strukturellem Rangdefizit: evtl FALSCHE Nullen" -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "cs_lusol fehlgeschlagen" +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "Matrix ist nicht quadratisch" -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "dgCMatrix_qrsol(., Anordnung) benötigt Anordnung in {0,..,3}" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "Dimensionen des Systems sind inkonsistent" -#: dgCMatrix.c:77 +#: dgCMatrix.c:40 #, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -"dgCMatrix_qrsol(<%d x %d>-Matrix) benötigt eine 'lange' rechteckige Matrix" - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "cs_qrsol() innerhalb dgCMatrix_qrsol() fehlgeschlagen" -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "dgCMatrix_cholsol benötigt eine kurze breite rechteckige Matrix" - -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "cholmod_sdmult-Fehler (rhs)" - -#: dgCMatrix.c:127 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" -msgstr "cholmod_factorize fehlgeschlagen: Status %d, Minor %d von ncol %d" - -#: dgCMatrix.c:131 -#, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" msgstr "" -"cholmod_solve (CHOLMOD_A) fehlgeschlagen: Status %d, Minor %d von ncol %d" - -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "cholmod_sdmult-Fehler (resid)" -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "SuiteSparseQR_C_QR gab einen Fehlerkode zurück" - -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, fuzzy, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "Matrix dimension %d x %d (= %g) ist zu groß" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "Exponentielle Matrix benötigt eine quadratische Matrix ungleich Null" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp: LAPACK-Routine dgebal gab %d zurück" -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp: dgetrf gab Fehlerkode %d zurück" -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp: dgetrs gab Fehlerkode %d zurück" -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "" "dgeMatrix_Schur: Argument x muss eine quadratische Matrix ungleich Null sein" -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur: Erster Aufruf von dgees fehlgeschlagen" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur: dgees gab Fehlerkode %d zurück" -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" - -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "Lapack-Routine dgetrs:: System ist exakt singulär" - -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "%s ist keine Liste" -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "Determinante benötigt eine quadratische Matrix" - -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "%s(): Fall mit strukturellem Rangdefizit: evtl FALSCHE Nullen" - -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "Matrix ist nicht quadratisch" - -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Dimensionen des Systems sind inkonsistent" - -#: factorizations.c:1612 +#: idz.c:467 idz.c:528 #, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: factorizations.c:1703 -#, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" -msgstr "" - -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "fehlender 'Matrix'-Namensraum: Sollte niemals vorkommen" - -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "Matrix-Namensraum nicht korrekt bestimmt" - -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "Argument type[1]='%s' muss eine Zeichenkette aus einem Buchstaben sein" -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s' muss die Zeichenkettenlänge 1 haben" -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s' muss die Zeichenkettenlänge 1 haben" -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " "\"%s\"" msgstr "" -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s' muss die Zeichenkettenlänge 1 haben" -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 -#, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s' muss in '%s' sein" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" +msgstr "" + +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" +msgstr "" + +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "ungültiger Zeilenindex an Position %d" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, fuzzy, c-format -msgid "replacement diagonal has incompatible type \"%s\"" -msgstr "Diagonale zur Ersetzung hat die falsche Länge" +msgid "'%s' is not of type \"%s\"" +msgstr "Dim-Slot ist nicht ganzzahlig" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" -msgstr "Diagonale zur Ersetzung hat die falsche Länge" +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "Slot '%s' muss die Länge 1 haben" -#: products.c:155 products.c:248 +#: perm.c:86 perm.c:103 #, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "Dimensionen von x und y sind nicht kompatibel für %s" +msgid "'%s' is NA" +msgstr "" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" -msgstr "Argument y muss numerisch, ganzzahlig oder logisch sein" +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "Dim-Slot ist nicht ganzzahlig" -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "Matrizen sind nicht für Multiplikation konform" +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "Slot '%s' muss die Länge 1 haben" -#: products.c:408 +#: perm.c:120 perm.c:143 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' or '%s' is NA" msgstr "" -"Dimensionen passen nicht in Matrix multiplikation von \"dtrMatrix\": %d != %d" -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "dtrMatrix muss quadratisch sein" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:528 products.c:559 +#: perm.c:150 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "Dimensionen von a (%d,%d) und b (%d,%d) sind nicht konform" +msgid "'%s' is NA or less than %s" +msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "right=TRUE ist noch nicht implementiert __ FIXME" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: products.c:782 products.c:807 +#, c-format +msgid "'%s' does not support complex matrices" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" -msgstr "Determinante benötigt eine quadratische Matrix" +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "Matrix ist nicht quadratisch" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" -msgstr "" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" +msgstr "Determinante benötigt eine quadratische Matrix" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "ungültige Klasse von 'x' in Csparse_subassign()" -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "ungültige Klasse von 'value' in Csparse_subassign()" -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "x[] <- val: val in booleschen Wert umgewandelt für \"%s\" x" -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -918,413 +653,700 @@ "x[] <- val: val sollte ganzzahlig oder logisch sein, wird in ganze Zahl " "umgewandelt für \"%s\" x" -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "Fehler in Csparse_subassign(); sollte niemals vorkommen" -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "Dim-Slot ist nicht ganzzahlig" +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 -#, fuzzy, c-format -msgid "'%s' slot does not have length %d" -msgstr "Dim-Slot muss die Länge 2 haben" +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "Argument muss zahl-ähnlich atomar sein" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data' muss ein Vektortyp sein" + +#: utils-R.c:352 #, c-format -msgid "'%s' slot contains NA" +msgid "invalid '%s' argument" +msgstr "ungültiges '%s' Argument" + +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "nicht-numerische Matrix-Ausdehnung" + +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "unzulässiger Wert für 'nrow' (zu groß oder NA)" + +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "unzulässiger Wert für 'nrow' (< 0)" + +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "unzulässiger Wert für 'ncol' (zu groß oder NA)" + +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "unzulässiger Wert für 'ncol' (< 0)" + +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgstr "" +"Datenlänge [%d] ist kein Teilvielfaches oder Vielfaches der Zahl der Zeilen " +"[%d]" + +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" msgstr "" +"Datenlänge [%d] ist kein Teilvielfaches oder Vielfaches der Zahl der Spalten " +"[%d]" + +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "Datenlänge überschreitet Größe der Matrix" + +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "zu viele Elemente angegeben" + +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "Argument ij muss eine zweispaltige ganzzahlige Matrix sein" -#: validity.c:54 validity.c:976 validity.c:1009 +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "Subskript 'i' außerhalb des Bereichs in M[ij]" + +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "Subskript 'j' außerhalb des Bereichs in M[ij]" + +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" +msgstr "i und j müssen Ganzzahlvektoren mit der gleichen Länge sein" + +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 +#, fuzzy, c-format +msgid "'%s' slot does not have length %d" +msgstr "Dim-Slot muss die Länge 2 haben" + +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "Dim-Slot ist nicht ganzzahlig" -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "Dimnames[%d] ist kein Zeichenkettenvektor" -#: validity.c:101 +#: validity.c:92 #, fuzzy, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "length(Dimnames[%d]() unterscheidet sich von Dim[%d], was %d ist" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "x-Slot ist kein \\\"double\\\"" -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "Dim-Slot muss die Länge 2 haben" -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "x-Slot ist kein \\\"double\\\"" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "Dim-Slot muss die Länge 2 haben" - -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "'Dim'-Slot hat eine Länge kleiner zwei" - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "erstes Element von Slot p muss Null sein" - -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "Slot p darf nicht abnehmend sein" - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "'Dim'-Slot hat eine Länge kleiner zwei" - -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "Dim-Slot muss die Länge 2 haben" -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "" "uplo='U' darf keine dünn besetzten Einträge unterhalb der Diagonale haben" -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "" "uplo='L' darf keine dünn besetzten Einträge unterhalb der Diagonale haben" -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "" "uplo='U' darf keine dünn besetzten Einträge unterhalb der Diagonale haben" -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "Dim-Slot ist nicht ganzzahlig" + +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "Dim-Slot ist nicht ganzzahlig" + +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "'Dim'-Slot hat eine Länge kleiner zwei" + +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s' muss in '%s' sein" + +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "'Dim'-Slot hat eine Länge kleiner zwei" + +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" + +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "'Dim'-Slot hat eine Länge kleiner zwei" + +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" + +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "Dimensionen von x und y sind nicht kompatibel für %s" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "Dim-Slot muss die Länge 2 haben" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "Dim-Slot muss die Länge 2 haben" -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "" "uplo='L' darf keine dünn besetzten Einträge unterhalb der Diagonale haben" -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "Dim-Slot muss die Länge 2 haben" -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "" "uplo='U' darf keine dünn besetzten Einträge unterhalb der Diagonale haben" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, fuzzy, c-format msgid "%s[%d] (%s) is not in %s" msgstr "%s ist keine Liste" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, fuzzy, c-format msgid "%s is not in {%s}" msgstr "%s ist keine Liste" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, fuzzy, c-format msgid "%s is not %d" msgstr "%s ist keine Liste" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "'Dim'-Slot hat eine Länge kleiner zwei" -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "erstes Element von Slot p muss Null sein" -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "Slot j ist nicht zunehmend innerhalb einer Spalte" -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "Dim-Slot ist nicht ganzzahlig" - -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "ungültige Klasse des Objektes zu %s" +# http://www.matheboard.de/archive/160705/thread.html +#, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "Diagonalelement %d des Choleskyfaktors fehlt" + +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "cholmod_factorize_p fehlgeschlagen: Status %d, Minor %d von ncol %d" + +#~ msgid "cholmod_change_factor failed" +#~ msgstr "cholmod_change_factor fehlgeschlagen" + +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "cholmod_write_sparse gab Fehlerkode zurück" + +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (zurückgetauscht) ist experimentell" + +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC(): 'resultKind' ungültig" + +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "Kode für komplexe dünn besetzte Matrizen noch nicht geschrieben" + +#~ msgid "Argument rho must be an environment" +#~ msgstr "Argument rho muss eine Umgebung sein" + +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "ungültige Klasse des Objektes zu as_cholmod_sparse" + +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "ungültiges Objekt an as_cholmod_sparse übergeben" + +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "in_place cholmod_sort gab einen Fehlerkode zurück" + +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "cholmod_sort gab einen Fehlerkode zurück" + +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "chm_sparse_to_SEXP(, *): ungültiges 'Rkind' (echter Artkode)" + +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "unbekannter xtype in Objekt cholmod_sparse" + +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "Kode für komplexe dünn besetzte Matrizen noch nicht geschrieben" + +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Symmetrisch und dreieckig sind beide gesetzt" + +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "ungültige Klasse des Objektes zu as_cholmod_triplet" + +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "" +#~ "as_cholmod_triplet(): konnte für internes diagU2N() nicht reallozieren" + +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "unbekannter xtype in Objekt cholmod_triplet" + +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "ungültige Klasse des Objektes zu as_cholmod_dense" + +#, c-format +#~ msgid "" +#~ "chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +#~ msgstr "" +#~ "chm_transpose_dense(ans, x) noch nicht implementiert für %s verschieden " +#~ "von %s" + +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "cholmod kann nicht initialisiert werden: Fehlerkode %d" + +#~ msgid "unknown 'Rkind'" +#~ msgstr "'Rkind' unbekannt" + +#~ msgid "unknown xtype" +#~ msgstr "unbekannter xtype" + +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "Kode für cholmod_dense mit Löchern noch nicht geschrieben" + +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "es ist nicht klar, ob eine dicht besetzte Mustermatrix sinnvoll ist" + +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "ungültige Klasse des Objektes zu as_cholmod_factor" + +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "Misserfolg in as_cholmod_factor" + +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "CHOLMOD-Faktorzerlegung war nicht erfolgreich" + +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "f->xtype von %d nicht erkannt" + +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U(-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_qrsol(<%d x %d>-Matrix) benötigt eine 'lange' rechteckige Matrix" + +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "cs_qrsol() innerhalb dgCMatrix_qrsol() fehlgeschlagen" + +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "dgCMatrix_cholsol benötigt eine kurze breite rechteckige Matrix" + +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "cholmod_sdmult-Fehler (rhs)" + +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_factorize fehlgeschlagen: Status %d, Minor %d von ncol %d" + +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "cholmod_solve (CHOLMOD_A) fehlgeschlagen: Status %d, Minor %d von ncol %d" + +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "cholmod_sdmult-Fehler (resid)" + +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "SuiteSparseQR_C_QR gab einen Fehlerkode zurück" + +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "Lapack-Routine dgetrs:: System ist exakt singulär" + +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "der führende Minor der Ordnung %d ist nicht positiv definit" + +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "fehlender 'Matrix'-Namensraum: Sollte niemals vorkommen" + +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "Matrix-Namensraum nicht korrekt bestimmt" + +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x): x ist keine gültige (abgesehen vom Sortieren) " +#~ "CsparseMatrix" + +#, c-format +#~ msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" +#~ msgstr "Unmögliche Rk_x/Rk_y in Csparse_%s(). Bitte dem Entwickler melden!" + +#, c-format +#~ msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" +#~ msgstr "" +#~ "chm_MOD_xtype() nicht erfolgreich in Csparse_%s(). Bitte dem Entwickler " +#~ "melden!" + +#, c-format +#~ msgid "the number of columns differ in R_rbind2_vector: %d != %d" +#~ msgstr "" +#~ "die Anzahl der Spalten untescheidet sich in R_rbind2_vector: %d != %d" + +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "csp_eye-Argument n muss positiv sein" + +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "ungültige Klasse von 'x' in Matrix_as_cs(a, x)" + +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "ungültige Klasse des Objektes zu %s" + +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "cs-Matrix nicht kompatibel mit Klasse '%s'" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "Unangemessene Klasse cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "Unangemessene Klasse cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "Dimensionen von x und y sind nicht kompatibel für %s" + +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "Argument y muss numerisch, ganzzahlig oder logisch sein" + +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "Matrizen sind nicht für Multiplikation konform" + +#, c-format +#~ msgid "" +#~ "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +#~ msgstr "" +#~ "Dimensionen passen nicht in Matrix multiplikation von \"dtrMatrix\": %d !" +#~ "= %d" + +#~ msgid "dtrMatrix must be square" +#~ msgstr "dtrMatrix muss quadratisch sein" + +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "Dimensionen von a (%d,%d) und b (%d,%d) sind nicht konform" + +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "right=TRUE ist noch nicht implementiert __ FIXME" + #, c-format #~ msgid "cholmod_change_factor failed with status %d" #~ msgstr "cholmod_change_factor mit Status %d fehlgeschlagen" @@ -1627,9 +1649,6 @@ #~ msgid "dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE" #~ msgstr "dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE" -#~ msgid "cs_qr failed" -#~ msgstr "cs_qr fehlgeschlagen" - #~ msgid "LU decomposition applies only to square matrices" #~ msgstr "LU-Zerlegung ist nur bei quadratischen Matrizen anwendbar" diff -Nru rmatrix-1.6-1.1/po/fr.po rmatrix-1.6-5/po/fr.po --- rmatrix-1.6-1.1/po/fr.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/fr.po 2023-11-03 01:34:40.000000000 +0000 @@ -6,7 +6,7 @@ msgstr "" "Project-Id-Version: Matrix 1.1-1\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2021-04-12 18:57+0200\n" "Last-Translator: Philippe Grosjean \n" "Language-Team: none\n" @@ -17,904 +17,637 @@ "Plural-Forms: nplurals=2; plural=(n > 1);\n" "X-Generator: Poedit 2.4.2\n" -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "l'élément de diagonale %d de la factorisation de Cholesky est manquant" - -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "cholmod_factorize_p a échoué : statut %d, mineur %d de ncol %d" - -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "cholmod_change_factor a échoué" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "" -"Csparse_sort(x) : x est une CsparseMatrix incorrecte (au delà d'un problème " -"de tri)" +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "cs_qr a échoué" -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "Rk_x/Rk_y impossible dans Csparse_%s(), veuillez reporter l’erreur" +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "chm_MOD_xtype() a échoué dans Csparse_%s(), veuillez reporter l’erreur" +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "argument '%s' incorrect" -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "erreur lors de l'ouverture en écriture du fichier \"%s\"" -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "cholmod_write_sparse a renvoyé le code d'erreur" - -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (back-permuted) est expérimental" - -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC() : 'resultKind' incorrect" - -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "argument '%s' incorrect" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "indices de lignes erronés à la position %d" - -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "Le slot Dim n’est pas un entier" - -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "le slot '%s' doit avoir une longueur de 1" - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "Le slot Dim n’est pas un entier" - -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "le slot '%s' doit avoir une longueur de 1" - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "L'argument ij doit être une matrice d'entiers à 2 colonnes" - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "indice 'i' hors plage dans M[ij]" - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "indice 'j' hors plage dans M[ij]" - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" -msgstr "i et j doivent être des vecteurs d'entiers de même longueur" - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data' doit être de type vecteur" - -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "argument '%s' incorrect" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "étendue de matrice non numérique" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "valeur 'nrow' incorrecte (trop large ou NA)" - -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "valeur 'nrow' incorrecte (< 0)" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." +msgstr "" -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "valeur 'ncol' incorrecte (trop large ou NA)" +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "Le slot Dim n’est pas un entier" -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "valeur 'ncol' incorrecte (< 0)" +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "Le slot Dim doit avoir une longueur de 2" -#: Mutils.c:1444 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" -msgstr "" -"la longueur des données [%d] n'est pas un sous-multiple ni un multiple du " -"nombre de lignes [%d]" +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "le premier élément du slot p doit être à zéro" -#: Mutils.c:1449 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" +msgid "'%s' slot contains NA" msgstr "" -"la longueur des données [%d] n'est pas un sous-multiple ni un multiple du " -"nombre de colonnes [%d]" - -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "la longueur des données excède la taille de la matrice" -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "trop d'éléments sont spécifiés" +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "le slot p ne peut contenir de valeurs décroissantes" -#: Mutils.c:1530 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" -msgstr "le nombre de colonnes diffère dans R_rbind2_vector: %d != %d" - -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" +msgid "first differences of '%s' slot exceed %s" msgstr "" -"L'argument doit être un vecteur atomique de type numérique ou convertible en " -"nombres" -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" -msgstr "" +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" -msgstr "" +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "dimensions cannot exceed %s" +msgid "wrong '%s'" msgstr "" -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" - -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" -msgstr "" - -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "le code n'est pas encore écrit pour les matrices éparses complexes" +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "Le slot Dim n’est pas un entier" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 +#: chm_common.c:481 cholmod-etc.c:190 #, c-format -msgid "%s cannot exceed %s" +msgid "n+1 would overflow type \"%s\"" msgstr "" -#: bind.c:848 -msgid "should never happen ..." -msgstr "" - -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "L'argument rho doit être un environnement" - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "classe d'objet incorrecte pour as_cholmod_sparse" - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "objet incorrect passé à as_cholmod_sparse" - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "in_place cholmod_sort a renvoyé un code d'erreur" - -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "cholmod_sort a renvoyé un code d'erreur" - -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" -msgstr "chm_sparse_to_SEXP(, *) : 'Rkind' incorrect (real kind code)" - -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "xtype inconnu dans cholmod_sparse object" - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "le code n'est pas encore écrit pour les matrices éparses complexes" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Symmetric et triangular sont tous deux sélectionnés" +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "le 'leading minor of order' %d n'est pas un entier fini" -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "classe d'objet incorrecte pour as_cholmod_triplet" +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "le 'leading minor of order' %d n'est pas un entier fini" -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -"as_cholmod_triplet() : impossible de réallouer de la mémoire pour la " -"fonction interne diagU2N()" - -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "xtype inconnu dans l'objet cholmod_triplet" - -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "classe d'objet incorrecte pour as_cholmod_dense" -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" -"chm_transpose_dense(ans, x) pas encore implémenté pour %s différent de %s" -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Erreur Cholmod '%s' dans le fichier %s, ligne %d" -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Avertissement Cholmod '%s' dans le fichier %s, ligne %d" -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "Impossible d'initialiser cholmod : code d'erreur %d" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "'Rkind' inconnu" - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "xtype inconnu" - -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "le code pour cholmod_dense en présence de trous n'est pas encore écrit" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "je ne sais pas si une matrice pattern dense a un sens" +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "Determinant nécessite une matrice carrée" -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "class d'objet incorrecte pour as_cholmod_factor" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" +msgstr "" -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "erreur dans as_cholmod_factor" +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s' doit être compris dans '%s'" -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "La factorisation CHOLMOD a échoué" +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s' doit être compris dans '%s'" -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "f->xtype de %d non reconnu" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U(): nrow=%d, ncol=%d" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" +msgstr "" -#: chm_common.c:1283 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" -msgstr "chm_diagN2U(x, uploT = %d): uploT doit être +- 1" - -#: coerce.c:60 -#, fuzzy, c-format -msgid "attempt to construct %s or %s from non-square matrix" -msgstr "Determinant nécessite une matrice carrée" - -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 -#, fuzzy, c-format -msgid "invalid '%s' to %s()" -msgstr "argument '%s' incorrect" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" +msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "Determinant nécessite une matrice carrée" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "Determinant nécessite une matrice carrée" -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "l'argument n de csp_eye doit être positif" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s' doit être compris dans '%s'" -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "classe incorrecte de 'x' dans Matrix_as_cs(a, x)" +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, fuzzy, c-format +msgid "'%s' must be an integer from %s to %s" +msgstr "'%s' doit être compris dans '%s'" -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "classe incorrecte d'objet à %s" +#: dense.c:218 sparse.c:598 +#, fuzzy, c-format +msgid "'%s' must be less than or equal to '%s'" +msgstr "'%s' doit être compris dans '%s'" -#: cs_utils.c:147 -#, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "matrice cs incompatible avec la classe '%s'" +#: dense.c:428 sparse.c:1069 +#, fuzzy, c-format +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "la diagonale de remplacement a une longueur incorrecte" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" -msgstr "Classe inappropriée cl='%s' dans Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" +msgstr "la diagonale de remplacement a une longueur incorrecte" -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" -msgstr "Classe inappropriée cl='%s' dans Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "Determinant nécessite une matrice carrée" -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, fuzzy, c-format -msgid "'%s' must be an integer from %s to %s" -msgstr "'%s' doit être compris dans '%s'" +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" + +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:1678 sparse.c:3135 #, fuzzy, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "'%s' doit être compris dans '%s'" -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "décalage cyclique à gauche incorrect, j (%d) < 0" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "décalage cyclique à gauche incorrect, j (%d) >= k (%d)" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "décalage cyclique à gauche incorrect, k (%d) > ldx (%d)" -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "Erreur inconnue dans getGivens" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "X doit être une matrice numérique (double précision)" -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "y doit être une matrice numérique (double précision)" -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "" "le nombre de lignes de y (%d) ne correspond pas au nombre de lignes de X (%d)" -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "La routine Lapack dposv a renvoyé le code d'erreur %d" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "La routine Lapack %s a renvoyé le code d'erreur %d" -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "X doit être une matrice (numérique) de réels" -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "tol, donné comme %g, doit être <= 1" -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "tol, donné comme %g, doit être <= 1" -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "Le premier appel à dgeqrf a renvoyé le code d'erreur %d" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "La routine Lapack dtrcon a renvoyé le code d'erreur %d" -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "dgCMatrix_lusol nécessite une matrice carrée non vide" - -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "Les dimensions du système à résoudre sont incohérentes" - -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "cs_lusol a échoué" - -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "dgCMatrix_qrsol(., order) nécessite un ordre compris entre {0,..,3}" +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "Determinant nécessite une matrice carrée" -#: dgCMatrix.c:77 -#, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" msgstr "" -"dgCMatrix_qrsol(<%d x %d>-matrix) nécessite une matrice rectangulaire haute " -"('tall')" - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "cs_qrsol() a échoué à l'intérieur de dgCMatrix_qrsol()" +"%s() : cas structurellement déficient de rang : probablement des zéros " +"ERRONES" -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "dgCMatrix_cholsol nécessite une matrice rectangulaire en longueur" +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "Matrix n'est pas carrée" -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "erreur cholmod_sdmult (partie droite de l'équation)" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "Les dimensions du système à résoudre sont incohérentes" -#: dgCMatrix.c:127 +#: dgCMatrix.c:40 #, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" -msgstr "cholmod_factorize a échoué : statut %d, mineur %d pour ncol %d" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" +msgstr "" -#: dgCMatrix.c:131 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" -msgstr "cholmod_solve (CHOLMOD_A) a échoué : statut %d, mineur %d pour ncol %d" - -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "erreur cholmod_sdmult (resid)" - -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "SuiteSparseQR_C_QR a renvoyé un code d'erreur" +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" +msgstr "" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, fuzzy, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "La dimension de l’objet Matrix %d x %d (= %g) est trop large" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "L'exponentiation de matrice nécessite une matrice carrée non nulle" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp : la routine LAPACK dgebal a renvoyé %d" -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp : dgetrf a renvoyé le code d'erreur %d" -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp : dgetrs a renvoyé le code d'erreur %d" -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "dgeMatrix_Schur : l'argument x doit être une matrice carrée non nulle" -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur : le premier appel à dgees a échoué" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur : dgees a renvoyé le code d'erreur %d" -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "le 'leading minor of order' %d n'est pas un entier fini" - -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "le 'leading minor of order' %d n'est pas un entier fini" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "Routine Lapack dgetrs : le système est exactement singulier" - -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "le 'leading minor of order' %d n'est pas un entier fini" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "%s n’est pas une liste" -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "Determinant nécessite une matrice carrée" - -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "" -"%s() : cas structurellement déficient de rang : probablement des zéros " -"ERRONES" - -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "Matrix n'est pas carrée" - -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Les dimensions du système à résoudre sont incohérentes" - -#: factorizations.c:1612 -#, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" -msgstr "" - -#: factorizations.c:1703 +#: idz.c:467 idz.c:528 #, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "espace de noms 'Matrix' manquant : ceci ne devrait jamais se produire" - -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "L’espace de noms Matrix n'est pas correctement déterminé" - -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "" "l'argument type[1]='%s' doit être une chaîne de caractères à une seule lettre" -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s' doit avoir une longueur de chaîne de caractères de 1" -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s' doit avoir une longueur de chaîne de caractères de 1" -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " "\"%s\"" msgstr "" -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s' doit avoir une longueur de chaîne de caractères de 1" -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 -#, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s' doit être compris dans '%s'" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" +msgstr "" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" +msgstr "" + +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "indices de lignes erronés à la position %d" + +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, fuzzy, c-format -msgid "replacement diagonal has incompatible type \"%s\"" -msgstr "la diagonale de remplacement a une longueur incorrecte" +msgid "'%s' is not of type \"%s\"" +msgstr "Le slot Dim n’est pas un entier" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" -msgstr "la diagonale de remplacement a une longueur incorrecte" +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "le slot '%s' doit avoir une longueur de 1" -#: products.c:155 products.c:248 +#: perm.c:86 perm.c:103 #, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "Les dimensions de x et y ne sont pas compatibles pour %s" +msgid "'%s' is NA" +msgstr "" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" -msgstr "L'argument y doit être un nombre réel, un entier ou un booléen" +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "Le slot Dim n’est pas un entier" -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "Les matrices sont incohérentes pour la multiplication" +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "le slot '%s' doit avoir une longueur de 1" -#: products.c:408 +#: perm.c:120 perm.c:143 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' or '%s' is NA" msgstr "" -"dimensions incompatibles pour la multiplication matricielle avec " -"\"dtrMatrix\" : %d != %d" -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "dtrMatrix doit être carrée" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:528 products.c:559 +#: perm.c:150 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "Les dimensions de a (%d,%d) et b (%d,%d) ne sont pas conformes" +msgid "'%s' is NA or less than %s" +msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "right=TRUE n'est pas encore implémenté __ FIXME" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: products.c:782 products.c:807 +#, c-format +msgid "'%s' does not support complex matrices" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" -msgstr "Determinant nécessite une matrice carrée" +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "Matrix n'est pas carrée" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" -msgstr "" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" +msgstr "Determinant nécessite une matrice carrée" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "classe de 'x' incorrecte dans Csparse_subassign()" -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "classe de 'value' incorrecte dans Csparse_subassign()" -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "" "x[] <- val: val est converti automatiquement en valeurs logiques pour \"%s\" " "x" -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -923,411 +656,701 @@ "x[] <- val: val devrait être des entiers ou des valeurs booléennes, il est " "converti automatiquement en entiers pour \"%s\" x" -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "" "erreur de programmation dans Csparse_subassign() qui ne devrait jamais se " "produire" -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "Le slot Dim n’est pas un entier" +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 -#, fuzzy, c-format -msgid "'%s' slot does not have length %d" -msgstr "Le slot Dim doit avoir une longueur de 2" +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "" +"L'argument doit être un vecteur atomique de type numérique ou convertible en " +"nombres" + +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data' doit être de type vecteur" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 +#: utils-R.c:352 #, c-format -msgid "'%s' slot contains NA" +msgid "invalid '%s' argument" +msgstr "argument '%s' incorrect" + +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "étendue de matrice non numérique" + +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "valeur 'nrow' incorrecte (trop large ou NA)" + +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "valeur 'nrow' incorrecte (< 0)" + +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "valeur 'ncol' incorrecte (trop large ou NA)" + +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "valeur 'ncol' incorrecte (< 0)" + +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" msgstr "" +"la longueur des données [%d] n'est pas un sous-multiple ni un multiple du " +"nombre de lignes [%d]" + +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" +msgstr "" +"la longueur des données [%d] n'est pas un sous-multiple ni un multiple du " +"nombre de colonnes [%d]" -#: validity.c:54 validity.c:976 validity.c:1009 +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "la longueur des données excède la taille de la matrice" + +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "trop d'éléments sont spécifiés" + +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "L'argument ij doit être une matrice d'entiers à 2 colonnes" + +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "indice 'i' hors plage dans M[ij]" + +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "indice 'j' hors plage dans M[ij]" + +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" +msgstr "i et j doivent être des vecteurs d'entiers de même longueur" + +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 +#, fuzzy, c-format +msgid "'%s' slot does not have length %d" +msgstr "Le slot Dim doit avoir une longueur de 2" + +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "Le slot Dim n’est pas un entier" -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "Dimnames[%d] n’est pas un vecteur de chaînes de caractères" -#: validity.c:101 +#: validity.c:92 #, fuzzy, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "length(Dimnames[%d]) diffère de Dim[%d] qui est %d" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "le slot x n’est pas un nombre \"double\"" -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "Le slot Dim doit avoir une longueur de 2" -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "le slot x n’est pas un nombre \"double\"" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "Le slot Dim doit avoir une longueur de 2" - -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "le slot 'Dim' a une longueur inférieure à deux" - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "le premier élément du slot p doit être à zéro" - -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "le slot p ne peut contenir de valeurs décroissantes" - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "le slot 'Dim' a une longueur inférieure à deux" - -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "Le slot Dim doit avoir une longueur de 2" -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "uplo='U' ne peut avoir des entrées éparses en dessous de la diagonale" -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "uplo='L' ne peut avoir des entrées éparses au dessus de la diagonale" -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "uplo='U' ne peut avoir des entrées éparses en dessous de la diagonale" -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "Le slot Dim n’est pas un entier" + +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "Le slot Dim n’est pas un entier" + +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "le slot 'Dim' a une longueur inférieure à deux" + +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s' doit être compris dans '%s'" + +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "le slot 'Dim' a une longueur inférieure à deux" + +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" + +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "le slot 'Dim' a une longueur inférieure à deux" + +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" + +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "Les dimensions de x et y ne sont pas compatibles pour %s" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "Le slot Dim doit avoir une longueur de 2" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "Le slot Dim doit avoir une longueur de 2" -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "uplo='L' ne peut avoir des entrées éparses au dessus de la diagonale" -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "Le slot Dim doit avoir une longueur de 2" -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "uplo='U' ne peut avoir des entrées éparses en dessous de la diagonale" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, fuzzy, c-format msgid "%s[%d] (%s) is not in %s" msgstr "%s n’est pas une liste" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, fuzzy, c-format msgid "%s is not in {%s}" msgstr "%s n’est pas une liste" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, fuzzy, c-format msgid "%s is not %d" msgstr "%s n’est pas une liste" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "le slot 'Dim' a une longueur inférieure à deux" -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "le premier élément du slot p doit être à zéro" -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "le slot j ne contient pas de valeurs croissantes au sein d'une colonne" -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "Le slot Dim n’est pas un entier" - -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "classe incorrecte d'objet à %s" #, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "" +#~ "l'élément de diagonale %d de la factorisation de Cholesky est manquant" + +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "cholmod_factorize_p a échoué : statut %d, mineur %d de ncol %d" + +#~ msgid "cholmod_change_factor failed" +#~ msgstr "cholmod_change_factor a échoué" + +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "cholmod_write_sparse a renvoyé le code d'erreur" + +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (back-permuted) est expérimental" + +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC() : 'resultKind' incorrect" + +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "le code n'est pas encore écrit pour les matrices éparses complexes" + +#~ msgid "Argument rho must be an environment" +#~ msgstr "L'argument rho doit être un environnement" + +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "classe d'objet incorrecte pour as_cholmod_sparse" + +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "objet incorrect passé à as_cholmod_sparse" + +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "in_place cholmod_sort a renvoyé un code d'erreur" + +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "cholmod_sort a renvoyé un code d'erreur" + +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "chm_sparse_to_SEXP(, *) : 'Rkind' incorrect (real kind code)" + +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "xtype inconnu dans cholmod_sparse object" + +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "le code n'est pas encore écrit pour les matrices éparses complexes" + +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Symmetric et triangular sont tous deux sélectionnés" + +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "classe d'objet incorrecte pour as_cholmod_triplet" + +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "" +#~ "as_cholmod_triplet() : impossible de réallouer de la mémoire pour la " +#~ "fonction interne diagU2N()" + +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "xtype inconnu dans l'objet cholmod_triplet" + +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "classe d'objet incorrecte pour as_cholmod_dense" + +#, c-format +#~ msgid "" +#~ "chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +#~ msgstr "" +#~ "chm_transpose_dense(ans, x) pas encore implémenté pour %s différent de %s" + +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "Impossible d'initialiser cholmod : code d'erreur %d" + +#~ msgid "unknown 'Rkind'" +#~ msgstr "'Rkind' inconnu" + +#~ msgid "unknown xtype" +#~ msgstr "xtype inconnu" + +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "" +#~ "le code pour cholmod_dense en présence de trous n'est pas encore écrit" + +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "je ne sais pas si une matrice pattern dense a un sens" + +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "class d'objet incorrecte pour as_cholmod_factor" + +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "erreur dans as_cholmod_factor" + +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "La factorisation CHOLMOD a échoué" + +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "f->xtype de %d non reconnu" + +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U(): nrow=%d, ncol=%d" + +#, c-format +#~ msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#~ msgstr "chm_diagN2U(x, uploT = %d): uploT doit être +- 1" + +#~ msgid "dgCMatrix_lusol requires a square, non-empty matrix" +#~ msgstr "dgCMatrix_lusol nécessite une matrice carrée non vide" + +#~ msgid "Dimensions of system to be solved are inconsistent" +#~ msgstr "Les dimensions du système à résoudre sont incohérentes" + +#~ msgid "cs_lusol failed" +#~ msgstr "cs_lusol a échoué" + +#~ msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#~ msgstr "dgCMatrix_qrsol(., order) nécessite un ordre compris entre {0,..,3}" + +#, c-format +#~ msgid "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) nécessite une matrice rectangulaire " +#~ "haute ('tall')" + +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "cs_qrsol() a échoué à l'intérieur de dgCMatrix_qrsol()" + +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "dgCMatrix_cholsol nécessite une matrice rectangulaire en longueur" + +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "erreur cholmod_sdmult (partie droite de l'équation)" + +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_factorize a échoué : statut %d, mineur %d pour ncol %d" + +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "cholmod_solve (CHOLMOD_A) a échoué : statut %d, mineur %d pour ncol %d" + +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "erreur cholmod_sdmult (resid)" + +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "SuiteSparseQR_C_QR a renvoyé un code d'erreur" + +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "Routine Lapack dgetrs : le système est exactement singulier" + +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "le 'leading minor of order' %d n'est pas un entier fini" + +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "" +#~ "espace de noms 'Matrix' manquant : ceci ne devrait jamais se produire" + +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "L’espace de noms Matrix n'est pas correctement déterminé" + +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x) : x est une CsparseMatrix incorrecte (au delà d'un " +#~ "problème de tri)" + +#, c-format +#~ msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" +#~ msgstr "Rk_x/Rk_y impossible dans Csparse_%s(), veuillez reporter l’erreur" + +#, c-format +#~ msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" +#~ msgstr "" +#~ "chm_MOD_xtype() a échoué dans Csparse_%s(), veuillez reporter l’erreur" + +#, c-format +#~ msgid "the number of columns differ in R_rbind2_vector: %d != %d" +#~ msgstr "le nombre de colonnes diffère dans R_rbind2_vector: %d != %d" + +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "l'argument n de csp_eye doit être positif" + +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "classe incorrecte de 'x' dans Matrix_as_cs(a, x)" + +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "classe incorrecte d'objet à %s" + +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "matrice cs incompatible avec la classe '%s'" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "Classe inappropriée cl='%s' dans Matrix_css_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "Classe inappropriée cl='%s' dans Matrix_csn_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "Les dimensions de x et y ne sont pas compatibles pour %s" + +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "L'argument y doit être un nombre réel, un entier ou un booléen" + +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "Les matrices sont incohérentes pour la multiplication" + +#, c-format +#~ msgid "" +#~ "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +#~ msgstr "" +#~ "dimensions incompatibles pour la multiplication matricielle avec " +#~ "\"dtrMatrix\" : %d != %d" + +#~ msgid "dtrMatrix must be square" +#~ msgstr "dtrMatrix doit être carrée" + +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "Les dimensions de a (%d,%d) et b (%d,%d) ne sont pas conformes" + +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "right=TRUE n'est pas encore implémenté __ FIXME" + +#, c-format #~ msgid "cholmod_change_factor failed with status %d" #~ msgstr "cholmod_change_factor a échoué avec le statut %d" @@ -1636,9 +1659,6 @@ #~ msgid "dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE" #~ msgstr "dgcMatrix_QR(*, keep_dimnames = NA): NA considéré comme TRUE" -#~ msgid "cs_qr failed" -#~ msgstr "cs_qr a échoué" - #~ msgid "LU decomposition applies only to square matrices" #~ msgstr "La décomposition LU n'est utilisable que pour des matrices carrées" diff -Nru rmatrix-1.6-1.1/po/it.po rmatrix-1.6-5/po/it.po --- rmatrix-1.6-1.1/po/it.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/it.po 2023-11-03 01:34:40.000000000 +0000 @@ -7,7 +7,7 @@ msgstr "" "Project-Id-Version: Matrix 1.3-3\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2021-04-14 12:18+0200\n" "Last-Translator: Daniele Medri \n" "Language-Team: Italian https://github.com/dmedri/R-italian-lang\n" @@ -18,900 +18,635 @@ "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Poedit 2.2.1\n" -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "l'elemento diagonale %d del fattore Cholesky è assente" - -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "cholmod_factorize_p non riuscito: stato %d, minore %d di ncol %d" - -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "cholmod_change_factor fallito" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "" -"Csparse_sort(x): x non è una valida (a parte l'ordinamento) CsparseMatrix" +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "cs_qr fallita" -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "" -"Non è possibile avere Rk_x/Rk_y in Csparse_%s(), per piacere riportatelo" +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "lo slot j non è crescente all'interno di una colonna" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "" -"chm_MOD_xtype() non ha avuto successo in Csparse_%s(), per piacere, " -"segnalatelo" +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "argomento '%s' non valido" -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "apertura file \"%s\" in scrittura fallita" -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "cholmod_write_sparse ha restituito il codice di errore" - -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (back-permuted) è sperimentale" - -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC(): 'resultKind' non valido" - -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "argomento '%s' non valido" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "indice riga non valido nella posizione %d" - -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "Lo slot dim non è intero" - -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "lo slot '%s' deve avere lunghezza 1" - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "Lo slot dim non è intero" - -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "lo slot '%s' deve avere lunghezza 1" - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "L'argomento ij dev'essere una matrice di interi con 2 colonne" - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "subscript 'i' fuori banda in M[ij]" - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "subscript 'j' fuori banda in M[ij]" - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" -msgstr "i e j devono essere vettori di interi con la medesima lunghezza" - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data' dev'essere un tipo vettore" - -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "argomento '%s' non valido" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "estensione della matrice non numerica" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "valore 'nrow' non valido (troppo largo o NA)" - -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "valore 'nrow' non valido (< 0)" - -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "valore 'ncol' non valido (troppo larga o NA)" - -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "valore 'ncol' non valido (< 0)" - -#: Mutils.c:1444 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." msgstr "" -"la lunghezza dati [%d] non è un sotto-multiplo o multiplo del numero di " -"righe [%d]" -#: Mutils.c:1449 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" -msgstr "" -"la lunghezza dati [%d] non è un sotto-multiplo o multiplo del numero di " -"colonne [%d]" +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "Lo slot dim non è intero" -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "la lunghezza dei dati eccede la dimensione della matrice" +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "Lo slot dim deve avere lunghezza 2" -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "specificati troppi elementi" +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "il primo elemento dello slot p dev'essere zero" -#: Mutils.c:1530 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" -msgstr "il numero di colonne differisce in R_rbind2_vector: %d != %d" - -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "L'argomento dev'essere un vettore atomico numerico" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" +msgid "'%s' slot contains NA" msgstr "" -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" -msgstr "" +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "lo slot p dev'essere non decrescente" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "dimensions cannot exceed %s" -msgstr "" - -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" +msgid "first differences of '%s' slot exceed %s" msgstr "" -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" -msgstr "" +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "codice a matrice sparsa complessa non ancora scritto" +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "%s cannot exceed %s" +msgid "wrong '%s'" msgstr "" -#: bind.c:848 -msgid "should never happen ..." -msgstr "" - -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "L'argomento rho dev'essere un ambiente" - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "classe di oggetto a as_cholmod_sparse non valida" - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "oggetto non valido passato a as_cholmod_sparse" - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "in_place cholmod_sort ha restituito un codice di errore" - -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "cholmod_sort ha restituito un codice di errore" +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "Lo slot dim non è intero" -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#: chm_common.c:481 cholmod-etc.c:190 +#, c-format +msgid "n+1 would overflow type \"%s\"" msgstr "" -"chm_sparse_to_SEXP(, *): 'Rkind' non valido (codice di tipo reale)" -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "xtype sconosciuto nell'oggetto cholmod_sparse" - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "codice a matrice sparsa complessa non ancora scritto" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Simmetrici e triangolari entrambi impostati" - -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "classe di oggetto a as_cholmod_triplet non valida" - -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" -msgstr "as_cholmod_triplet(): non è possibile riallocare per diagU2N() interno" +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "il minore principale dell'ordine %d non è definito positivo" -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "xtype sconosciuto nell'oggetto cholmod_triplet" +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "il minore principale dell'ordine %d non è definito positivo" -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "classe di oggetto a as_cholmod_dense non valida" +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" +msgstr "" -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" -"chm_transpose_dense(ans, x) non ancora implementato per %s diverso da%s" -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Errore cholmod '%s' nel file %s, linea %d" -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Avvertimento cholmod '%s' nel file %s, linea %d" -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "Non è possibile inizializzare il colmod: codice di errore %d" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "'Rkind' sconosciuto" - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "xtype sconosciuto" - -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "il codice per cholmod_dense con buchi non ancora scritto" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "non sappiamo se una matrice di schemi densi abbia senso" +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "Il determinante richiede una matrice quadrata" -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "classe di oggetto a as_cholmod_factor non valida" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" +msgstr "" -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "fallimento in as_cholmod_factor" +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s' dev'essere in '%s'" -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "La fattorizzazione CHOLMOD non è andata a buon fine" +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s' dev'essere in '%s'" -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "f->xtype di %d non riconosciuta" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U (): nrow =%d, ncol =%d" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" +msgstr "" -#: chm_common.c:1283 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" -msgstr "chm_diagN2U (x, uploT =%d): uploT dovrebbe essere +-1" - -#: coerce.c:60 -#, fuzzy, c-format -msgid "attempt to construct %s or %s from non-square matrix" -msgstr "Il determinante richiede una matrice quadrata" - -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 -#, fuzzy, c-format -msgid "invalid '%s' to %s()" -msgstr "argomento '%s' non valido" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" +msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "Il determinante richiede una matrice quadrata" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "Il determinante richiede una matrice quadrata" -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "l'argomento csp_eye n dev'essere positivo" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s' dev'essere in '%s'" -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "classe di 'x' in Matrix_as_cs(a, x) non valida" +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, fuzzy, c-format +msgid "'%s' must be an integer from %s to %s" +msgstr "'%s' dev'essere in '%s'" -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "classe di oggetto a %s non valida" +#: dense.c:218 sparse.c:598 +#, fuzzy, c-format +msgid "'%s' must be less than or equal to '%s'" +msgstr "'%s' dev'essere in '%s'" -#: cs_utils.c:147 -#, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "matrice cs non compatibile con la classe '%s'" +#: dense.c:428 sparse.c:1069 +#, fuzzy, c-format +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "la diagonale di ricambio ha una lunghezza errata" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" -msgstr "Classe inappropriata cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" +msgstr "la diagonale di ricambio ha una lunghezza errata" -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" -msgstr "Classe inappropriata cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "Il determinante richiede una matrice quadrata" -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, fuzzy, c-format -msgid "'%s' must be an integer from %s to %s" -msgstr "'%s' dev'essere in '%s'" +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" + +#: dense.c:1678 sparse.c:3135 #, fuzzy, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "'%s' dev'essere in '%s'" -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "spostamento ciclico sinistro errato, j (%d) < 0" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "spostamento ciclico sinistro errato, j (%d) >= k (%d)" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "spostamento ciclico sinistro errato, k (%d) > ldx (%d)" -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "Errore sconosciuto in getGivens" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "X deve essere una matrice numerica (doppia precisione)" -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "y dev'essere una matrice numerica (doppia precisione)" -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "" "il numero di righe in y (%d) non corrisponde al numero di righe in X (%d)" -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "La routine Lapack dposv ha restituito il codice di errore %d" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "La routine Lapack %s ha restituito il codice di errore %d" -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "X dev'essere una matrice (numerica) reale" -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "tol, indicato come %g, dev'essere <= 1" -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "tol, indicato come %g, dev'essere <= 1" -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "La prima chiamata a dgeqrf ha restituito il codice di errore %d" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "La routine Lapack dtrcon ha restituito il codice di errore %d" -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "dgCMatrix_lusol richiede una matrice quadrata non vuota" +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "Il determinante richiede una matrice quadrata" -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "Le dimensioni del sistema da risolvere sono inconsistenti" +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" +msgstr "%s(): caso con rango strutturalmente carente: possibili zero sbagliati" -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "cs_lusol fallita" +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "La matrice non è quadrata" -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "dgCMatrix_qrsol(., order) richiede ordine in {0,..,3}" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "Le dimensioni del sistema da risolvere sono inconsistenti" -#: dgCMatrix.c:77 +#: dgCMatrix.c:40 #, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -"dgCMatrix_qrsol(<%d x %d>-matrix) richiede una matrice rettangolare \"alta\"" - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "cs_qrsol() fallita dentro dgCMatrix_qrsol()" - -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "dgCMatrix_cholsol richiede una matrice rettangolare \"corta, larga\"" -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "cholmod_sdmult error (rhs)" - -#: dgCMatrix.c:127 -#, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" -msgstr "cholmod_factorize fallito: stato %d, minore %d da ncol %d" - -#: dgCMatrix.c:131 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" -msgstr "cholmod_solve(CHOLMOD_A) non riuscito: stato %d, minore %d da ncol %d" - -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "cholmod_sdmult error (resid)" - -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "SuiteSparseQR_C_QR ha restituito un codice di errore" +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" +msgstr "" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, fuzzy, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "Dimensione matrice %d x %d (= %g) è troppo grande" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "L'esponenziale della matrice richiede una matrice quadrata non nulla" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp: la routine LAPACK dgebal ha restituito %d" -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp: dgetrf ha restituito il codice di errore %d" -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp: dgetrs ha restituito il codice di errore %d" -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "" "dgeMatrix_Schur: l'argomento x dev'essere una matrice quadrata non nulla" -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur: prima chiamata a dgees fallita" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur: dgees ha restituito il codice %d" -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "il minore principale dell'ordine %d non è definito positivo" - -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "il minore principale dell'ordine %d non è definito positivo" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "Routine Lapack dgetrs: il sistema è esattamente singolare" - -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "il minore principale dell'ordine %d non è definito positivo" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "%s non è una lista" -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "Il determinante richiede una matrice quadrata" - -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "%s(): caso con rango strutturalmente carente: possibili zero sbagliati" - -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "La matrice non è quadrata" - -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Le dimensioni del sistema da risolvere sono inconsistenti" - -#: factorizations.c:1612 -#, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" -msgstr "" - -#: factorizations.c:1703 +#: idz.c:467 idz.c:528 #, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "namespace 'Matrix' assente: non dovrebbe mai accadere" - -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "Namespace della matrice non determinato correttamente" - -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "" "tipo di argomento [1]='%s' deve essere una stringa di caratteri di una " "lettera" -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s' deve avere una stringa di lunghezza 1" -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s' deve avere una stringa di lunghezza 1" -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " "\"%s\"" msgstr "" -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s' deve avere una stringa di lunghezza 1" -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 -#, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s' dev'essere in '%s'" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" +msgstr "" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" +msgstr "" + +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "indice riga non valido nella posizione %d" + +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, fuzzy, c-format -msgid "replacement diagonal has incompatible type \"%s\"" -msgstr "la diagonale di ricambio ha una lunghezza errata" +msgid "'%s' is not of type \"%s\"" +msgstr "Lo slot dim non è intero" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" -msgstr "la diagonale di ricambio ha una lunghezza errata" +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "lo slot '%s' deve avere lunghezza 1" -#: products.c:155 products.c:248 +#: perm.c:86 perm.c:103 #, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "Le dimensioni di x e y sono non compatibili per %s" +msgid "'%s' is NA" +msgstr "" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" -msgstr "L'argomento y dev'essere numerico, intero o logico" +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "Lo slot dim non è intero" -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "Le matrici non sono conformi per la moltiplicazione" +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "lo slot '%s' deve avere lunghezza 1" -#: products.c:408 +#: perm.c:120 perm.c:143 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' or '%s' is NA" msgstr "" -"dimensione non conforme nella moltiplicazione matriciale di \"dtrMatrix\": " -"%d != %d" -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "dtrMatrix dev'essere quadrata" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:528 products.c:559 +#: perm.c:150 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "Dimensioni di a (%d,%d) e b (%d,%d) non conformi" +msgid "'%s' is NA or less than %s" +msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "right=TRUE non è ancora implementato __ SISTEMATEMI" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: products.c:782 products.c:807 +#, c-format +msgid "'%s' does not support complex matrices" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" -msgstr "Il determinante richiede una matrice quadrata" +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "La matrice non è quadrata" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" -msgstr "" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" +msgstr "Il determinante richiede una matrice quadrata" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "classe of 'x' in Csparse_subassign() non valida" -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "classe di 'value' in Csparse_subassign() non valida" -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "x[] <- val: val è convertito in logico per x \"%s\"" -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -920,410 +655,697 @@ "x[] <- val: val dovrebbe essere intero o logico, è convertito in intero, per " "x \"%s\"" -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "" "l'errore di programmazione in Csparse_subassign() non dovrebbe mai accadere" -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "Lo slot dim non è intero" +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 -#, fuzzy, c-format -msgid "'%s' slot does not have length %d" -msgstr "Lo slot dim deve avere lunghezza 2" +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "L'argomento dev'essere un vettore atomico numerico" + +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data' dev'essere un tipo vettore" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 +#: utils-R.c:352 #, c-format -msgid "'%s' slot contains NA" +msgid "invalid '%s' argument" +msgstr "argomento '%s' non valido" + +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "estensione della matrice non numerica" + +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "valore 'nrow' non valido (troppo largo o NA)" + +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "valore 'nrow' non valido (< 0)" + +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "valore 'ncol' non valido (troppo larga o NA)" + +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "valore 'ncol' non valido (< 0)" + +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" msgstr "" +"la lunghezza dati [%d] non è un sotto-multiplo o multiplo del numero di " +"righe [%d]" -#: validity.c:54 validity.c:976 validity.c:1009 +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" +msgstr "" +"la lunghezza dati [%d] non è un sotto-multiplo o multiplo del numero di " +"colonne [%d]" + +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "la lunghezza dei dati eccede la dimensione della matrice" + +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "specificati troppi elementi" + +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "L'argomento ij dev'essere una matrice di interi con 2 colonne" + +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "subscript 'i' fuori banda in M[ij]" + +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "subscript 'j' fuori banda in M[ij]" + +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" +msgstr "i e j devono essere vettori di interi con la medesima lunghezza" + +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 +#, fuzzy, c-format +msgid "'%s' slot does not have length %d" +msgstr "Lo slot dim deve avere lunghezza 2" + +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "Lo slot dim non è intero" -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "Dimnames[%d] non è un vettore di caratteri" -#: validity.c:101 +#: validity.c:92 #, fuzzy, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "length(Dimnames[%d]) differisce da Dim[%d] che è %d" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "lo slot x non è \"double\"" -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "Lo slot dim deve avere lunghezza 2" -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "lo slot x non è \"double\"" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "Lo slot dim deve avere lunghezza 2" - -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "lo slot 'Dim' ha lunghezza inferiore a due" - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "il primo elemento dello slot p dev'essere zero" - -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "lo slot p dev'essere non decrescente" - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "lo slot 'Dim' ha lunghezza inferiore a due" - -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "lo slot j non è crescente all'interno di una colonna" -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "lo slot j non è crescente all'interno di una colonna" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "Lo slot dim deve avere lunghezza 2" -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "uplo='U' non deve avere voci sparse sotto la diagonale" -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "uplo='L' non deve avere voci sparse sopra la diagonale" -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "uplo='U' non deve avere voci sparse sotto la diagonale" -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "Lo slot dim non è intero" + +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "Lo slot dim non è intero" + +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "lo slot 'Dim' ha lunghezza inferiore a due" + +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s' dev'essere in '%s'" + +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "lo slot 'Dim' ha lunghezza inferiore a due" + +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "lo slot j non è crescente all'interno di una colonna" + +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "lo slot 'Dim' ha lunghezza inferiore a due" + +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "lo slot j non è crescente all'interno di una colonna" + +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "Le dimensioni di x e y sono non compatibili per %s" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "Lo slot dim deve avere lunghezza 2" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "Lo slot dim deve avere lunghezza 2" -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "uplo='L' non deve avere voci sparse sopra la diagonale" -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "Lo slot dim deve avere lunghezza 2" -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "uplo='U' non deve avere voci sparse sotto la diagonale" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, fuzzy, c-format msgid "%s[%d] (%s) is not in %s" msgstr "%s non è una lista" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, fuzzy, c-format msgid "%s is not in {%s}" msgstr "%s non è una lista" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, fuzzy, c-format msgid "%s is not %d" msgstr "%s non è una lista" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "lo slot j non è crescente all'interno di una colonna" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "lo slot 'Dim' ha lunghezza inferiore a due" -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "il primo elemento dello slot p dev'essere zero" -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "lo slot j non è crescente all'interno di una colonna" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "lo slot j non è crescente all'interno di una colonna" -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "Lo slot dim non è intero" - -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "classe di oggetto a %s non valida" #, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "l'elemento diagonale %d del fattore Cholesky è assente" + +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "cholmod_factorize_p non riuscito: stato %d, minore %d di ncol %d" + +#~ msgid "cholmod_change_factor failed" +#~ msgstr "cholmod_change_factor fallito" + +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "cholmod_write_sparse ha restituito il codice di errore" + +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (back-permuted) è sperimentale" + +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC(): 'resultKind' non valido" + +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "codice a matrice sparsa complessa non ancora scritto" + +#~ msgid "Argument rho must be an environment" +#~ msgstr "L'argomento rho dev'essere un ambiente" + +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "classe di oggetto a as_cholmod_sparse non valida" + +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "oggetto non valido passato a as_cholmod_sparse" + +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "in_place cholmod_sort ha restituito un codice di errore" + +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "cholmod_sort ha restituito un codice di errore" + +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "" +#~ "chm_sparse_to_SEXP(, *): 'Rkind' non valido (codice di tipo reale)" + +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "xtype sconosciuto nell'oggetto cholmod_sparse" + +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "codice a matrice sparsa complessa non ancora scritto" + +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Simmetrici e triangolari entrambi impostati" + +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "classe di oggetto a as_cholmod_triplet non valida" + +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "" +#~ "as_cholmod_triplet(): non è possibile riallocare per diagU2N() interno" + +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "xtype sconosciuto nell'oggetto cholmod_triplet" + +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "classe di oggetto a as_cholmod_dense non valida" + +#, c-format +#~ msgid "" +#~ "chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +#~ msgstr "" +#~ "chm_transpose_dense(ans, x) non ancora implementato per %s diverso da%s" + +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "Non è possibile inizializzare il colmod: codice di errore %d" + +#~ msgid "unknown 'Rkind'" +#~ msgstr "'Rkind' sconosciuto" + +#~ msgid "unknown xtype" +#~ msgstr "xtype sconosciuto" + +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "il codice per cholmod_dense con buchi non ancora scritto" + +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "non sappiamo se una matrice di schemi densi abbia senso" + +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "classe di oggetto a as_cholmod_factor non valida" + +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "fallimento in as_cholmod_factor" + +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "La fattorizzazione CHOLMOD non è andata a buon fine" + +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "f->xtype di %d non riconosciuta" + +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U (): nrow =%d, ncol =%d" + +#, c-format +#~ msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#~ msgstr "chm_diagN2U (x, uploT =%d): uploT dovrebbe essere +-1" + +#~ msgid "dgCMatrix_lusol requires a square, non-empty matrix" +#~ msgstr "dgCMatrix_lusol richiede una matrice quadrata non vuota" + +#~ msgid "Dimensions of system to be solved are inconsistent" +#~ msgstr "Le dimensioni del sistema da risolvere sono inconsistenti" + +#~ msgid "cs_lusol failed" +#~ msgstr "cs_lusol fallita" + +#~ msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#~ msgstr "dgCMatrix_qrsol(., order) richiede ordine in {0,..,3}" + +#, c-format +#~ msgid "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) richiede una matrice rettangolare " +#~ "\"alta\"" + +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "cs_qrsol() fallita dentro dgCMatrix_qrsol()" + +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_cholsol richiede una matrice rettangolare \"corta, larga\"" + +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "cholmod_sdmult error (rhs)" + +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_factorize fallito: stato %d, minore %d da ncol %d" + +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "cholmod_solve(CHOLMOD_A) non riuscito: stato %d, minore %d da ncol %d" + +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "cholmod_sdmult error (resid)" + +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "SuiteSparseQR_C_QR ha restituito un codice di errore" + +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "Routine Lapack dgetrs: il sistema è esattamente singolare" + +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "il minore principale dell'ordine %d non è definito positivo" + +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "namespace 'Matrix' assente: non dovrebbe mai accadere" + +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "Namespace della matrice non determinato correttamente" + +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x): x non è una valida (a parte l'ordinamento) CsparseMatrix" + +#, c-format +#~ msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" +#~ msgstr "" +#~ "Non è possibile avere Rk_x/Rk_y in Csparse_%s(), per piacere riportatelo" + +#, c-format +#~ msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" +#~ msgstr "" +#~ "chm_MOD_xtype() non ha avuto successo in Csparse_%s(), per piacere, " +#~ "segnalatelo" + +#, c-format +#~ msgid "the number of columns differ in R_rbind2_vector: %d != %d" +#~ msgstr "il numero di colonne differisce in R_rbind2_vector: %d != %d" + +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "l'argomento csp_eye n dev'essere positivo" + +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "classe di 'x' in Matrix_as_cs(a, x) non valida" + +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "classe di oggetto a %s non valida" + +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "matrice cs non compatibile con la classe '%s'" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "Classe inappropriata cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "Classe inappropriata cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "Le dimensioni di x e y sono non compatibili per %s" + +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "L'argomento y dev'essere numerico, intero o logico" + +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "Le matrici non sono conformi per la moltiplicazione" + +#, c-format +#~ msgid "" +#~ "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +#~ msgstr "" +#~ "dimensione non conforme nella moltiplicazione matriciale di " +#~ "\"dtrMatrix\": %d != %d" + +#~ msgid "dtrMatrix must be square" +#~ msgstr "dtrMatrix dev'essere quadrata" + +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "Dimensioni di a (%d,%d) e b (%d,%d) non conformi" + +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "right=TRUE non è ancora implementato __ SISTEMATEMI" + +#, c-format #~ msgid "cholmod_change_factor failed with status %d" #~ msgstr "cholmod_change_factor fallito con status %d" @@ -1630,9 +1652,6 @@ #~ msgid "dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE" #~ msgstr "dgcMatrix_QR(*, keep_dimnames = NA): NA presi come TRUE" -#~ msgid "cs_qr failed" -#~ msgstr "cs_qr fallita" - #~ msgid "LU decomposition applies only to square matrices" #~ msgstr "La decomposizione LU si applica solo alle matrici quadrate" diff -Nru rmatrix-1.6-1.1/po/ko.po rmatrix-1.6-5/po/ko.po --- rmatrix-1.6-1.1/po/ko.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/ko.po 2023-11-03 01:34:40.000000000 +0000 @@ -15,7 +15,7 @@ msgstr "" "Project-Id-Version: Matrix 1.1-3\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2015-07-15 17:14-0600\n" "Last-Translator:Chel Hee Lee \n" "Language-Team: Chel Hee Lee \n" @@ -25,892 +25,632 @@ "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "콜레스키 분해(Cholesky factor)의 대각요소 %d를 찾을 수 없습니다" - -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "cholmod_factorize_p failed: status %d, minor %d of ncol %d" - -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "cholmod_change_factor failed" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "cs_qr 실패" -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "" +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "" +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "'%s' 인자는 유효하지 않습니다" -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "쓰기 위하여 파일 \"%s\"을 여는데 실패했습니다." -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "cholmod_write_sparse가 에러코드를 반환하였습니다." - -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (back-permuted)는 실험단계에 있습니다" - -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC(): 유효한 'resultKind'가 아닙니다" - -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "'%s' 인자는 유효하지 않습니다" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "%d번째 위치에서 유효하지 않은 행인덱스가 있습니다" - -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." - -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "슬롯 '%s'의 길이는 반드시 1이어야 합니다." - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." - -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "슬롯 '%s'의 길이는 반드시 1이어야 합니다." - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "인자 ij는 반드시 2개의 열을 가진 정수형 행렬이어야 합니다." - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "첨자 'i'가 M[ij]내에 존재하지 않습니다." - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "첨자 'j'가 M[ij]내에 존재하지 않습니다." - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." msgstr "" -"i와 j는 반드시 같은 길이를 가지는 정수형 벡터(integer vectors)이어야 합니다." - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data'는 반드시 벡터형(vector type)이어야 합니다." - -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "'%s' 인자는 유효하지 않습니다" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "non-numeric matrix extent" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "'nrow'의 값이 너무 크거나 NA이므로 올바르지 않습니다." -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "'nrow'의 값이 0 보다 작으므로 올바르지 않습니다." - -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "'ncol'의 값이 너무 크거나 NA이므로 올바르지 않습니다." +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "'ncol'의 값이 0보다 작으므로 올바르지 않습니다." +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: Mutils.c:1444 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" -msgstr "데이터의 길이[%d]가 행의 개수[%d]의 약수 또는 배수가 아닙니다" +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "슬롯 p의 첫번째 요소는 반드시 0 이어야 합니다. " -#: Mutils.c:1449 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" -msgstr "데이터의 길이[%d]가 열의 개수[%d]의 약수 또는 배수가 아닙니다" - -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "데이터의 길이(data length)가 행렬의 크기(size of matrix)를 초과합니다." +msgid "'%s' slot contains NA" +msgstr "" -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "너무 많은 요소들이 지정되었습니다" +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "슬롯 p는 반드시 감소하지 않아야(non-decreasing) 합니다." -#: Mutils.c:1530 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" +msgid "first differences of '%s' slot exceed %s" msgstr "" -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "인자는 반드시 수치형과 같은 기본형 벡터이어야합니다" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" -msgstr "" +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" -msgstr "" +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "dimensions cannot exceed %s" +msgid "wrong '%s'" msgstr "" -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" +#: chm_common.c:481 cholmod-etc.c:190 +#, c-format +msgid "n+1 would overflow type \"%s\"" msgstr "" -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "complex sparse matrix code not yet written" +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "the leading minor of order %d is not positive definite" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 -#, c-format -msgid "%s cannot exceed %s" -msgstr "" +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "the leading minor of order %d is not positive definite" -#: bind.c:848 -msgid "should never happen ..." +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "인자 rho는 반드시 인바이런먼트(environment)이어야 합니다." - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "as_cholmod_sparse에 전달된 객체가 올바르지 않습니다." - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "as_cholmod_sparse에 전달된 객체가 올바르지 않습니다." - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "in_place cholmod_sort returned an error code" - -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "에러코드가 cholmod_sort로부터 반환되었습니다." - -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" -msgstr "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" - -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "cholmod_sparse 객체에 사용할 수 있는 xtype이 아닙니다." - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "complex sparse matrix code not yet written" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Symmetric and triangular both set" - -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "as_cholmod_triplet에 전달된 객체의 클래스가 올바르지 않습니다." - -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" -msgstr "as_cholmod_triplet(): could not reallocate for internal diagU2N()" - -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "cholmod_triplet 객체에서 사용할 수 있는 xtype이 아닙니다." - -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "as_cholmod_dense에 전달된 객체의 클래스가 올바르지 않습니다." - -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Cholmod error '%s' at file %s, line %d" -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Cholmod warning '%s' at file %s, line %d" -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "cholmod를 초기화 할 수 없습니다: 에러코드 %d" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "사용할 수 있는 'Rkind'이 아닙니다." - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "사용할 수 있는 xtype이 아닙니다." - -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "code for cholmod_dense with holes not yet written" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "don't know if a dense pattern matrix makes sense" +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "invalid class of object to as_cholmod_factor" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" +msgstr "" -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "failure in as_cholmod_factor" +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "CHOLMOD factorization was unsuccessful" +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "f->xtype of %d not recognized" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U(): nrow=%d, ncol=%d" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" +msgstr "" -#: chm_common.c:1283 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" -msgstr "chm_diagN2U(x, uploT = %d): uploT은 반드시 1 또는 -1이어야 합니다" - -#: coerce.c:60 -#, fuzzy, c-format -msgid "attempt to construct %s or %s from non-square matrix" -msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." - -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 -#, fuzzy, c-format -msgid "invalid '%s' to %s()" -msgstr "'%s' 인자는 유효하지 않습니다" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" +msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "csp_eye의 인자 n은 반드시 양수이어야 합니다" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "Matrix_as_cs(a, x)에 입력된 'x'의 클래스가 올바르지 않습니다." +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, fuzzy, c-format +msgid "'%s' must be an integer from %s to %s" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "invalid class of object to %s" +#: dense.c:218 sparse.c:598 +#, fuzzy, c-format +msgid "'%s' must be less than or equal to '%s'" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: cs_utils.c:147 +#: dense.c:428 sparse.c:1069 #, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "cs matrix not compatible with class '%s'" +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" msgstr "" -"Matrix_css_to_SEXP(S, cl, ..)에 입력된 cl='%s'은 올바른 클래스가 아닙니다." -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." + +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" msgstr "" -"Matrix_csn_to_SEXP(S, cl, ..)에 입력된 cl='%s'는 올바른 클래스가 아닙니다." -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, fuzzy, c-format -msgid "'%s' must be an integer from %s to %s" -msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:1678 sparse.c:3135 #, fuzzy, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "incorrect left cyclic shift, j (%d) < 0" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "incorrect left cyclic shift, j (%d) >= k (%d)" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "incorrect left cyclic shift, k (%d) > ldx (%d)" -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "getGivens에서 알 수 없는 에러가 발생했습니다" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "X는 반드시 double precision을 가진 수치형 행렬이어야 합니다." -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "y는 반드시 double precision을 가진 수치형 행렬이어야 합니다." -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "y가 가진 행의 개수 (%d)가 X가 가진 행의 개수 (%d)와 일치하지 않습니다." -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "다음의 에러코드가 Lapack 루틴 dposv으로부터 반환되었습니다: %d" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "에러코드 %2$d는 Lapack 루틴 %1$s로부터 얻어졌습니다." -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "X는 반드시 실수(real)형 숫자를 가진 행렬이어야 합니다." -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "tol의 값은 1보다 작거나 같아야 하는데 %g를 가지고 있습니다." -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "tol의 값은 1보다 작거나 같아야 하는데 %g를 가지고 있습니다." -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "dgeqrf에 첫번째 호출로부터 다음과 같은 에러코드가 반환되었습니다: %d" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "에러코드 %d가 Lapack 루틴 dtrcon으로부터 반환되었습니다." -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "" -"dgCMatrix_lusol은 정방(square)이며 비어있지 않은(non-empty) 행렬을 필요로 합" -"니다." +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "Dimensions of system to be solved are inconsistent" +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" +msgstr "%s(): 구조적으로 계수에 문제가 있는 경우입니다: possibly WRONG zeros" -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "cs_lusol 실패" +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "정방행렬이 아닙니다." -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "Dimensions of system to be solved are inconsistent" -#: dgCMatrix.c:77 +#: dgCMatrix.c:40 #, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -"dgCMatrix_qrsol(<%d x %d>-matrix)은 'tall' 사각행렬(rectangular matrix)이 필" -"요합니다." - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "dgCMatrix_qrsol()의 내에서 cs_qrsol()이 실패했습니다" - -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "cholmod_sdmult error (rhs)" - -#: dgCMatrix.c:127 -#, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" -msgstr "cholmod_factorize 실패: 상태 %d, minor %d from ncol %d" - -#: dgCMatrix.c:131 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" -msgstr "cholmod_solve (CHOLMOD_A) 실패: 상태 %d, minor %d from ncol %d" - -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "cholmod_sdmult error (resid)" - -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "에러코드가 SuiteSparseQR_C_QR로부터 반환되었습니다." +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" +msgstr "" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "행렬의 지수(exponential)은 정방이고 non-null인 행렬이어야 합니다" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp: %d가 LAPACK 루틴 dgebal로부터 반환되었습니다." -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp: 에러코드 %d가 dgetrf로부터 반환되었습니다." -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp: 에러코드 %d가 dgetrs로부터 반환되었습니다." -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "" "dgeMatrix_Schur: 인자 x는 반드시 null이 아닌 정방(square)행렬이어야 합니다." -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur: dgees로의 첫번째 호출에 실패했습니다" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur: 코드 %d가 dgees로부터 반환되었습니다." -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "the leading minor of order %d is not positive definite" - -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "the leading minor of order %d is not positive definite" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "Lapack 루틴 dgetrs: 시스템(system)이 정확하게 특이(singular)합니다." - -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "the leading minor of order %d is not positive definite" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "정방행렬이 아닙니다." -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." - -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "%s(): 구조적으로 계수에 문제가 있는 경우입니다: possibly WRONG zeros" - -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "정방행렬이 아닙니다." - -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Dimensions of system to be solved are inconsistent" - -#: factorizations.c:1612 -#, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" -msgstr "" - -#: factorizations.c:1703 +#: idz.c:467 idz.c:528 #, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "" -"'Matrix' 네임스페이스(namespace)를 찾을 수 없습니다. 반드시 존재해야 합니다 " - -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "올바르게 정의된 Matrix 네임스페이스(namespace)가 아닙니다" - -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "인자 type[1]='%s'는 반드시 길이가 1인 문자이어야 합니다." -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s'는 반드시 길이가 1인 문자열(string)이어야 합니다." -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s'는 반드시 길이가 1인 문자열(string)이어야 합니다." -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " "\"%s\"" msgstr "" -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s'는 반드시 길이가 1인 문자열(string)이어야 합니다." -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 -#, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." - -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 -#, c-format -msgid "replacement diagonal has incompatible type \"%s\"" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" msgstr "" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" msgstr "" -#: products.c:155 products.c:248 -#, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "x와 y의 차원정보가 %s와 일치하지 않습니다." +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "%d번째 위치에서 유효하지 않은 행인덱스가 있습니다" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" -msgstr "인자 y는 반드시 수치형, 정수형, 또는 논리형이어야 합니다." +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 +#, fuzzy, c-format +msgid "'%s' is not of type \"%s\"" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "곱셈연산을 할 수 있는 행렬들이 아닙니다" +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "슬롯 '%s'의 길이는 반드시 1이어야 합니다." -#: products.c:408 +#: perm.c:86 perm.c:103 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' is NA" msgstr "" -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "dtrMatrix는 정방행렬이 아닙니다." +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." + +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "슬롯 '%s'의 길이는 반드시 1이어야 합니다." -#: products.c:528 products.c:559 +#: perm.c:120 perm.c:143 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "a (%d,%d)와 b (%d,%d)의 크기가 서로 일치하지 않습니다." +msgid "'%s' or '%s' is NA" +msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "right=TRUE의 경우는 아직 구현되지 않았습니다 __ FIXME" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: perm.c:150 +#, c-format +msgid "'%s' is NA or less than %s" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" -msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: products.c:782 products.c:807 +#, c-format +msgid "'%s' does not support complex matrices" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "정방행렬이 아닙니다." + +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" +msgstr "행렬식(determinant)를 얻기 위해서는 정방행렬을 사용해야 합니다." + +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "Csparse_subassign()에서 사용되는 'x'의 클래스가 올바르지 않습니다." -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "Csparse_subassign()에서 사용되는 'value'의 클래스가 올바르지 않습니다." -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "x[] <- val: val is coerced to logical for \"%s\" x" -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -919,411 +659,669 @@ "x[] <- val: val should be integer or logical, is coerced to integer, for " "\"%s\" x" -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "" "Csparse_subassign()를 사용 중 발생하지 말아야 하는 프로그래밍 에러" "(programming error)가 발견되었습니다." -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 -#, fuzzy, c-format -msgid "'%s' slot does not have length %d" -msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "인자는 반드시 수치형과 같은 기본형 벡터이어야합니다" + +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data'는 반드시 벡터형(vector type)이어야 합니다." -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 +#: utils-R.c:352 #, c-format -msgid "'%s' slot contains NA" +msgid "invalid '%s' argument" +msgstr "'%s' 인자는 유효하지 않습니다" + +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "non-numeric matrix extent" + +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "'nrow'의 값이 너무 크거나 NA이므로 올바르지 않습니다." + +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "'nrow'의 값이 0 보다 작으므로 올바르지 않습니다." + +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "'ncol'의 값이 너무 크거나 NA이므로 올바르지 않습니다." + +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "'ncol'의 값이 0보다 작으므로 올바르지 않습니다." + +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgstr "데이터의 길이[%d]가 행의 개수[%d]의 약수 또는 배수가 아닙니다" + +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" +msgstr "데이터의 길이[%d]가 열의 개수[%d]의 약수 또는 배수가 아닙니다" + +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "데이터의 길이(data length)가 행렬의 크기(size of matrix)를 초과합니다." + +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "너무 많은 요소들이 지정되었습니다" + +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "인자 ij는 반드시 2개의 열을 가진 정수형 행렬이어야 합니다." + +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "첨자 'i'가 M[ij]내에 존재하지 않습니다." + +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "첨자 'j'가 M[ij]내에 존재하지 않습니다." + +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" msgstr "" +"i와 j는 반드시 같은 길이를 가지는 정수형 벡터(integer vectors)이어야 합니다." -#: validity.c:54 validity.c:976 validity.c:1009 +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 +#, fuzzy, c-format +msgid "'%s' slot does not have length %d" +msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." + +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "'s1'과 's2'는 반드시 \"character\"형 벡터이어야 합니다." -#: validity.c:101 +#: validity.c:92 #, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." - -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "슬롯 p의 첫번째 요소는 반드시 0 이어야 합니다. " - -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "슬롯 p는 반드시 감소하지 않아야(non-decreasing) 합니다." - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." - -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "uplo='U'의 경우에는 어떠한 값들도 대각의 아랫부분에 있어서는 안됩니다." -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "uplo='L'의 경우는 어떠한 값들도 대각의 윗부분에 있어서는 안됩니다." -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "uplo='U'의 경우에는 어떠한 값들도 대각의 아랫부분에 있어서는 안됩니다." -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." + +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." + +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." + +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s'는 반드시 '%s'내에 있어야 합니다." + +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." + +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" + +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." + +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" + +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "x와 y의 차원정보가 %s와 일치하지 않습니다." -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "uplo='L'의 경우는 어떠한 값들도 대각의 윗부분에 있어서는 안됩니다." -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "Dim 슬롯(slot)의 길이는 반드시 2이어야 합니다." -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "uplo='U'의 경우에는 어떠한 값들도 대각의 아랫부분에 있어서는 안됩니다." -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, c-format msgid "%s[%d] (%s) is not in %s" msgstr "" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, c-format msgid "%s is not in {%s}" msgstr "" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, c-format msgid "%s is not %d" msgstr "" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "'Dim'은 2 보다 짧은 슬롯의 길이를 가지고 있습니다." -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "슬롯 p의 첫번째 요소는 반드시 0 이어야 합니다. " -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "슬롯 j는 열(column)내에서 증가하지 않습니다" -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "x 슬롯(slot)은 반드시 \"double\"형 숫자(numeric)이어야 합니다." - -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "invalid class of object to %s" #, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "콜레스키 분해(Cholesky factor)의 대각요소 %d를 찾을 수 없습니다" + +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "cholmod_factorize_p failed: status %d, minor %d of ncol %d" + +#~ msgid "cholmod_change_factor failed" +#~ msgstr "cholmod_change_factor failed" + +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "cholmod_write_sparse가 에러코드를 반환하였습니다." + +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (back-permuted)는 실험단계에 있습니다" + +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC(): 유효한 'resultKind'가 아닙니다" + +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "complex sparse matrix code not yet written" + +#~ msgid "Argument rho must be an environment" +#~ msgstr "인자 rho는 반드시 인바이런먼트(environment)이어야 합니다." + +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "as_cholmod_sparse에 전달된 객체가 올바르지 않습니다." + +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "as_cholmod_sparse에 전달된 객체가 올바르지 않습니다." + +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "in_place cholmod_sort returned an error code" + +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "에러코드가 cholmod_sort로부터 반환되었습니다." + +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" + +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "cholmod_sparse 객체에 사용할 수 있는 xtype이 아닙니다." + +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "complex sparse matrix code not yet written" + +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Symmetric and triangular both set" + +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "as_cholmod_triplet에 전달된 객체의 클래스가 올바르지 않습니다." + +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "as_cholmod_triplet(): could not reallocate for internal diagU2N()" + +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "cholmod_triplet 객체에서 사용할 수 있는 xtype이 아닙니다." + +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "as_cholmod_dense에 전달된 객체의 클래스가 올바르지 않습니다." + +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "cholmod를 초기화 할 수 없습니다: 에러코드 %d" + +#~ msgid "unknown 'Rkind'" +#~ msgstr "사용할 수 있는 'Rkind'이 아닙니다." + +#~ msgid "unknown xtype" +#~ msgstr "사용할 수 있는 xtype이 아닙니다." + +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "code for cholmod_dense with holes not yet written" + +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "don't know if a dense pattern matrix makes sense" + +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "invalid class of object to as_cholmod_factor" + +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "failure in as_cholmod_factor" + +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "CHOLMOD factorization was unsuccessful" + +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "f->xtype of %d not recognized" + +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U(): nrow=%d, ncol=%d" + +#, c-format +#~ msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#~ msgstr "chm_diagN2U(x, uploT = %d): uploT은 반드시 1 또는 -1이어야 합니다" + +#~ msgid "dgCMatrix_lusol requires a square, non-empty matrix" +#~ msgstr "" +#~ "dgCMatrix_lusol은 정방(square)이며 비어있지 않은(non-empty) 행렬을 필요로 " +#~ "합니다." + +#~ msgid "Dimensions of system to be solved are inconsistent" +#~ msgstr "Dimensions of system to be solved are inconsistent" + +#~ msgid "cs_lusol failed" +#~ msgstr "cs_lusol 실패" + +#~ msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#~ msgstr "dgCMatrix_qrsol(., order) needs order in {0,..,3}" + +#, c-format +#~ msgid "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix)은 'tall' 사각행렬(rectangular matrix)이 " +#~ "필요합니다." + +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "dgCMatrix_qrsol()의 내에서 cs_qrsol()이 실패했습니다" + +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" + +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "cholmod_sdmult error (rhs)" + +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_factorize 실패: 상태 %d, minor %d from ncol %d" + +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_solve (CHOLMOD_A) 실패: 상태 %d, minor %d from ncol %d" + +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "cholmod_sdmult error (resid)" + +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "에러코드가 SuiteSparseQR_C_QR로부터 반환되었습니다." + +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "Lapack 루틴 dgetrs: 시스템(system)이 정확하게 특이(singular)합니다." + +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "the leading minor of order %d is not positive definite" + +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "" +#~ "'Matrix' 네임스페이스(namespace)를 찾을 수 없습니다. 반드시 존재해야 합니" +#~ "다 " + +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "올바르게 정의된 Matrix 네임스페이스(namespace)가 아닙니다" + +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" + +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "csp_eye의 인자 n은 반드시 양수이어야 합니다" + +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "Matrix_as_cs(a, x)에 입력된 'x'의 클래스가 올바르지 않습니다." + +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "invalid class of object to %s" + +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "cs matrix not compatible with class '%s'" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "" +#~ "Matrix_css_to_SEXP(S, cl, ..)에 입력된 cl='%s'은 올바른 클래스가 아닙니다." + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "" +#~ "Matrix_csn_to_SEXP(S, cl, ..)에 입력된 cl='%s'는 올바른 클래스가 아닙니다." + +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "x와 y의 차원정보가 %s와 일치하지 않습니다." + +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "인자 y는 반드시 수치형, 정수형, 또는 논리형이어야 합니다." + +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "곱셈연산을 할 수 있는 행렬들이 아닙니다" + +#~ msgid "dtrMatrix must be square" +#~ msgstr "dtrMatrix는 정방행렬이 아닙니다." + +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "a (%d,%d)와 b (%d,%d)의 크기가 서로 일치하지 않습니다." + +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "right=TRUE의 경우는 아직 구현되지 않았습니다 __ FIXME" + +#, c-format #~ msgid "cholmod_change_factor failed with status %d" #~ msgstr "cholmod_change_factor가 실패했으며 상태 %d를 가집니다" @@ -1605,9 +1603,6 @@ #~ msgid "cs_sqr failed" #~ msgstr "cs_sqr 실패" -#~ msgid "cs_qr failed" -#~ msgstr "cs_qr 실패" - #~ msgid "LU decomposition applies only to square matrices" #~ msgstr "LU 분해(decomposition)은 오로지 정방행렬에만 적용됩니다." diff -Nru rmatrix-1.6-1.1/po/lt.po rmatrix-1.6-5/po/lt.po --- rmatrix-1.6-1.1/po/lt.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/lt.po 2023-11-03 01:34:40.000000000 +0000 @@ -7,7 +7,7 @@ msgstr "" "Project-Id-Version: Matrix 1.3-3\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2021-02-25 14:30+0200\n" "Last-Translator: Gabrielė Stupurienė \n" "Language-Team: none\n" @@ -19,887 +19,632 @@ "n%10>=2 && n%10<=9 && (n%100<11 || n%100>19) ? 1 : 2);\n" "X-Generator: Poedit 2.4.2\n" -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "trūksta Choleskio faktoriaus įstrižainės elemento %d" - -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "cholmod_factorize_p nepavyko: būsena %d, nedideli %d iš ncol %d" - -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "cholmod_change_factor nepavyko" - -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "Csparse_sort(x): x nėra galiojantis (išskyrus rūšiavimą) CsparseMatrix" +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "cs_qr nepavyko" -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "Neįmanoma Rk_x/Rk_y, esanti Csparse_%s(), prašome pranešti" +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "laukas j nedidėja stulpelio viduje" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "chm_MOD_xtype() nebuvo sėkmingas Csparse_%s(), prašome pranešti" +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "netinkamas argumentas '%s'" -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "nepavyko atidaryti failo \"%s\" rašymui" -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "cholmod_write_sparse grąžintas klaidos kodas" - -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (atgalinis) yra eksperimentinis" - -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC(): netinkamas 'resultKind'" - -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "netinkamas argumentas '%s'" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "neleistinas eilutės indeksas padėtyje %d" - -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "Dim laukas nėra sveikasis skaičius" - -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "'%s' lauko ilgis turi būti 1" - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "Dim laukas nėra sveikasis skaičius" - -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "'%s' lauko ilgis turi būti 1" - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "Argumentas ij turi būti 2 stulpelių sveikųjų skaičių matrica" - -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "apatinis indeksas 'i' už M[ij] ribų" - -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "apatinis indeksas 'j' už M[ij] ribų" - -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" -msgstr "i ir j turi būti to paties ilgio sveikieji vektoriai" - -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data' turi būti vektoriaus tipo" - -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "netinkamas argumentas '%s'" - -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "neskaitinės matricos dydis" - -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "neleistina 'nrow' reikšmė (per didelė arba NA)" - -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "neleistina 'nrow' reikšmė (< 0)" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." +msgstr "" -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "neleistina 'ncol' reikšmė (per didelė arba NA)" +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "Dim laukas nėra sveikasis skaičius" -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "neleistina 'ncol' reikšmė (< 0)" +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "Dim laukas turi būti 2 ilgio" -#: Mutils.c:1444 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" -msgstr "duomenų ilgis [%d] nėra eilučių skaičiaus pogrupis ar kartotinis [%d]" +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "pirmasis lauko p elementas turi būti lygus nuliui" -#: Mutils.c:1449 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" +msgid "'%s' slot contains NA" msgstr "" -"duomenų ilgis [%d] nėra stulpelių skaičiaus pogrupis ar kartotinis [%d]" - -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "duomenų ilgis viršija matricos dydį" -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "nurodyta per daug elementų" +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "laukas p turi būti nemažėjantis" -#: Mutils.c:1530 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" -msgstr "stulpelių skaičius skiriasi R_rbind2_vector: %d != %d" - -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "Argumentas turi būti skaitinis atominis vektorius" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" -msgstr "" - -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" +msgid "first differences of '%s' slot exceed %s" msgstr "" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 -#, c-format -msgid "dimensions cannot exceed %s" -msgstr "" +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 +#, c-format +msgid "wrong '%s'" msgstr "" -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "sudėtinis sparse matricos kodas dar neįrašytas" +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "Dim laukas nėra sveikasis skaičius" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 +#: chm_common.c:481 cholmod-etc.c:190 #, c-format -msgid "%s cannot exceed %s" +msgid "n+1 would overflow type \"%s\"" msgstr "" -#: bind.c:848 -msgid "should never happen ..." -msgstr "" - -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "Argumentas rho turi būti aplinka" - -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" -msgstr "netinkama objekto klasė į as_cholmod_sparse" - -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "neleistinas objektas perduotas į as_cholmod_sparse" - -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "in_place cholmod_sort grąžino klaidos kodą" +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "cholmod_sort grąžino klaidos kodą" +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -"chm_sparse_to_SEXP (, *): neteisingas 'Rkind' (tikrasis rūšies kodas)" - -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "nežinomas xtype cholmod_sparse objekte" - -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "sudėtinis sparse matricos kodas dar neįrašytas" - -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Simetriškas ir trikampis abiejų rinkinys" - -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "netinkama objekto klasė į as_cholmod_triplet" - -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" -msgstr "as_cholmod_triplet(): nepavyko perskirstyti vidiniam diagU2N()" - -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "nežinomas xtype cholmod_triplet objekte" - -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "netinkama objekto klasė į as_cholmod_dense" -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" -msgstr "chm_transpose_dense(ans, x) dar neįgyvendintas dėl %s skiriasi nuo %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" +msgstr "" -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Cholmod klaida '%s' faile %s, eilutė %d" -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Cholmod įspėjimas '%s' faile %s, eilutė %d" -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "Neįmanoma inicijuoti cholmod: klaidos kodas %d" - -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "nežinomas 'Rkind'" - -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "nežinomas xtype" - -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "cholmod_dense kodas su dar neįrašytais tarpais" - -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "nežinau, ar tankio modelio matrica turi prasmę" +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "Determinantui reikia kvadratinės matricos" -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" -msgstr "netinkama objekto klasė į as_cholmod_factor" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" +msgstr "" -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "klaida, esanti as_cholmod_factor" +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s' turi būti '%s'" -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "CHOLMOD faktoringas buvo nesėkmingas" +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s' turi būti '%s'" -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "neatpažintas %d f->xtype" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U(): nrow=%d, ncol=%d" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" +msgstr "" -#: chm_common.c:1283 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" -msgstr "chm_diagN2U(x, uploT = %d): uploT turi būti +- 1" - -#: coerce.c:60 -#, fuzzy, c-format -msgid "attempt to construct %s or %s from non-square matrix" -msgstr "Determinantui reikia kvadratinės matricos" - -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 -#, fuzzy, c-format -msgid "invalid '%s' to %s()" -msgstr "netinkamas argumentas '%s'" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" +msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "Determinantui reikia kvadratinės matricos" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "Determinantui reikia kvadratinės matricos" -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "csp_eye argumentas n turi būti teigiamas" +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s' turi būti '%s'" -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "netinkama 'x' klasė, esanti Matrix_as_cs(a, x)" +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 +#, fuzzy, c-format +msgid "'%s' must be an integer from %s to %s" +msgstr "'%s' turi būti '%s'" -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "netinkama objekto klasė į %s" +#: dense.c:218 sparse.c:598 +#, fuzzy, c-format +msgid "'%s' must be less than or equal to '%s'" +msgstr "'%s' turi būti '%s'" -#: cs_utils.c:147 -#, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "cs matrica nesuderinama su klase '%s'" +#: dense.c:428 sparse.c:1069 +#, fuzzy, c-format +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "keitimo įstrižainės ilgis neteisingas" -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" -msgstr "Netinkama klasė cl ='%s', esanti Matrix_css_to_SEXP(S, cl, ..)" +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" +msgstr "keitimo įstrižainės ilgis neteisingas" -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" -msgstr "Netinkama klasė cl ='%s', esanti Matrix_csn_to_SEXP(S, cl, ..)" +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "Determinantui reikia kvadratinės matricos" -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 -#, fuzzy, c-format -msgid "'%s' must be an integer from %s to %s" -msgstr "'%s' turi būti '%s'" +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" + +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" -#: dense.c:207 sparse.c:516 +#: dense.c:1678 sparse.c:3135 #, fuzzy, c-format -msgid "'%s' must be less than or equal to '%s'" +msgid "'%s' must be %d or %d" msgstr "'%s' turi būti '%s'" -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "neteisingas kairysis ciklinis pastūmimas, j (%d) < 0" -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "neteisingas kairysis ciklinis pastūmimas, j (%d) >= k (%d)" -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "neteisingas kairysis ciklinis pastūmimas, k (%d) > ldx (%d)" -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "Nežinoma getGivens klaida" -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "X turi būti skaitinė (dvigubo tikslumo) matrica" -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "y turi būti skaitinė (dvigubo tikslumo) matrica" -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "" "eilučių skaičius, esantis y (%d) neatitinka eilučių skaičiaus, esančio X (%d)" -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "Lapack programa dposv grąžino klaidos kodą %d" -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "Lapack programa %s grąžino klaidos kodą %d" -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "X turi būti realioji (skaitinė) matrica" -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "tol, kaip %g, turi būti < = 1" -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "tol, kaip %g, turi būti < = 1" -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "Pirmasis iškvietimas į dgeqrf grąžino klaidos kodą %d" -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "Lapack programa dtrcon grąžino klaidos kodą %d" -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "dgCMatrix_lusol reikia kvadratinės, netuščios matricos" +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "Determinantui reikia kvadratinės matricos" -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" -msgstr "Sistemos, kurią reikia išspręsti, matmenys yra nenuoseklūs" +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" +msgstr "%s(): struktūrinio rango deficito atvejis: galbūt WRONG nuliai" -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "cs_lusol nepavyko" +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "Matrica nėra kvadratinė" -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "dgCMatrix_qrsol(., tvarka) reikia tvarkos {0,..,3}" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" +msgstr "Sistemos, kurią reikia išspręsti, matmenys yra nenuoseklūs" -#: dgCMatrix.c:77 +#: dgCMatrix.c:40 #, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -"dgCMatrix_qrsol(<%d x %d>-matrix) reikalauja 'tall' stačiakampės matricos" - -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "cs_qrsol() nepavyko viduje dgCMatrix_qrsol ()" -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "dgCMatrix_cholsol reikia 'short, wide' stačiakampės matricos" - -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "cholmod_sdmult klaida (rhs)" - -#: dgCMatrix.c:127 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" -msgstr "cholmod_factorize nepavyko: būsena %d, nedideli %d iš ncol %d" - -#: dgCMatrix.c:131 -#, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" -msgstr "cholmod_solve (CHOLMOD_A) nepavyko: būsena %d, nedideli %d iš ncol %d" - -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "cholmod_sdmult klaida (resid)" - -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "SuiteSparseQR_C_QR grąžino klaidos kodą" +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" +msgstr "" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, fuzzy, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "Matricos matmenys %d x %d (= %g) yra per dideli" -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "Matricos eksponentė reikalauja kvadratinės, ne nulinės matricos" -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp: LAPACK programa dgebal grąžino %d" -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp: dgetrf grąžino klaidos kodą %d" -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp: dgetrs grąžino klaidos kodą %d" -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "dgeMatrix_Schur: argumentas x turi būti ne nulinė kvadratinė matrica" -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur: pirmasis iškvietimas į dgees nepavyko" -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur: dgees grąžintas kodas %d" -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" - -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "Lapack programa dgetrs: sistema yra tiksliai singuliari" - -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "%s nėra sąrašas" -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "Determinantui reikia kvadratinės matricos" - -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "%s(): struktūrinio rango deficito atvejis: galbūt WRONG nuliai" - -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "Matrica nėra kvadratinė" - -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Sistemos, kurią reikia išspręsti, matmenys yra nenuoseklūs" - -#: factorizations.c:1612 -#, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" -msgstr "" - -#: factorizations.c:1703 +#: idz.c:467 idz.c:528 #, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "trūksta 'Matrix' vardų srities: niekada neturėtų įvykti" - -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "Matricos vardų sritis nustatyta neteisingai" - -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "argumentas type[1]='%s' turi būti vienos raidės simbolio eilutė" -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s' eilutės ilgis turi būti 1" -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s' eilutės ilgis turi būti 1" -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " "\"%s\"" msgstr "" -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s' eilutės ilgis turi būti 1" -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 -#, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s' turi būti '%s'" +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" +msgstr "" + +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" +msgstr "" + +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "neleistinas eilutės indeksas padėtyje %d" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, fuzzy, c-format -msgid "replacement diagonal has incompatible type \"%s\"" -msgstr "keitimo įstrižainės ilgis neteisingas" +msgid "'%s' is not of type \"%s\"" +msgstr "Dim laukas nėra sveikasis skaičius" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" -msgstr "keitimo įstrižainės ilgis neteisingas" +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "'%s' lauko ilgis turi būti 1" -#: products.c:155 products.c:248 +#: perm.c:86 perm.c:103 #, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "X ir y matmenys nesuderinami su %s" +msgid "'%s' is NA" +msgstr "" -#: products.c:227 -msgid "Argument y must be numeric, integer or logical" -msgstr "Argumentas y turi būti skaitinis, sveikasis skaičius arba loginis" +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "Dim laukas nėra sveikasis skaičius" -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "Matricos nėra tinkamos daugybai" +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "'%s' lauko ilgis turi būti 1" -#: products.c:408 +#: perm.c:120 perm.c:143 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' or '%s' is NA" msgstr "" -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "dtrMatrix turi būti kvadratinė" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:528 products.c:559 +#: perm.c:150 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "Matmenys a (%d,%d) ir b (%d,%d) neatitinka" +msgid "'%s' is NA or less than %s" +msgstr "" -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "right=TRUE dar neįgyvendinta __ FIXME" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: products.c:782 products.c:807 +#, c-format +msgid "'%s' does not support complex matrices" msgstr "" -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" -msgstr "Determinantui reikia kvadratinės matricos" +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "Matrica nėra kvadratinė" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" -msgstr "" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" +msgstr "Determinantui reikia kvadratinės matricos" -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "netinkama 'x' klasė, esanti Csparse_subassign()" -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "netinkama 'value' klasė, esanti Csparse_subassign()" -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "x[] <- val: val yra paverstas į loginį \"%s\" x" -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -908,409 +653,681 @@ "x[] <- val: val turėtų būti sveikasis skaičius arba loginis, yra pakeistas į " "sveikąjį skaičių dėl \"%s\" x" -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "programavimo klaida Csparse_subassign() niekada neturėtų įvykti" -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "Dim laukas nėra sveikasis skaičius" +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 -#, fuzzy, c-format -msgid "'%s' slot does not have length %d" -msgstr "Dim laukas turi būti 2 ilgio" +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "Argumentas turi būti skaitinis atominis vektorius" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data' turi būti vektoriaus tipo" + +#: utils-R.c:352 #, c-format -msgid "'%s' slot contains NA" +msgid "invalid '%s' argument" +msgstr "netinkamas argumentas '%s'" + +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "neskaitinės matricos dydis" + +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "neleistina 'nrow' reikšmė (per didelė arba NA)" + +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "neleistina 'nrow' reikšmė (< 0)" + +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "neleistina 'ncol' reikšmė (per didelė arba NA)" + +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "neleistina 'ncol' reikšmė (< 0)" + +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgstr "duomenų ilgis [%d] nėra eilučių skaičiaus pogrupis ar kartotinis [%d]" + +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" msgstr "" +"duomenų ilgis [%d] nėra stulpelių skaičiaus pogrupis ar kartotinis [%d]" + +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "duomenų ilgis viršija matricos dydį" -#: validity.c:54 validity.c:976 validity.c:1009 +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "nurodyta per daug elementų" + +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "Argumentas ij turi būti 2 stulpelių sveikųjų skaičių matrica" + +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "apatinis indeksas 'i' už M[ij] ribų" + +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "apatinis indeksas 'j' už M[ij] ribų" + +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" +msgstr "i ir j turi būti to paties ilgio sveikieji vektoriai" + +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 +#, fuzzy, c-format +msgid "'%s' slot does not have length %d" +msgstr "Dim laukas turi būti 2 ilgio" + +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "Dim laukas nėra sveikasis skaičius" -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "Dimnames[%d] nėra simbolių vektorius" -#: validity.c:101 +#: validity.c:92 #, fuzzy, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "length(Dimnames[%d]) skiriasi nuo Dim[%d], kuris yra %d" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "x laukas nėra \"double\"" -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "Dim laukas turi būti 2 ilgio" -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "x laukas nėra \"double\"" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "Dim laukas turi būti 2 ilgio" - -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "'Dim' lauko ilgis yra mažesnis nei du" - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "pirmasis lauko p elementas turi būti lygus nuliui" - -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "laukas p turi būti nemažėjantis" - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "'Dim' lauko ilgis yra mažesnis nei du" - -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "laukas j nedidėja stulpelio viduje" -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "laukas j nedidėja stulpelio viduje" -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "Dim laukas turi būti 2 ilgio" -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "uplo='U' neturi turėti sparse įrašų po įstrižainės" -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "uplo='L' neturi turėti sparse įrašų virš įstrižainės" -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "uplo='U' neturi turėti sparse įrašų po įstrižainės" -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "Dim laukas nėra sveikasis skaičius" + +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "Dim laukas nėra sveikasis skaičius" + +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "'Dim' lauko ilgis yra mažesnis nei du" + +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s' turi būti '%s'" + +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "'Dim' lauko ilgis yra mažesnis nei du" + +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "laukas j nedidėja stulpelio viduje" + +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "'Dim' lauko ilgis yra mažesnis nei du" + +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "laukas j nedidėja stulpelio viduje" + +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "X ir y matmenys nesuderinami su %s" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "Dim laukas turi būti 2 ilgio" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "Dim laukas turi būti 2 ilgio" -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "uplo='L' neturi turėti sparse įrašų virš įstrižainės" -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "Dim laukas turi būti 2 ilgio" -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "uplo='U' neturi turėti sparse įrašų po įstrižainės" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, fuzzy, c-format msgid "%s[%d] (%s) is not in %s" msgstr "%s nėra sąrašas" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, fuzzy, c-format msgid "%s is not in {%s}" msgstr "%s nėra sąrašas" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, fuzzy, c-format msgid "%s is not %d" msgstr "%s nėra sąrašas" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "laukas j nedidėja stulpelio viduje" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "'Dim' lauko ilgis yra mažesnis nei du" -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "pirmasis lauko p elementas turi būti lygus nuliui" -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "laukas j nedidėja stulpelio viduje" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " "coincide)" msgstr "" -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "laukas j nedidėja stulpelio viduje" -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "Dim laukas nėra sveikasis skaičius" - -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "netinkama objekto klasė į %s" #, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "trūksta Choleskio faktoriaus įstrižainės elemento %d" + +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "cholmod_factorize_p nepavyko: būsena %d, nedideli %d iš ncol %d" + +#~ msgid "cholmod_change_factor failed" +#~ msgstr "cholmod_change_factor nepavyko" + +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "cholmod_write_sparse grąžintas klaidos kodas" + +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (atgalinis) yra eksperimentinis" + +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC(): netinkamas 'resultKind'" + +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "sudėtinis sparse matricos kodas dar neįrašytas" + +#~ msgid "Argument rho must be an environment" +#~ msgstr "Argumentas rho turi būti aplinka" + +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "netinkama objekto klasė į as_cholmod_sparse" + +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "neleistinas objektas perduotas į as_cholmod_sparse" + +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "in_place cholmod_sort grąžino klaidos kodą" + +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "cholmod_sort grąžino klaidos kodą" + +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "" +#~ "chm_sparse_to_SEXP (, *): neteisingas 'Rkind' (tikrasis rūšies " +#~ "kodas)" + +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "nežinomas xtype cholmod_sparse objekte" + +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "sudėtinis sparse matricos kodas dar neįrašytas" + +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Simetriškas ir trikampis abiejų rinkinys" + +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "netinkama objekto klasė į as_cholmod_triplet" + +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "as_cholmod_triplet(): nepavyko perskirstyti vidiniam diagU2N()" + +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "nežinomas xtype cholmod_triplet objekte" + +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "netinkama objekto klasė į as_cholmod_dense" + +#, c-format +#~ msgid "" +#~ "chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +#~ msgstr "" +#~ "chm_transpose_dense(ans, x) dar neįgyvendintas dėl %s skiriasi nuo %s" + +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "Neįmanoma inicijuoti cholmod: klaidos kodas %d" + +#~ msgid "unknown 'Rkind'" +#~ msgstr "nežinomas 'Rkind'" + +#~ msgid "unknown xtype" +#~ msgstr "nežinomas xtype" + +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "cholmod_dense kodas su dar neįrašytais tarpais" + +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "nežinau, ar tankio modelio matrica turi prasmę" + +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "netinkama objekto klasė į as_cholmod_factor" + +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "klaida, esanti as_cholmod_factor" + +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "CHOLMOD faktoringas buvo nesėkmingas" + +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "neatpažintas %d f->xtype" + +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U(): nrow=%d, ncol=%d" + +#, c-format +#~ msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#~ msgstr "chm_diagN2U(x, uploT = %d): uploT turi būti +- 1" + +#~ msgid "dgCMatrix_lusol requires a square, non-empty matrix" +#~ msgstr "dgCMatrix_lusol reikia kvadratinės, netuščios matricos" + +#~ msgid "Dimensions of system to be solved are inconsistent" +#~ msgstr "Sistemos, kurią reikia išspręsti, matmenys yra nenuoseklūs" + +#~ msgid "cs_lusol failed" +#~ msgstr "cs_lusol nepavyko" + +#~ msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#~ msgstr "dgCMatrix_qrsol(., tvarka) reikia tvarkos {0,..,3}" + +#, c-format +#~ msgid "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) reikalauja 'tall' stačiakampės matricos" + +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "cs_qrsol() nepavyko viduje dgCMatrix_qrsol ()" + +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "dgCMatrix_cholsol reikia 'short, wide' stačiakampės matricos" + +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "cholmod_sdmult klaida (rhs)" + +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "cholmod_factorize nepavyko: būsena %d, nedideli %d iš ncol %d" + +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "cholmod_solve (CHOLMOD_A) nepavyko: būsena %d, nedideli %d iš ncol %d" + +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "cholmod_sdmult klaida (resid)" + +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "SuiteSparseQR_C_QR grąžino klaidos kodą" + +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "Lapack programa dgetrs: sistema yra tiksliai singuliari" + +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "vadovaujantis minoras, kurio eilė yra %d, nėra teigiamai apibrėžtas" + +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "trūksta 'Matrix' vardų srities: niekada neturėtų įvykti" + +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "Matricos vardų sritis nustatyta neteisingai" + +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x): x nėra galiojantis (išskyrus rūšiavimą) CsparseMatrix" + +#, c-format +#~ msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" +#~ msgstr "Neįmanoma Rk_x/Rk_y, esanti Csparse_%s(), prašome pranešti" + +#, c-format +#~ msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" +#~ msgstr "chm_MOD_xtype() nebuvo sėkmingas Csparse_%s(), prašome pranešti" + +#, c-format +#~ msgid "the number of columns differ in R_rbind2_vector: %d != %d" +#~ msgstr "stulpelių skaičius skiriasi R_rbind2_vector: %d != %d" + +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "csp_eye argumentas n turi būti teigiamas" + +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "netinkama 'x' klasė, esanti Matrix_as_cs(a, x)" + +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "netinkama objekto klasė į %s" + +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "cs matrica nesuderinama su klase '%s'" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "Netinkama klasė cl ='%s', esanti Matrix_css_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "Netinkama klasė cl ='%s', esanti Matrix_csn_to_SEXP(S, cl, ..)" + +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "X ir y matmenys nesuderinami su %s" + +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "Argumentas y turi būti skaitinis, sveikasis skaičius arba loginis" + +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "Matricos nėra tinkamos daugybai" + +#~ msgid "dtrMatrix must be square" +#~ msgstr "dtrMatrix turi būti kvadratinė" + +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "Matmenys a (%d,%d) ir b (%d,%d) neatitinka" + +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "right=TRUE dar neįgyvendinta __ FIXME" + +#, c-format #~ msgid "cholmod_change_factor failed with status %d" #~ msgstr "cholmod_change_factor nepavyko su būsena %d" @@ -1612,9 +1629,6 @@ #~ msgid "dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE" #~ msgstr "dgcMatrix_QR(*, keep_dimnames = NA): NA laikoma TRUE" -#~ msgid "cs_qr failed" -#~ msgstr "cs_qr nepavyko" - #~ msgid "LU decomposition applies only to square matrices" #~ msgstr "LU dekompozicija taikoma tik kvadratinėms matricoms" diff -Nru rmatrix-1.6-1.1/po/pl.po rmatrix-1.6-5/po/pl.po --- rmatrix-1.6-1.1/po/pl.po 2023-08-03 18:04:13.000000000 +0000 +++ rmatrix-1.6-5/po/pl.po 2023-11-03 01:34:40.000000000 +0000 @@ -2,7 +2,7 @@ msgstr "" "Project-Id-Version: Matrix 1.1-2-2\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2023-08-03 13:30-0400\n" +"POT-Creation-Date: 2023-11-02 21:33-0400\n" "PO-Revision-Date: 2014-03-24 17:53+0100\n" "Last-Translator: Łukasz Daniel \n" "Language-Team: Łukasz Daniel \n" @@ -15,674 +15,403 @@ "X-Poedit-SourceCharset: iso-8859-1\n" "X-Generator: Poedit 1.5.4\n" -# Matrix/src/CHMfactor.c: 97 -# error(_("diagonal element %d of Cholesky factor is missing"), j) -#: CHMfactor.c:35 -#, c-format -msgid "diagonal element %d of Cholesky factor is missing" -msgstr "brakuje elementu diagonalnego %d czynnika Cholesky'ego" - -# Matrix/src/CHMfactor.c: 135 -# error(_("cholmod_factorize_p failed: status %d, minor %d of ncol %d"), -# c.status, f->minor, f->n) -#: CHMfactor.c:66 -#, c-format -msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" -msgstr "" -"'cholmod_factorize_p' nie powiódł się: status %d, minor %d liczba kolumn %d" - -# Matrix/src/CHMfactor.c: 140 -# error(_("cholmod_change_factor failed")) -#: CHMfactor.c:71 -msgid "cholmod_change_factor failed" -msgstr "'cholmod_change_factor' nie powiódł się" - -# Matrix/src/Csparse.c: 55 -# warning(_("Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix")) -#: Csparse.c:24 -msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" -msgstr "" -"Csparse_sort(x): 'x' nie jest poprawnym (niezależnie od sortowania) obiektem " -"klasy \"CsparseMatrix\"" +# Matrix/src/dgCMatrix.c: 160 +# error(_("cs_lusol failed")) +#: Csparse.c:26 Csparse.c:318 chm_common.c:165 chm_common.c:291 +#: chm_common.c:813 chm_common.c:816 chm_common.c:849 chm_common.c:867 +#: dgCMatrix.c:18 dgCMatrix.c:43 dgCMatrix.c:70 dgCMatrix.c:84 dgCMatrix.c:89 +#: dgCMatrix.c:94 +#, fuzzy, c-format +msgid "'%s' failed" +msgstr "funkcja 'cs_qr' nie powiodła się " -#: Csparse.c:81 -#, c-format -msgid "Impossible Rk_x/Rk_y in Csparse_%s(), please report" -msgstr "" +# Matrix/src/Csparse.c: 97 +# (_("slot j is not increasing inside a column")) +#: Csparse.c:35 chm_common.c:54 +#, fuzzy, c-format +msgid "'%s' slot is not increasing within columns after sorting" +msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" -#: Csparse.c:83 -#, c-format -msgid "chm_MOD_xtype() was not successful in Csparse_%s(), please report" -msgstr "" +# Matrix/src/Mutils.c: 990 +# error(_("invalid '%s' argument"), "byrow") +#: Csparse.c:77 coerce.c:220 coerce.c:240 coerce.c:250 coerce.c:905 +#: coerce.c:911 coerce.c:1015 coerce.c:1501 coerce.c:1521 coerce.c:1531 +#: coerce.c:2061 coerce.c:2256 coerce.c:2262 coerce.c:2268 coerce.c:2397 +#: coerce.c:2404 coerce.c:2494 coerce.c:2629 coerce.c:2707 coerce.c:2729 +#: coerce.c:4327 coerce.c:4396 dense.c:701 products.c:936 products.c:1288 +#: solve.c:719 solve.c:968 solve.c:1100 sparse.c:1233 sparse.c:1625 +#, fuzzy, c-format +msgid "invalid '%s' to '%s'" +msgstr "niepoprawny argument '%s'" # Matrix/src/Csparse.c: 612 # error(_("failure to open file \"%s\" for writing"), # CHAR(asChar(fname))) -#: Csparse.c:145 -#, c-format -msgid "failure to open file \"%s\" for writing" +#: Csparse.c:316 +#, fuzzy, c-format +msgid "failed to open file \"%s\" for writing" msgstr "nie udało się otworzyć pliku '%s' do zapisu" -# Matrix/src/Csparse.c: 616 -# error(_("cholmod_write_sparse returned error code")) -#: Csparse.c:149 -msgid "cholmod_write_sparse returned error code" -msgstr "'cholmod_write_sparse' zwrócił kod błędu" - -# Matrix/src/Csparse.c: 689 -# warning(_("%s = '%s' (back-permuted) is experimental"), -# "resultKind", "diagBack") -#: Csparse.c:331 -#, c-format -msgid "%s = '%s' (back-permuted) is experimental" -msgstr "%s = '%s' (wstecznie permutowany) jest eksperymentalny" - -# Matrix/src/Csparse.c: 699 -# error(_("diag_tC(): invalid 'resultKind'")) -#: Csparse.c:341 -msgid "diag_tC(): invalid 'resultKind'" -msgstr "diag_tC(): niepoprawny 'resultKind'" - # Matrix/src/Mutils.c: 990 # error(_("invalid '%s' argument"), "byrow") -#: Mutils.c:410 +#: attrib.c:229 #, fuzzy msgid "invalid factor name" msgstr "niepoprawny argument '%s'" -#: Mutils.c:414 +#: attrib.c:233 #, c-format msgid "attempt to set factor on %s without '%s' slot" msgstr "" -#: Mutils.c:446 -#, c-format -msgid "attempt to discard factors from %s without '%s' slot" -msgstr "" - -#: Mutils.c:594 Mutils.c:674 -msgid "attempt to get sign of non-permutation" -msgstr "" - -#: Mutils.c:619 Mutils.c:691 -msgid "attempt to invert non-permutation" -msgstr "" - -# Matrix/src/Csparse.c: 797 -# error(_("invalid row index at position %d"), ii) -#: Mutils.c:634 -#, fuzzy -msgid "invalid transposition vector" -msgstr "niepoprawny indeks wiersza na pozycji %d" - -# Matrix/src/dgeMatrix.c: 19 -# (_("'x' slot must be numeric \"double\"")) -#: Mutils.c:647 Mutils.c:649 Mutils.c:664 Mutils.c:666 Mutils.c:681 -#: Mutils.c:701 Mutils.c:713 -#, fuzzy, c-format -msgid "'%s' is not of type \"%s\"" -msgstr "gniazdo 'x' musi być liczbą typu \"double\"" - -# Matrix/src/Mutils.c: 257 -# _("'%s' slot must have length 1") -#: Mutils.c:651 Mutils.c:668 Mutils.c:715 -#, fuzzy, c-format -msgid "'%s' does not have length %d" -msgstr "gniazdo '%s' musi mieć długość 1" - -#: Mutils.c:654 Mutils.c:671 -#, c-format -msgid "'%s' is NA" -msgstr "" - -# Matrix/src/dgeMatrix.c: 19 -# (_("'x' slot must be numeric \"double\"")) -#: Mutils.c:683 Mutils.c:706 -#, fuzzy, c-format -msgid "'%s' or '%s' is not of type \"%s\"" -msgstr "gniazdo 'x' musi być liczbą typu \"double\"" - -# Matrix/src/Mutils.c: 257 -# _("'%s' slot must have length 1") -#: Mutils.c:685 Mutils.c:708 -#, fuzzy, c-format -msgid "'%s' or '%s' does not have length %d" -msgstr "gniazdo '%s' musi mieć długość 1" - -#: Mutils.c:688 Mutils.c:711 -#, c-format -msgid "'%s' or '%s' is NA" +#: bind.c:46 bind.c:153 +msgid "number of rows of matrices must match" msgstr "" -#: Mutils.c:704 -#, c-format -msgid "'%s' has length exceeding %s" +#: bind.c:48 bind.c:155 +msgid "number of columns of matrices must match" msgstr "" -#: Mutils.c:718 +#: bind.c:51 bind.c:158 bind.c:182 bind.c:206 chm_common.c:474 chm_common.c:623 +#: chm_common.c:717 cholmod-etc.c:183 cholmod-etc.c:282 cholmod-etc.c:325 +#: coerce.c:215 coerce.c:235 coerce.c:260 coerce.c:268 coerce.c:276 +#: coerce.c:341 coerce.c:1496 coerce.c:1516 coerce.c:1543 coerce.c:1551 +#: coerce.c:1559 products.c:28 products.c:50 products.c:56 #, c-format -msgid "'%s' is NA or less than %s" +msgid "dimensions cannot exceed %s" msgstr "" -#: Mutils.c:744 -#, c-format -msgid "unexpected type \"%s\" in %s()" +#: bind.c:210 +msgid "number of rows of result is not a multiple of vector length" msgstr "" -#: Mutils.c:766 Mutils.c:787 -#, c-format -msgid "unexpected kind \"%c\" in %s()" +#: bind.c:212 +msgid "number of columns of result is not a multiple of vector length" msgstr "" -#: Mutils.c:920 Mutils.c:1005 +#: bind.c:626 bind.c:691 sparse.c:912 sparse.c:993 #, c-format -msgid "indices would exceed %s" +msgid "%s cannot exceed %s" msgstr "" -#: Mutils.c:922 bind.c:750 bind.c:843 coerce.c:216 coerce.c:509 coerce.c:627 -#: coerce.c:1860 coerce.c:2116 coerce.c:2204 factorizations.c:123 -#: packedMatrix.c:953 subscript.c:1215 subscript.c:1400 +#: bind.c:756 bind.c:853 chm_common.c:720 cholmod-etc.c:328 coerce.c:29 +#: coerce.c:518 coerce.c:811 coerce.c:945 coerce.c:2772 coerce.c:3041 +#: coerce.c:3139 dense.c:924 products.c:151 products.c:212 products.c:291 +#: products.c:379 products.c:456 products.c:550 products.c:865 subscript.c:1232 +#: subscript.c:1417 utils-R.c:32 #, c-format msgid "attempt to allocate vector of length exceeding %s" msgstr "" -# Matrix/src/Mutils.c: 840 -# error(_("Argument 'ij' must be 2-column integer matrix")) -#: Mutils.c:1272 -msgid "Argument ij must be 2-column integer matrix" -msgstr "Argument 'ij' musi być 2-kolumnową macierzą liczb całkowitych" - -# Matrix/src/Mutils.c: 856 -# error(_("subscript 'i' out of bounds in M[ij]")) -#: Mutils.c:1297 -msgid "subscript 'i' out of bounds in M[ij]" -msgstr "indeks 'i' poza zakresem w 'M[ij]'" - -# Matrix/src/Mutils.c: 858 -# error(_("subscript 'j' out of bounds in M[ij]")) -#: Mutils.c:1299 -msgid "subscript 'j' out of bounds in M[ij]" -msgstr "indeks 'j' poza zakresem w 'M[ij]'" - -# Matrix/src/Mutils.c: 897 -# error(_("'i' and 'j' arguments must be integer vectors of the same length")) -#: Mutils.c:1353 -msgid "i and j must be integer vectors of the same length" +#: bind.c:858 products.c:1354 +msgid "should never happen ..." msgstr "" -"'i' oraz 'j' muszą być wektorami liczb całkowitych o tej samej długości" - -# Matrix/src/Mutils.c: 983 -# error(_("'data' must be of a vector type")) -#: Mutils.c:1399 -msgid "'data' must be of a vector type" -msgstr "'data' musi być type wektor" - -# Matrix/src/Mutils.c: 990 -# error(_("invalid '%s' argument"), "byrow") -#: Mutils.c:1406 -#, c-format -msgid "invalid '%s' argument" -msgstr "niepoprawny argument '%s'" - -# Matrix/src/Mutils.c: 997 -# error(_("non-numeric matrix extent")) -# Matrix/src/Mutils.c: 1005 -# error(_("non-numeric matrix extent")) -#: Mutils.c:1413 Mutils.c:1421 -msgid "non-numeric matrix extent" -msgstr "nieliczbowy rozmiar macierzy" -# Matrix/src/Mutils.c: 1000 -# error(_("invalid 'nrow' value (too large or NA)")) -#: Mutils.c:1416 -msgid "invalid 'nrow' value (too large or NA)" -msgstr "niepoprawna wartość 'nrow' (zbyt duża lub wartość NA)" - -# Matrix/src/Mutils.c: 1002 -# error(_("invalid 'nrow' value (< 0)")) -#: Mutils.c:1418 -msgid "invalid 'nrow' value (< 0)" -msgstr "niepoprawna wartość 'nrow' (< 0)" - -# Matrix/src/Mutils.c: 1008 -# error(_("invalid 'ncol' value (too large or NA)")) -#: Mutils.c:1424 -msgid "invalid 'ncol' value (too large or NA)" -msgstr "niepoprawna wartość 'ncol' (zbyt duża lub wartość NA)" +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: chm_common.c:11 chm_common.c:34 validity.c:38 validity.c:183 validity.c:262 +#: validity.c:281 validity.c:290 validity.c:309 validity.c:335 validity.c:355 +#: validity.c:405 validity.c:422 validity.c:456 validity.c:473 validity.c:507 +#: validity.c:509 validity.c:959 validity.c:992 validity.c:1074 validity.c:1094 +#: validity.c:1160 validity.c:1162 validity.c:1210 validity.c:1273 +#: validity.c:1275 validity.c:1321 validity.c:1368 validity.c:1417 +#: validity.c:1450 validity.c:1460 validity.c:1473 validity.c:1527 +#: validity.c:1529 validity.c:1561 validity.c:1573 validity.c:1596 +#: validity.c:1659 validity.c:1678 validity.c:1680 validity.c:1712 +#: validity.c:1747 validity.c:1775 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\"" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" -# Matrix/src/Mutils.c: 1010 -# error(_("invalid 'ncol' value (< 0)")) -#: Mutils.c:1426 -msgid "invalid 'ncol' value (< 0)" -msgstr "niepoprawna wartość 'ncol' (< 0)" +# Matrix/src/dgeMatrix.c: 11 +# (_("'Dim' slot must have length 2")) +#: chm_common.c:14 validity.c:357 validity.c:407 validity.c:458 validity.c:880 +#: validity.c:891 validity.c:961 validity.c:994 validity.c:1096 validity.c:1164 +#: validity.c:1212 validity.c:1277 validity.c:1323 validity.c:1462 +#: validity.c:1479 validity.c:1531 validity.c:1533 validity.c:1563 +#: validity.c:1575 validity.c:1598 validity.c:1714 validity.c:1751 +#: validity.c:1779 validity.c:1829 +#, fuzzy, c-format +msgid "'%s' slot does not have length %s" +msgstr "gniazdo 'Dim' musi mieć długość 2" -# Matrix/src/Mutils.c: 1028 -# warning(_("data length [%d] is not a sub-multiple or multiple of the number of rows [%d]"), lendat, nr) -#: Mutils.c:1444 -#, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" -msgstr "" -"długość danych [%d] nie jest podwielokrotnością lub wielokrotnością liczby " -"wierszy [%d]" +# Matrix/src/Csparse.c: 75 +# (_("first element of slot p must be zero")) +#: chm_common.c:18 validity.c:410 validity.c:461 validity.c:1667 +#: validity.c:1687 validity.c:1689 +#, fuzzy, c-format +msgid "first element of '%s' slot is not 0" +msgstr "pierwszy element gniazda 'p' musi być zerem" -# Matrix/src/Mutils.c: 1031 -# warning(_("data length [%d] is not a sub-multiple or multiple of the number of columns [%d]"), lendat, nc) -#: Mutils.c:1449 +#: chm_common.c:23 chm_common.c:46 validity.c:43 validity.c:361 validity.c:414 +#: validity.c:432 validity.c:465 validity.c:483 validity.c:519 validity.c:521 +#: validity.c:1041 validity.c:1053 validity.c:1100 validity.c:1173 +#: validity.c:1185 validity.c:1286 validity.c:1298 validity.c:1327 +#: validity.c:1378 validity.c:1427 validity.c:1466 validity.c:1486 +#: validity.c:1567 validity.c:1583 validity.c:1608 validity.c:1672 +#: validity.c:1692 validity.c:1694 validity.c:1721 #, c-format -msgid "" -"data length [%d] is not a sub-multiple or multiple of the number of columns " -"[%d]" +msgid "'%s' slot contains NA" msgstr "" -"długość danych [%d] nie jest podwielokrotnością lub wielokrotnością liczby " -"kolumn [%d]" -# Matrix/src/Mutils.c: 1034 -# warning(_("data length exceeds size of matrix")) -#: Mutils.c:1453 -msgid "data length exceeds size of matrix" -msgstr "długość danych przekracza rozmiar macierzy" - -# Matrix/src/Mutils.c: 1040 -# error(_("too many elements specified")) -#: Mutils.c:1458 -msgid "too many elements specified" -msgstr "określono zbyt dużo elementów" +# Matrix/src/Csparse.c: 86 +# (_("slot p must be non-decreasing")) +#: chm_common.c:26 validity.c:416 validity.c:467 +#, fuzzy, c-format +msgid "'%s' slot is not nondecreasing" +msgstr "gniazdo 'p' musi być niemalejące" -#: Mutils.c:1530 +#: chm_common.c:29 validity.c:418 validity.c:469 #, c-format -msgid "the number of columns differ in R_rbind2_vector: %d != %d" +msgid "first differences of '%s' slot exceed %s" msgstr "" -# Matrix/src/dpoMatrix.c: 115 -# error(_("Argument 'b' must be a numeric matrix")) -#: Mutils.c:1589 Mutils.c:1624 Mutils.c:1635 Mutils.c:1666 -msgid "Argument must be numeric-like atomic vector" -msgstr "Argument musi być atomowym wektorem liczbowym" - -#: bind.c:42 bind.c:149 -msgid "number of rows of matrices must match" -msgstr "" +# Matrix/src/dsyMatrix.c: 7 +# (_("'dim' slot has length less than two")) +# Matrix/src/dtrMatrix.c: 11 +# (_("'dim' slot has length less than two")) +#: chm_common.c:37 validity.c:424 validity.c:475 +#, fuzzy, c-format +msgid "'%s' slot has length less than %s" +msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" -#: bind.c:44 bind.c:151 -msgid "number of columns of matrices must match" -msgstr "" +# Matrix/src/dsyMatrix.c: 7 +# (_("'dim' slot has length less than two")) +# Matrix/src/dtrMatrix.c: 11 +# (_("'dim' slot has length less than two")) +#: chm_common.c:49 validity.c:363 validity.c:434 validity.c:485 validity.c:523 +#: validity.c:526 validity.c:1043 validity.c:1102 validity.c:1175 +#: validity.c:1187 validity.c:1288 validity.c:1300 validity.c:1380 +#: validity.c:1429 validity.c:1488 validity.c:1610 validity.c:1723 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s}" +msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" -#: bind.c:47 bind.c:154 bind.c:178 bind.c:202 coerce.c:37 factorizations.c:75 -#: factorizations.c:120 factorizations.c:233 +#: chm_common.c:467 chm_common.c:470 chm_common.c:472 chm_common.c:616 +#: chm_common.c:619 chm_common.c:621 chm_common.c:711 chm_common.c:713 +#: cholmod-etc.c:177 cholmod-etc.c:179 cholmod-etc.c:181 cholmod-etc.c:276 +#: cholmod-etc.c:278 cholmod-etc.c:280 cholmod-etc.c:319 cholmod-etc.c:321 +#: cs-etc.c:43 #, c-format -msgid "dimensions cannot exceed %s" +msgid "wrong '%s'" msgstr "" -#: bind.c:206 -msgid "number of rows of result is not a multiple of vector length" -msgstr "" - -#: bind.c:208 -msgid "number of columns of result is not a multiple of vector length" -msgstr "" - -# Matrix/src/chm_common.c: 383 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 577 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 812 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 862 -# error(_("complex sparse matrix code not yet written")) -#: bind.c:227 -#, fuzzy -msgid "complex matrices are not yet supported" -msgstr "kod dla zespolonych rzadkich macierzy nie został jeszcze napisany" +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: chm_common.c:477 cholmod-etc.c:186 +#, fuzzy, c-format +msgid "'%s' would overflow type \"%s\"" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" -#: bind.c:620 bind.c:685 sparse.c:830 sparse.c:911 +#: chm_common.c:481 cholmod-etc.c:190 #, c-format -msgid "%s cannot exceed %s" -msgstr "" - -#: bind.c:848 -msgid "should never happen ..." -msgstr "" - -# Matrix/src/chm_common.c: 67 -# error(_("Argument 'rho' must be an environment")) -#: chm_common.c:82 -msgid "Argument rho must be an environment" -msgstr "Argument 'rho' musi być środowiskiem" - -# Matrix/src/chm_common.c: 230 -# error(_("invalid class of object passed to 'as_cholmod_sparse' function")) -#: chm_common.c:263 -msgid "invalid class of object to as_cholmod_sparse" +msgid "n+1 would overflow type \"%s\"" msgstr "" -"niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_sparse()'" -# Matrix/src/chm_common.c: 232 -# error(_("invalid object passed to 'as_cholmod_sparse' function")) -#: chm_common.c:265 -msgid "invalid object passed to as_cholmod_sparse" -msgstr "niepoprawny obiekt przekazany do funkcji 'as_cholmod_sparse()'" - -# Matrix/src/chm_common.c: 259 -# error(_("'in_place' 'cholmod_sort' returned an error code")) -#: chm_common.c:293 -msgid "in_place cholmod_sort returned an error code" -msgstr "'in_place' funkcji 'cholmod_sort()' zwróciło kod błędu" - -# Matrix/src/chm_common.c: 265 -# error(_("'cholmod_sort' function returned an error code")) -#: chm_common.c:299 -msgid "cholmod_sort returned an error code" -msgstr "funkcja 'cholmod_sort' zwróciła kod błędu" - -# Matrix/src/chm_common.c: 346 -# error(_("chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)")) -#: chm_common.c:390 -msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" -msgstr "chm_sparse_to_SEXP(, *): niepoprawny 'Rkind' (kod 'real kind')" - -# Matrix/src/chm_common.c: 354 -# error(_("unknown 'xtype' in \"cholmod_sparse\" object")) -#: chm_common.c:398 -msgid "unknown xtype in cholmod_sparse object" -msgstr "nieznany 'xtype' w obiekcie klasy \"cholmod_sparse\"" - -# Matrix/src/chm_common.c: 383 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 577 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 812 -# error(_("complex sparse matrix code not yet written")) -# Matrix/src/chm_common.c: 862 -# error(_("complex sparse matrix code not yet written")) -#: chm_common.c:427 chm_common.c:658 chm_common.c:939 chm_common.c:989 -msgid "complex sparse matrix code not yet written" -msgstr "kod dla zespolonych rzadkich macierzy nie został jeszcze napisany" - -# Matrix/src/chm_common.c: 388 -# error(_("'symmetric' and 'triangular' both set")) -# Matrix/src/chm_common.c: 582 -# error(_("'symmetric' and 'triangular' both set")) -#: chm_common.c:432 chm_common.c:663 -msgid "Symmetric and triangular both set" -msgstr "Ustawiono jednocześnie 'symmetric' oraz 'triangular'" +# Matrix/src/dppMatrix.c: 34 +# error(_("the leading minor of order %d is not positive definite"), +# info) +# Matrix/src/dpoMatrix.c: 40 +# error(_("the leading minor of order %d is not positive definite"), +# info) +#: chm_common.c:486 cholmod-etc.c:195 +#, fuzzy, c-format +msgid "leading principal minor of order %d is not positive" +msgstr "wiodący minor rzędu %d nie jest dodatnio określony" -# Matrix/src/chm_common.c: 428 -# error(_("invalid class of object passed to 'as_cholmod_triplet' function")) -#: chm_common.c:508 -msgid "invalid class of object to as_cholmod_triplet" -msgstr "" -"niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_triplet()'" +# Matrix/src/dppMatrix.c: 34 +# error(_("the leading minor of order %d is not positive definite"), +# info) +# Matrix/src/dpoMatrix.c: 40 +# error(_("the leading minor of order %d is not positive definite"), +# info) +#: chm_common.c:489 cholmod-etc.c:198 +#, fuzzy, c-format +msgid "leading principal minor of order %d is zero" +msgstr "wiodący minor rzędu %d nie jest dodatnio określony" -# Matrix/src/chm_common.c: 452 -# error(_("as_cholmod_triplet(): could not reallocate for internal 'diagU2N()' function")) -#: chm_common.c:532 -msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#: chm_common.c:715 cholmod-etc.c:323 +msgid "leading dimension not equal to number of rows" msgstr "" -"as_cholmod_triplet(): nie można ponownie przydzielić dla wewnętrznej funkcji " -"'diagU2N()'" -# Matrix/src/chm_common.c: 549 -# error(_("unknown 'xtype' in \"cholmod_triplet\" object")) -#: chm_common.c:630 -msgid "unknown xtype in cholmod_triplet object" -msgstr "nieznany 'xtype' w obiekcie klasy \"cholmod_triplet\"" - -# Matrix/src/chm_common.c: 628 -# error(_("invalid class of object passed to 'as_cholmod_dense()' function")) -#: chm_common.c:709 -msgid "invalid class of object to as_cholmod_dense" -msgstr "niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_dense()'" - -#: chm_common.c:777 +#: chm_common.c:778 #, c-format msgid "" -"chm_transpose_dense(ans, x) not yet implemented for %s different from %s" +"invalid simplicial Cholesky factorization: structural zero on main diagonal " +"in column %d" msgstr "" # Matrix/src/chm_common.c: 698 # error(_("Cholmod error '%s' at file %s, line %d"), message, file, line) -#: chm_common.c:801 -#, c-format -msgid "Cholmod error '%s' at file %s, line %d" +#: chm_common.c:838 +#, fuzzy, c-format +msgid "CHOLMOD error '%s' at file '%s', line %d" msgstr "Błąd 'cholmod' '%s' w pliku %s, linia %d" # Matrix/src/chm_common.c: 702 # warning(_("Cholmod warning '%s' at file %s, line %d"), # message, file, line) -#: chm_common.c:805 -#, c-format -msgid "Cholmod warning '%s' at file %s, line %d" +#: chm_common.c:841 +#, fuzzy, c-format +msgid "CHOLMOD warning '%s' at file '%s', line %d" msgstr "Ostrzeżenie 'cholmod' '%s' w pliku %s, linia %d" -# Matrix/src/chm_common.c: 731 -# error(_("Unable to initialize 'cholmod' function: error code %d"), res) -#: chm_common.c:834 -#, c-format -msgid "Unable to initialize cholmod: error code %d" -msgstr "Nie można zainicjować funkcji 'cholmod()': kod błędu %d" - -# Matrix/src/chm_common.c: 778 -# error(_("unknown 'Rkind'")) -#: chm_common.c:883 -msgid "unknown 'Rkind'" -msgstr "nieznany 'Rkind'" - -# Matrix/src/chm_common.c: 785 -# error(_("unknown 'xtype'")) -# Matrix/src/chm_common.c: 848 -# error(_("unknown 'xtype'")) -#: chm_common.c:890 chm_common.c:975 -msgid "unknown xtype" -msgstr "nieznany 'xtype'" - -# Matrix/src/chm_common.c: 818 -# error(_("code for 'cholmod_dense()' function with holes not yet written")) -# Matrix/src/chm_common.c: 871 -# error(_("code for 'cholmod_dense()' functionwith holes not yet written")) -#: chm_common.c:945 chm_common.c:998 -msgid "code for cholmod_dense with holes not yet written" -msgstr "kod dla funkcji 'cholmod_dense()' z dziurami nie jest jeszcze napisany" - -# Matrix/src/chm_common.c: 867 -# error(_("don't know if a dense pattern matrix makes sense")) -#: chm_common.c:994 -msgid "don't know if a dense pattern matrix makes sense" -msgstr "nie wiadomo, czy gęsty wzrór macierzy ma sens" +# Matrix/src/dgeMatrix.c: 341 +# error(_("Determinant requires a square matrix")) +#: coerce.c:24 coerce.c:364 coerce.c:1050 +#, fuzzy, c-format +msgid "attempt to construct non-square %s" +msgstr "Wyznacznik wymaga aby macierz była kwadratowa" -# Matrix/src/chm_common.c: 934 -# error(_("invalid class of object passed to 'as_cholmod_factor' function")) -#: chm_common.c:1057 -#, fuzzy -msgid "object of invalid class to 'as_cholmod_factor()'" +#: coerce.c:186 coerce.c:476 coerce.c:1467 coerce.c:1622 +#, c-format +msgid "second argument of '%s' does not specify a subclass of %s" msgstr "" -"niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_factor()'" -# Matrix/src/chm_common.c: 988 -# error(_("failure in 'as_cholmod_factor' function")) -#: chm_common.c:1114 -msgid "failure in as_cholmod_factor" -msgstr "niepowodzenie w funkcji 'as_cholmod_factor()'" +# Matrix/src/Mutils.c: 268 +# _("'%s' must be in '%s'") +#: coerce.c:194 coerce.c:200 coerce.c:484 coerce.c:490 coerce.c:925 +#: coerce.c:1475 coerce.c:1481 coerce.c:1630 coerce.c:1636 coerce.c:2275 +#: coerce.c:3344 coerce.c:3349 +#, fuzzy, c-format +msgid "'%s' must be \"%s\" or \"%s\"" +msgstr "'%s' musi być w '%s'" -# Matrix/src/chm_common.c: 1016 -# error(_("CHOLMOD factorization was unsuccessful")) -#: chm_common.c:1160 -msgid "CHOLMOD factorization was unsuccessful" -msgstr "Faktoryzacja 'CHOLMOD' nie powiodła się" +# Matrix/src/Mutils.c: 268 +# _("'%s' must be in '%s'") +#: coerce.c:246 coerce.c:496 coerce.c:793 coerce.c:917 coerce.c:1527 +#: coerce.c:1642 dense.c:322 dense.c:1107 dense.c:1683 dense.c:1688 +#: dense.c:1934 dense.c:2129 sparse.c:783 sparse.c:2448 sparse.c:3140 +#: sparse.c:3145 sparse.c:3150 sparse.c:3426 sparse.c:3663 +#, fuzzy, c-format +msgid "'%s' must be %s or %s" +msgstr "'%s' musi być w '%s'" -# Matrix/src/chm_common.c: 1029 -# error(_("f->xtype of %d not recognized"), f->xtype) -#: chm_common.c:1173 -#, c-format -msgid "f->xtype of %d not recognized" -msgstr "'f->xtype' dla %d nie został rozpoznany" +#: coerce.c:266 coerce.c:274 coerce.c:285 coerce.c:1549 coerce.c:1557 +#: coerce.c:1568 +msgid "nonempty vector supplied for empty matrix" +msgstr "" -# Matrix/src/chm_common.c: 1094 -# error(_("chm_diagN2U(): nrow=%d, ncol=%d"), -# n, chx->ncol) -#: chm_common.c:1240 +#: coerce.c:287 coerce.c:1570 #, c-format -msgid "chm_diagN2U(): nrow=%d, ncol=%d" -msgstr "chm_diagN2U(): nrow=%d, ncol=%d" +msgid "vector length (%lld) exceeds matrix length (%d * %d)" +msgstr "" -# Matrix/src/chm_common.c: 1137 -# error(_("chm_diagN2U(x, uploT = %d): uploT should be +- 1"), uploT) -#: chm_common.c:1283 +#: coerce.c:290 coerce.c:1573 #, c-format -msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" -msgstr "chm_diagN2U(x, uploT = %d): 'uploT' powinien wynosić +/- 1" - -# Matrix/src/dgeMatrix.c: 341 -# error(_("Determinant requires a square matrix")) -#: coerce.c:60 -#, fuzzy, c-format -msgid "attempt to construct %s or %s from non-square matrix" -msgstr "Wyznacznik wymaga aby macierz była kwadratowa" - -# Matrix/src/Mutils.c: 990 -# error(_("invalid '%s' argument"), "byrow") -#: coerce.c:180 coerce.c:187 coerce.c:192 coerce.c:491 coerce.c:593 -#: coerce.c:599 coerce.c:607 coerce.c:697 coerce.c:748 coerce.c:755 -#: coerce.c:760 coerce.c:1185 coerce.c:1366 coerce.c:1372 coerce.c:1379 -#: coerce.c:1501 coerce.c:1508 coerce.c:1590 coerce.c:1721 coerce.c:1795 -#: coerce.c:1817 coerce.c:2409 coerce.c:2413 coerce.c:3418 coerce.c:3421 -#: coerce.c:3510 factorizations.c:1788 factorizations.c:2053 -#: factorizations.c:2169 packedMatrix.c:335 sparse.c:1226 sparse.c:1618 -#: unpackedMatrix.c:474 -#, fuzzy, c-format -msgid "invalid '%s' to %s()" -msgstr "niepoprawny argument '%s'" +msgid "matrix length (%d * %d) is not a multiple of vector length (%lld)" +msgstr "" -#: coerce.c:219 +#: coerce.c:521 #, c-format msgid "coercing n-by-n %s to %s is not supported for n*n exceeding %s" msgstr "" -#: coerce.c:223 coerce.c:513 coerce.c:631 +#: coerce.c:525 coerce.c:815 coerce.c:949 #, c-format msgid "sparse->dense coercion: allocating vector of size %0.1f GiB" msgstr "" -#: coerce.c:1061 coerce.c:2007 coerce.c:2013 +#: coerce.c:1196 coerce.c:1941 coerce.c:2948 coerce.c:2954 #, c-format msgid "attempt to construct %s with more than %s nonzero entries" msgstr "" # Matrix/src/dgeMatrix.c: 341 # error(_("Determinant requires a square matrix")) -#: coerce.c:2311 +#: coerce.c:3246 #, fuzzy msgid "attempt to pack non-square matrix" msgstr "Wyznacznik wymaga aby macierz była kwadratowa" -#: coerce.c:2483 coerce.c:2681 +#: coerce.c:3420 coerce.c:3590 #, c-format msgid "unable to aggregate %s with '%s' and '%s' slots of length exceeding %s" msgstr "" -#: coerce.c:2644 -msgid "NAs produced by integer overflow" -msgstr "" - # Matrix/src/dgeMatrix.c: 341 # error(_("Determinant requires a square matrix")) -#: coerce.c:3302 +#: coerce.c:4211 #, fuzzy, c-format msgid "attempt to pack a %s" msgstr "Wyznacznik wymaga aby macierz była kwadratowa" -# Matrix/src/cs_utils.c: 37 -# error(_("'csp_eye' function's argument 'n' must be positive")) -#: cs_utils.c:37 -msgid "csp_eye argument n must be positive" -msgstr "argument 'n' w funkcji 'csp_eye()' musi być dodatni" - -# Matrix/src/cs_utils.c: 68 -# error(_("invalid class of 'x' argument in 'Matrix_as_cs(a, x)' function")) -#: cs_utils.c:71 -msgid "invalid class of 'x' in Matrix_as_cs(a, x)" -msgstr "niepoprawna klasa argumentu 'x' w funkcji 'Matrix_as_cs(a, x)'" - -# Matrix/src/cs_utils.c: 170 -# error(_("invalid class of object to %s"), "Matrix_as_css") -# Matrix/src/cs_utils.c: 185 -# error(_("invalid class of object to %s"), "Matrix_as_css") -# Matrix/src/cs_utils.c: 205 -# error(_("invalid class of object to %s"), "Matrix_as_csn") -# Matrix/src/cs_utils.c: 218 -# error(_("invalid class of object to %s"), "Matrix_as_csn") -#: cs_utils.c:133 cs_utils.c:179 cs_utils.c:194 cs_utils.c:214 cs_utils.c:227 -#, c-format -msgid "invalid class of object to %s" -msgstr "niepoprawna klasa obiektu przekazanego do '%s'" - -# Matrix/src/cs_utils.c: 139 -# error(_("cs matrix not compatible with class '%s'"), valid[ctype]) -#: cs_utils.c:147 -#, c-format -msgid "cs matrix not compatible with class '%s'" -msgstr "'cs matrix' nie jest zgodne z klasą '%s'" - -# Matrix/src/cs_utils.c: 242 -# error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), -# cl) -# Matrix/src/cs_utils.c: 261 -# error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), -# cl) -#: cs_utils.c:251 cs_utils.c:270 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" -msgstr "Niepoprawna klasa cl='%s' w 'Matrix_css_to_SEXP(S, cl, ..)'" - -# Matrix/src/cs_utils.c: 287 -# error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), -# cl) -# Matrix/src/cs_utils.c: 306 -# error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), -# cl) -#: cs_utils.c:297 cs_utils.c:316 -#, c-format -msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" -msgstr "Niepoprawna klasa cl='%s' w 'Matrix_csn_to_SEXP(S, cl, ..)'" +# Matrix/src/Mutils.c: 268 +# _("'%s' must be in '%s'") +#: coerce.c:4330 dense.c:1237 sparse.c:2579 +#, fuzzy, c-format +msgid "'%s' must be %s or %s or %s" +msgstr "'%s' musi być w '%s'" # Matrix/src/Mutils.c: 268 # _("'%s' must be in '%s'") -#: dense.c:199 dense.c:204 sparse.c:508 sparse.c:513 +#: dense.c:210 dense.c:215 sparse.c:590 sparse.c:595 #, fuzzy, c-format msgid "'%s' must be an integer from %s to %s" msgstr "'%s' musi być w '%s'" # Matrix/src/Mutils.c: 268 # _("'%s' must be in '%s'") -#: dense.c:207 sparse.c:516 +#: dense.c:218 sparse.c:598 #, fuzzy, c-format msgid "'%s' must be less than or equal to '%s'" msgstr "'%s' musi być w '%s'" +#: dense.c:428 sparse.c:1069 +#, c-format +msgid "replacement diagonal has incompatible type \"%s\"" +msgstr "" + +#: dense.c:437 sparse.c:1078 +msgid "replacement diagonal has wrong length" +msgstr "" + +# Matrix/src/dgeMatrix.c: 341 +# error(_("Determinant requires a square matrix")) +#: dense.c:627 sparse.c:1274 +#, fuzzy +msgid "attempt to symmetrize a non-square matrix" +msgstr "Wyznacznik wymaga aby macierz była kwadratowa" + +#: dense.c:726 sparse.c:1652 +msgid "attempt to get symmetric part of non-square matrix" +msgstr "" + +#: dense.c:878 sparse.c:2082 +msgid "attempt to get skew-symmetric part of non-square matrix" +msgstr "" + +# Matrix/src/Mutils.c: 268 +# _("'%s' must be in '%s'") +#: dense.c:1678 sparse.c:3135 +#, fuzzy, c-format +msgid "'%s' must be %d or %d" +msgstr "'%s' musi być w '%s'" + # Matrix/src/dense.c: 31 # error(_("incorrect left cyclic shift, j (%d) < 0"), j, k) -#: dense.c:832 +#: dense.c:2161 #, c-format msgid "incorrect left cyclic shift, j (%d) < 0" msgstr "niepoprawne lewe cykliczne przesunięcie, j (%d) < 0" # Matrix/src/dense.c: 29 # error(_("incorrect left cyclic shift, j (%d) >= k (%d)"), j, k) -#: dense.c:835 +#: dense.c:2164 #, c-format msgid "incorrect left cyclic shift, j (%d) >= k (%d)" msgstr "niepoprawne lewe cykliczne przesunięcie, j (%d) >= k (%d)" # Matrix/src/dense.c: 33 # error(_("incorrect left cyclic shift, k (%d) > ldx (%d)"), k, ldx) -#: dense.c:838 +#: dense.c:2167 #, c-format msgid "incorrect left cyclic shift, k (%d) > ldx (%d)" msgstr "niepoprawne lewe cykliczne przesunięcie, k (%d) > ldx (%d)" # Matrix/src/dense.c: 78 # error(_("Unknown error in 'getGivens' function")) -#: dense.c:891 +#: dense.c:2220 #, fuzzy msgid "unknown error in getGivens" msgstr "Nieznany błąd w funkcji 'getGivens()'" @@ -693,7 +422,7 @@ # error(_("'X' argument must be a numeric (double precision) matrix")) # Matrix/src/dense.c: 137 # error(_("'X' argument must be a numeric (double precision) matrix")) -#: dense.c:900 dense.c:914 dense.c:944 +#: dense.c:2229 dense.c:2243 dense.c:2273 msgid "X must be a numeric (double precision) matrix" msgstr "'X' musi być macierzą liczbową (o podwójnej precyzji)" @@ -701,7 +430,7 @@ # error(_("'y' argument must be a numeric (double precision) matrix")) # Matrix/src/dense.c: 142 # error(_("'y' argument must be a numeric (double precision) matrix")) -#: dense.c:916 dense.c:946 +#: dense.c:2245 dense.c:2275 msgid "y must be a numeric (double precision) matrix" msgstr "'y' musi być macierzą liczbową (o podwójnej precyzji)" @@ -709,14 +438,14 @@ # error(_("number of rows in 'y' (%d) does not match number of rows in 'X' (%d)"), ydims[0], n) # Matrix/src/dense.c: 145 # error(_("number of rows in 'y' (%d) does not match number of rows in 'X' (%d)"), ydims[0], n) -#: dense.c:920 dense.c:950 +#: dense.c:2249 dense.c:2279 #, c-format msgid "number of rows in y (%d) does not match number of rows in X (%d)" msgstr "liczba wierszy w 'y' (%d) nie zgadza się z liczbą wierszy w 'X' (%d)" # Matrix/src/dense.c: 124 # error(_("Lapack routine 'dposv' returned error code %d"), info) -#: dense.c:936 +#: dense.c:2265 #, fuzzy, c-format msgid "LAPACK dposv returned error code %d" msgstr "procedura Lapack 'dposv' zwróciła kod błędu %d" @@ -729,34 +458,34 @@ # error(_("Lapack routine '%s' returned error code %d"), "dgetrf()", info) # Matrix/src/dspMatrix.c: 182 # error(_("Lapack routine '%s' returned error code %d"), "dsptrf", info) -#: dense.c:964 dense.c:970 +#: dense.c:2293 dense.c:2299 #, fuzzy, c-format msgid "LAPACK dgels returned error code %d" msgstr "Procedura Lapack '%s' zwróciła kod błędu %d" # Matrix/src/dense.c: 173 # error(_("'X' must be a real (numeric) matrix")) -#: dense.c:989 +#: dense.c:2318 msgid "X must be a real (numeric) matrix" msgstr "'X' musi być rzeczywistą (liczbową) macierzą" # Matrix/src/dense.c: 175 # error(_("'tol' argument, given as %g, must be less or equal to 1"), tol) -#: dense.c:992 +#: dense.c:2321 #, fuzzy, c-format msgid "tol, given as %g, must be >= 0" msgstr "argument 'tol', podany jako %g, musi być mniejszy lub równy 1" # Matrix/src/dense.c: 175 # error(_("'tol' argument, given as %g, must be less or equal to 1"), tol) -#: dense.c:994 +#: dense.c:2323 #, c-format msgid "tol, given as %g, must be <= 1" msgstr "argument 'tol', podany jako %g, musi być mniejszy lub równy 1" # Matrix/src/dense.c: 199 # error(_("First call to 'dgeqrf' returned error code %d"), info) -#: dense.c:1023 dense.c:1031 +#: dense.c:2352 dense.c:2360 #, fuzzy, c-format msgid "LAPACK dgeqrf returned error code %d" msgstr "Pierwsze wywołanie 'dgeqrf()' zwróciło kod błędu %d" @@ -765,16 +494,41 @@ # error(_("Lapack routine 'dtrcon' returned error code %d"), info) # Matrix/src/dense.c: 230 # error(_("Lapack routine 'dtrcon' returned error code %d"), info) -#: dense.c:1036 dense.c:1059 +#: dense.c:2365 dense.c:2388 #, fuzzy, c-format msgid "LAPACK dtrcon returned error code %d" msgstr "Procedura Lapack 'dtrcon()' zwróciła kod błędu %d" -# Matrix/src/dgCMatrix.c: 156 -# error(_("dgCMatrix_lusol requires a square, non-empty matrix")) -#: dgCMatrix.c:43 -msgid "dgCMatrix_lusol requires a square, non-empty matrix" -msgstr "'dgCMatrix_lusol' wymaga kwadratowej, niepustej macierzy" +# Matrix/src/dgeMatrix.c: 341 +# error(_("Determinant requires a square matrix")) +#: determinant.c:33 +#, fuzzy +msgid "determinant of non-square matrix is undefined" +msgstr "Wyznacznik wymaga aby macierz była kwadratowa" + +# Matrix/src/sparseQR.c: 121 +# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), +# "sparseQR_qty") +# Matrix/src/sparseQR.c: 159 +# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), +# "sparseQR_coef") +# Matrix/src/sparseQR.c: 195 +# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), +# "sparseQR_resid_fitted") +#: determinant.c:276 +#, fuzzy, c-format +msgid "%s(<%s>) does not support structurally rank deficient case" +msgstr "" +"%s(): przypadek strukturalnie z niedoborem rang: prawdopodobnie BŁĘDNE zera" + +# Matrix/src/dsyMatrix.c: 9 +# (_("Matrix is not square")) +# Matrix/src/dtrMatrix.c: 13 +# (_("Matrix is not square")) +#: dgCMatrix.c:14 +#, fuzzy, c-format +msgid "'%s' is empty or not square" +msgstr "Macierz nie jest kwadratowa" # Matrix/src/dppMatrix.c: 81 # error(_("Dimensions of system to be solved are inconsistent")) @@ -802,94 +556,29 @@ # error(_("Dimensions of system to be solved are inconsistent")) # Matrix/src/dspMatrix.c: 79 # error(_("Dimensions of system to be solved are inconsistent")) -#: dgCMatrix.c:45 dgCMatrix.c:71 dgCMatrix.c:118 -msgid "Dimensions of system to be solved are inconsistent" +#: dgCMatrix.c:16 dgCMatrix.c:38 dgCMatrix.c:61 solve.c:43 solve.c:984 +#, fuzzy, c-format +msgid "dimensions of '%s' and '%s' are inconsistent" msgstr "Wymiary systemu, który ma być rozwiązany, są niespójne" -# Matrix/src/dgCMatrix.c: 160 -# error(_("cs_lusol failed")) -#: dgCMatrix.c:47 -msgid "cs_lusol failed" -msgstr "'cs_lusol' nie powiódł się" - -# Matrix/src/dgCMatrix.c: 181 -# error(_("'dgCMatrix_qrsol(., order)' function needs order in {0,..,3}")) -#: dgCMatrix.c:68 -msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" -msgstr "" -"funkcja 'dgCMatrix_qrsol(., order)' potrzebuje zmiennej 'order' ze zbioru " -"{0,..,3}" - -# Matrix/src/dgCMatrix.c: 190 -# error(_("'dgCMatrix_qrsol(<%d x %d>-matrix)' function requires a 'tall' rectangular matrix"), -# xc->m, xc->n) -#: dgCMatrix.c:77 -#, c-format -msgid "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" -msgstr "" -"funkcja 'dgCMatrix_qrsol(macierz <%d x %d>)' wymaga długiej prostokątnej " -"macierzy" - -# Matrix/src/dgCMatrix.c: 201 -# error(_("'cs_qrsol()' function failed inside 'dgCMatrix_qrsol()' function")) -#: dgCMatrix.c:88 -msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" -msgstr "" -"funkcja 'cs_qrsol()' nie powiodła się wewnątrz funkcji 'dgCMatrix_qrsol()'" - -# Matrix/src/dgCMatrix.c: 469 -# error(_("'dgCMatrix_cholsol' function requires a 'short, wide' rectangular matrix")) -#: dgCMatrix.c:116 -msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" -msgstr "" -"funkcja 'dgCMatrix_cholsol()' wymaga krótkiej lub szerokiej macierzy " -"prostokątnej" - -# Matrix/src/dgCMatrix.c: 477 -# error(_("'cholmod_sdmult' function error (rhs)")) -#: dgCMatrix.c:124 -msgid "cholmod_sdmult error (rhs)" -msgstr "błąd funkcji 'cholmod_sdmult' (prawa strona)" - -# Matrix/src/CHMfactor.c: 135 -# error(_("cholmod_factorize_p failed: status %d, minor %d of ncol %d"), -# c.status, f->minor, f->n) -#: dgCMatrix.c:127 +#: dgCMatrix.c:40 #, c-format -msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +msgid "%s(%s, %s) requires m-by-n '%s' with m >= n > 0" msgstr "" -"'cholmod_factorize_p' nie powiódł się: status %d, minor %d liczba kolumn %d" -# Matrix/src/dgCMatrix.c: 484 -# error(_("'cholmod_solve' function (CHOLMOD_A) failed: status %d, minor %d from ncol %d"), -# c.status, L->minor, L->n) -#: dgCMatrix.c:131 +#: dgCMatrix.c:63 #, c-format -msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +msgid "%s(%s, %s) requires m-by-n '%s' with n >= m > 0" msgstr "" -"funkcja 'cholmod_solve' (CHOLMOD_A) nie powiodła się: status %d, minor %d z " -"liczbą kolumn %d" - -# Matrix/src/dgCMatrix.c: 501 -# error(_("'cholmod_sdmult' function error (resid)")) -#: dgCMatrix.c:148 -msgid "cholmod_sdmult error (resid)" -msgstr "błąd funkcji 'cholmod_sdmult' (reszta)" - -# Matrix/src/dgCMatrix.c: 293 -# error(_("'SuiteSparseQR_C_QR' function returned an error code")) -#: dgCMatrix.c:196 -msgid "SuiteSparseQR_C_QR returned an error code" -msgstr "funkcja 'SuiteSparseQR_C_QR()' zwróciła kod błędu" -#: dgeMatrix.c:20 +#: dgeMatrix.c:22 #, c-format msgid "dgeMatrix_svd(x,*): dim(x)[j] = %d is too large" msgstr "" # Matrix/src/dgeMatrix.c: 570 # error(_("Matrix exponential requires square, non-null matrix")) -#: dgeMatrix.c:88 +#: dgeMatrix.c:90 msgid "Matrix exponential requires square, non-null matrix" msgstr "Eksponencjowanie macierzy wymaga kwadratowej, niepustej macierzy" @@ -897,247 +586,83 @@ # error(_("dgeMatrix_exp: LAPACK routine 'dgebal()' returned %d"), j) # Matrix/src/dgeMatrix.c: 589 # error(_("dgeMatrix_exp: LAPACK routine 'dgebal()' returned %d"), j) -#: dgeMatrix.c:105 dgeMatrix.c:107 +#: dgeMatrix.c:107 dgeMatrix.c:109 #, c-format msgid "dgeMatrix_exp: LAPACK routine dgebal returned %d" msgstr "dgeMatrix_exp: procedura LAPACK 'dgebal()' zwróciła %d" # Matrix/src/dgeMatrix.c: 627 # error(_("dgeMatrix_exp: 'dgetrf()' returned error code %d"), j) -#: dgeMatrix.c:145 +#: dgeMatrix.c:147 #, c-format msgid "dgeMatrix_exp: dgetrf returned error code %d" msgstr "dgeMatrix_exp: funkcja 'dgetrf()' zwróciła kod błędu %d" # Matrix/src/dgeMatrix.c: 629 # error(_("dgeMatrix_exp: 'dgetrs()' returned error code %d"), j) -#: dgeMatrix.c:147 +#: dgeMatrix.c:149 #, c-format msgid "dgeMatrix_exp: dgetrs returned error code %d" msgstr "dgeMatrix_exp: funkcja 'dgetrs()' zwróciła kod błędu %d" # Matrix/src/dgeMatrix.c: 702 # error(_("dgeMatrix_Schur: 'x' argument must be a non-null square matrix")) -#: dgeMatrix.c:222 +#: dgeMatrix.c:224 msgid "dgeMatrix_Schur: argument x must be a non-null square matrix" msgstr "dgeMatrix_Schur: argument 'x' musi być niepustą macierzą kwadratową" # Matrix/src/dgeMatrix.c: 713 # error(_("dgeMatrix_Schur: first call to 'dgees()' function failed")) -#: dgeMatrix.c:235 +#: dgeMatrix.c:237 msgid "dgeMatrix_Schur: first call to dgees failed" msgstr "dgeMatrix_Schur: pierwsze wywołanie funkcji 'dgees()' nie powiodło się" # Matrix/src/dgeMatrix.c: 721 # error(_("dgeMatrix_Schur: 'dgees()' function returned code %d"), info) -#: dgeMatrix.c:244 +#: dgeMatrix.c:246 #, c-format msgid "dgeMatrix_Schur: dgees returned code %d" msgstr "dgeMatrix_Schur: funkcja 'dgees()' zwróciła kod %d" -#: factorizations.c:73 -#, c-format -msgid "wrong '%s' or '%s' or '%s'" -msgstr "" - -#: factorizations.c:118 -#, c-format -msgid "wrong '%s' or '%s'" -msgstr "" - -#: factorizations.c:153 -#, c-format -msgid "expected %s or %s" -msgstr "" - -#: factorizations.c:231 -#, c-format -msgid "wrong '%s' or '%s' or '%s" -msgstr "" - -#: factorizations.c:236 -#, c-format -msgid "'%s' would overflow \"%s\"" -msgstr "" - -#: factorizations.c:239 -#, c-format -msgid "n+1 would overflow \"%s\"" -msgstr "" - -# Matrix/src/dppMatrix.c: 34 -# error(_("the leading minor of order %d is not positive definite"), -# info) -# Matrix/src/dpoMatrix.c: 40 -# error(_("the leading minor of order %d is not positive definite"), -# info) -#: factorizations.c:243 -#, fuzzy, c-format -msgid "leading principal minor of order %d is not positive" -msgstr "wiodący minor rzędu %d nie jest dodatnio określony" - -# Matrix/src/dppMatrix.c: 34 -# error(_("the leading minor of order %d is not positive definite"), -# info) -# Matrix/src/dpoMatrix.c: 40 -# error(_("the leading minor of order %d is not positive definite"), -# info) -#: factorizations.c:246 -#, fuzzy, c-format -msgid "leading principal minor of order %d is zero" -msgstr "wiodący minor rzędu %d nie jest dodatnio określony" - -#: factorizations.c:317 -#, c-format -msgid "LAPACK routine '%s': argument %d had illegal value" -msgstr "" - -# Matrix/src/dgeMatrix.c: 428 -# error(_("Lapack routine 'dgetrs()': system is exactly singular")) -#: factorizations.c:326 factorizations.c:329 -#, fuzzy, c-format -msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" -msgstr "procedura Lapack 'dgetrs()': system jest ściśle osobliwy" - -# Matrix/src/dppMatrix.c: 34 -# error(_("the leading minor of order %d is not positive definite"), -# info) -# Matrix/src/dpoMatrix.c: 40 -# error(_("the leading minor of order %d is not positive definite"), -# info) -#: factorizations.c:339 factorizations.c:342 -#, fuzzy, c-format -msgid "" -"LAPACK routine '%s': leading principal minor of order %d is not positive" -msgstr "wiodący minor rzędu %d nie jest dodatnio określony" - -#: factorizations.c:355 factorizations.c:358 -#, c-format -msgid "" -"LAPACK routine '%s': matrix is rank deficient or not positive definite, the " -"_computed_ rank is %d" -msgstr "" - # Matrix/src/dsyMatrix.c: 9 # (_("Matrix is not square")) # Matrix/src/dtrMatrix.c: 13 # (_("Matrix is not square")) -#: factorizations.c:647 sparse.c:195 +#: factorizations.c:355 sparse.c:196 #, fuzzy, c-format msgid "'%s' is not a number" msgstr "Macierz nie jest kwadratowa" -#: factorizations.c:665 +#: factorizations.c:376 #, c-format msgid "LU factorization of m-by-n %s requires m == n" msgstr "" -#: factorizations.c:674 +#: factorizations.c:385 #, c-format msgid "LU factorization of %s failed: out of memory or near-singular" msgstr "" -#: factorizations.c:764 +#: factorizations.c:462 #, c-format msgid "QR factorization of m-by-n %s requires m >= n" msgstr "" -#: factorizations.c:773 +#: factorizations.c:471 #, c-format msgid "QR factorization of %s failed: out of memory" msgstr "" -#: factorizations.c:867 factorizations.c:2223 +#: factorizations.c:571 factorizations.c:849 #, c-format msgid "'%s' is not a number or not finite" msgstr "" -# Matrix/src/dgeMatrix.c: 341 -# error(_("Determinant requires a square matrix")) -#: factorizations.c:1124 -#, fuzzy -msgid "determinant of non-square matrix is undefined" -msgstr "Wyznacznik wymaga aby macierz była kwadratowa" - -# Matrix/src/sparseQR.c: 121 -# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), -# "sparseQR_qty") -# Matrix/src/sparseQR.c: 159 -# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), -# "sparseQR_coef") -# Matrix/src/sparseQR.c: 195 -# warning(_("%s(): structurally rank deficient case: possibly WRONG zeros"), -# "sparseQR_resid_fitted") -#: factorizations.c:1290 -#, fuzzy, c-format -msgid "%s(<%s>) does not support structurally rank deficient case" -msgstr "" -"%s(): przypadek strukturalnie z niedoborem rang: prawdopodobnie BŁĘDNE zera" - -# Matrix/src/dsyMatrix.c: 9 -# (_("Matrix is not square")) -# Matrix/src/dtrMatrix.c: 13 -# (_("Matrix is not square")) -#: factorizations.c:1412 -#, fuzzy, c-format -msgid "'%s' is not square" -msgstr "Macierz nie jest kwadratowa" - -# Matrix/src/dppMatrix.c: 81 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dpoMatrix.c: 92 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dpoMatrix.c: 117 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dsyMatrix.c: 85 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dtCMatrix.c: 90 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dtCMatrix.c: 106 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dgCMatrix.c: 158 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dgCMatrix.c: 184 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dgCMatrix.c: 438 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dgCMatrix.c: 471 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dtrMatrix.c: 99 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dgeMatrix.c: 423 -# error(_("Dimensions of system to be solved are inconsistent")) -# Matrix/src/dspMatrix.c: 79 -# error(_("Dimensions of system to be solved are inconsistent")) -#: factorizations.c:1418 factorizations.c:2058 -#, fuzzy, c-format -msgid "dimensions of '%s' and '%s' are inconsistent" -msgstr "Wymiary systemu, który ma być rozwiązany, są niespójne" - -#: factorizations.c:1612 +#: idz.c:467 idz.c:528 #, c-format -msgid "%s(<%s>, <%s>) failed: out of memory" +msgid "incompatible '%s' and '%s' in '%s'" msgstr "" -#: factorizations.c:1703 -#, c-format -msgid "attempt to construct sparse matrix with more than %s nonzero elements" -msgstr "" - -# Matrix/src/init.c: 356 -# error(_("missing 'Matrix' namespace: should never happen")) -#: init.c:421 -#, fuzzy -msgid "missing 'Matrix' namespace; should never happen" -msgstr "brakuje przestrzeni nazw 'Matrix': nie powinno się wydarzyć" - -# Matrix/src/init.c: 367 -# error(_("Matrix namespace not determined correctly")) -#: init.c:431 -#, fuzzy -msgid "'Matrix' namespace not determined correctly" -msgstr "przestrzeń nazw macierzy nie została poprawnie określona" - # Matrix/src/Mutils.c: 13 # error( # _("argument type[1]='%s' must be a one-letter character string"), @@ -1146,26 +671,26 @@ # error( # _("argument type[1]='%s' must be a one-letter character string"), # typstr) -#: kappa.c:7 kappa.c:50 +#: kappa.c:10 kappa.c:54 #, fuzzy, c-format msgid "argument '%s' is not of type \"%s\"" msgstr "argument type[1]='%s' musi być jednoliterowym łańcuchem tekstowym" # Matrix/src/Mutils.c: 261 # _("'%s' must have string length 1") -#: kappa.c:10 kappa.c:53 +#: kappa.c:13 kappa.c:57 #, fuzzy, c-format msgid "argument '%s' has length %d" msgstr "'%s' musi mieć łańcuch długości 1" # Matrix/src/Mutils.c: 261 # _("'%s' must have string length 1") -#: kappa.c:14 kappa.c:57 +#: kappa.c:17 kappa.c:61 #, fuzzy, c-format msgid "argument '%s' (\"%s\") does not have string length %d" msgstr "'%s' musi mieć łańcuch długości 1" -#: kappa.c:38 +#: kappa.c:41 #, c-format msgid "" "argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or " @@ -1174,157 +699,151 @@ # Matrix/src/Mutils.c: 261 # _("'%s' must have string length 1") -#: kappa.c:71 +#: kappa.c:75 #, fuzzy, c-format msgid "argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\"" msgstr "'%s' musi mieć łańcuch długości 1" -#: kappa.c:107 +#: kappa.c:238 #, c-format msgid "%s(%s) is undefined: '%s' is not square" msgstr "" -#: kappa.c:109 kappa.c:160 kappa.c:213 kappa.c:264 kappa.c:319 kappa.c:349 -#: kappa.c:377 +#: objects.c:23 #, c-format -msgid "%s(%s) is undefined: '%s' has length %d" +msgid "unexpected type \"%s\" in '%s'" msgstr "" -#: packedMatrix.c:186 unpackedMatrix.c:228 +#: objects.c:41 objects.c:58 #, c-format -msgid "incompatible '%s' and '%s' in %s()" +msgid "unexpected kind \"%c\" in '%s'" msgstr "" -# Matrix/src/Mutils.c: 268 -# _("'%s' must be in '%s'") -#: packedMatrix.c:620 sparse.c:701 unpackedMatrix.c:956 +#: perm.c:26 perm.c:106 +msgid "attempt to get sign of non-permutation" +msgstr "" + +#: perm.c:51 perm.c:123 +msgid "attempt to invert non-permutation" +msgstr "" + +# Matrix/src/Csparse.c: 797 +# error(_("invalid row index at position %d"), ii) +#: perm.c:66 +#, fuzzy +msgid "invalid transposition vector" +msgstr "niepoprawny indeks wiersza na pozycji %d" + +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: perm.c:79 perm.c:81 perm.c:96 perm.c:98 perm.c:113 perm.c:133 perm.c:145 #, fuzzy, c-format -msgid "'%s' must be %s or %s" -msgstr "'%s' musi być w '%s'" +msgid "'%s' is not of type \"%s\"" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" -#: packedMatrix.c:717 sparse.c:989 unpackedMatrix.c:1056 +# Matrix/src/Mutils.c: 257 +# _("'%s' slot must have length 1") +#: perm.c:83 perm.c:100 perm.c:147 +#, fuzzy, c-format +msgid "'%s' does not have length %d" +msgstr "gniazdo '%s' musi mieć długość 1" + +#: perm.c:86 perm.c:103 #, c-format -msgid "replacement diagonal has incompatible type \"%s\"" +msgid "'%s' is NA" msgstr "" -#: packedMatrix.c:722 sparse.c:998 unpackedMatrix.c:1061 -msgid "replacement diagonal has wrong length" -msgstr "" +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: perm.c:115 perm.c:138 +#, fuzzy, c-format +msgid "'%s' or '%s' is not of type \"%s\"" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" -# Matrix/src/dgeMatrix.c: 127 -# error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), -# tr ? "tcrossprod" : "crossprod") -# Matrix/src/dgeMatrix.c: 184 -# error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), -# tr ? "tcrossprod" : "crossprod") -#: products.c:155 products.c:248 -#, c-format -msgid "Dimensions of x and y are not compatible for %s" -msgstr "Wymiary 'x' oraz 'y' nie są zgodne dla '%s'" +# Matrix/src/Mutils.c: 257 +# _("'%s' slot must have length 1") +#: perm.c:117 perm.c:140 +#, fuzzy, c-format +msgid "'%s' or '%s' does not have length %d" +msgstr "gniazdo '%s' musi mieć długość 1" -# Matrix/src/dgeMatrix.c: 166 -# error(_("'y' argument must be numeric or integer")) -#: products.c:227 -#, fuzzy -msgid "Argument y must be numeric, integer or logical" -msgstr "Argument 'y' musi być liczbą lub rzeczywistą lub całkowitą" +#: perm.c:120 perm.c:143 +#, c-format +msgid "'%s' or '%s' is NA" +msgstr "" -# Matrix/src/dsyMatrix.c: 122 -# error(_("Matrices are not conformable for multiplication")) -# Matrix/src/dtrMatrix.c: 123 -# error(_("Matrices are not conformable for multiplication")) -# Matrix/src/dgeMatrix.c: 447 -# error(_("Matrices are not conformable for multiplication")) -# Matrix/src/dgeMatrix.c: 469 -# error(_("Matrices are not conformable for multiplication")) -# Matrix/src/dspMatrix.c: 153 -# error(_("Matrices are not conformable for multiplication")) -#: products.c:311 products.c:315 products.c:488 products.c:579 products.c:605 -msgid "Matrices are not conformable for multiplication" -msgstr "Macierze nie są dostosowane do przemnożenia" +#: perm.c:136 +#, c-format +msgid "'%s' has length exceeding %s" +msgstr "" -#: products.c:408 +#: perm.c:150 #, c-format -msgid "dimension mismatch in matrix multiplication of \"dtrMatrix\": %d != %d" +msgid "'%s' is NA or less than %s" msgstr "" -# Matrix/src/dtrMatrix.c: 121 -# error(_("object of class \"dtrMatrix\" must be square")) -#: products.c:486 -msgid "dtrMatrix must be square" -msgstr "obiekt klasy \"dtrMatrix\" musi być kwadratowy" +#: products.c:107 products.c:210 products.c:289 products.c:377 products.c:454 +#: products.c:548 products.c:809 products.c:859 +msgid "non-conformable arguments" +msgstr "" -# Matrix/src/dtpMatrix.c: 125 -# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), -# xDim[0], xDim[1], yDim[0], yDim[1]) -# Matrix/src/dtpMatrix.c: 153 -# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), -# aDim[0], aDim[1], bDim[0], bDim[1]) -# Matrix/src/dtpMatrix.c: 184 -# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), -# xDim[0], xDim[1], yDim[0], yDim[1]) -#: products.c:528 products.c:559 +#: products.c:782 products.c:807 #, c-format -msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" -msgstr "Wymiary 'a' (%d,%d) oraz 'b' (%d,%d) nie pokrywają się" +msgid "'%s' does not support complex matrices" +msgstr "" -# Matrix/src/dtpMatrix.c: 132 -# error(_("right=TRUE is not yet implemented __ FIXME")) -#: products.c:535 -msgid "right=TRUE is not yet implemented __ FIXME" -msgstr "'right = TRUE' nie jest jeszcze zaimplementowane __ NAPRAW_MNIE" +# Matrix/src/dsyMatrix.c: 9 +# (_("Matrix is not square")) +# Matrix/src/dtrMatrix.c: 13 +# (_("Matrix is not square")) +#: solve.c:38 +#, fuzzy, c-format +msgid "'%s' is not square" +msgstr "Macierz nie jest kwadratowa" -#: products.c:668 -msgid "" -"cholmod_sdmult() not yet implemented for pattern matrices -> coercing to " -"double" +#: solve.c:497 +#, c-format +msgid "%s(<%s>, <%s>) failed: out of memory" msgstr "" # Matrix/src/dgeMatrix.c: 341 # error(_("Determinant requires a square matrix")) -#: sparse.c:1267 unpackedMatrix.c:501 -#, fuzzy -msgid "attempt to symmetrize a non-square matrix" +#: solve.c:618 +#, fuzzy, c-format +msgid "attempt to construct %s with more than %s nonzero elements" msgstr "Wyznacznik wymaga aby macierz była kwadratowa" -#: sparse.c:1645 unpackedMatrix.c:1160 unpackedMatrix.c:1287 -msgid "attempt to get symmetric part of non-square matrix" -msgstr "" - -#: sparse.c:2092 unpackedMatrix.c:1365 unpackedMatrix.c:1510 -msgid "attempt to get skew-symmetric part of non-square matrix" -msgstr "" - -#: sparse.c:2743 sparse.c:3020 -msgid "sparseResult=TRUE inefficient for unit triangular 'x'" +#: sparseVector.c:90 +#, c-format +msgid "%s length cannot exceed %s" msgstr "" -#: subscript.c:1525 subscript.c:1679 subscript.c:1880 subscript.c:2059 +#: subscript.c:1542 subscript.c:1695 subscript.c:1938 subscript.c:2122 #, c-format msgid "%s too dense for %s; would have more than %s nonzero entries" msgstr "" -#: subscript.c:2146 +#: subscript.c:2209 #, c-format msgid "NA subscripts in %s not supported for '%s' inheriting from %s" msgstr "" # Matrix/src/t_Csparse_subassign.c: 144 # error(_("invalid class of 'x' in 'Csparse_subassign()' function")) -#: t_Csparse_subassign.c:144 +#: t_Csparse_subassign.c:142 msgid "invalid class of 'x' in Csparse_subassign()" msgstr "niepoprawna klasa 'x' w funkcji 'Csparse_subassign()'" # Matrix/src/t_Csparse_subassign.c: 146 # error(_("invalid class of 'value' in 'Csparse_subassign()' function")) -#: t_Csparse_subassign.c:146 +#: t_Csparse_subassign.c:144 msgid "invalid class of 'value' in Csparse_subassign()" msgstr "niepoprawna klasa 'value' w funkcji 'Csparse_subassign()'" # Matrix/src/t_Csparse_subassign.c: 189 # warning(_("x[] <- val: 'val' must be logical for \"%s\" x"), # valid_cM[ctype_x]) -#: t_Csparse_subassign.c:189 +#: t_Csparse_subassign.c:187 #, c-format msgid "x[] <- val: val is coerced to logical for \"%s\" x" msgstr "" @@ -1333,7 +852,7 @@ # Matrix/src/t_Csparse_subassign.c: 194 # error(_("x[] <- val: 'val' must be integer or logical for \"%s\" x"), # valid_cM[ctype_x]) -#: t_Csparse_subassign.c:194 +#: t_Csparse_subassign.c:192 #, c-format msgid "" "x[] <- val: val should be integer or logical, is coerced to integer, for " @@ -1344,196 +863,233 @@ # Matrix/src/t_Csparse_subassign.c: 201 # error(_("programming error in 'Csparse_subassign()' function should never happen")) -#: t_Csparse_subassign.c:201 +#: t_Csparse_subassign.c:199 msgid "programming error in Csparse_subassign() should never happen" msgstr "" "błąd programowy w funkcji 'Csparse_subassign()' nie powinien się wydarzyć" -# Matrix/src/dgeMatrix.c: 19 -# (_("'x' slot must be numeric \"double\"")) -#: validity.c:47 validity.c:192 validity.c:273 validity.c:292 validity.c:301 -#: validity.c:320 validity.c:346 validity.c:366 validity.c:416 validity.c:433 -#: validity.c:467 validity.c:484 validity.c:518 validity.c:520 validity.c:970 -#: validity.c:1003 validity.c:1023 validity.c:1089 validity.c:1091 -#: validity.c:1139 validity.c:1203 validity.c:1205 validity.c:1251 -#: validity.c:1298 validity.c:1347 validity.c:1380 validity.c:1390 -#: validity.c:1403 validity.c:1457 validity.c:1459 validity.c:1491 -#: validity.c:1503 validity.c:1526 validity.c:1589 validity.c:1608 -#: validity.c:1610 validity.c:1642 validity.c:1677 validity.c:1705 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\"" -msgstr "gniazdo 'x' musi być liczbą typu \"double\"" +#: utils-R.c:30 utils-R.c:116 +#, c-format +msgid "indices would exceed %s" +msgstr "" + +# Matrix/src/dpoMatrix.c: 115 +# error(_("Argument 'b' must be a numeric matrix")) +#: utils-R.c:235 utils-R.c:270 utils-R.c:281 utils-R.c:312 +msgid "Argument must be numeric-like atomic vector" +msgstr "Argument musi być atomowym wektorem liczbowym" + +# Matrix/src/Mutils.c: 983 +# error(_("'data' must be of a vector type")) +#: utils-R.c:345 +msgid "'data' must be of a vector type" +msgstr "'data' musi być type wektor" + +# Matrix/src/Mutils.c: 990 +# error(_("invalid '%s' argument"), "byrow") +#: utils-R.c:352 +#, c-format +msgid "invalid '%s' argument" +msgstr "niepoprawny argument '%s'" + +# Matrix/src/Mutils.c: 997 +# error(_("non-numeric matrix extent")) +# Matrix/src/Mutils.c: 1005 +# error(_("non-numeric matrix extent")) +#: utils-R.c:359 utils-R.c:367 +msgid "non-numeric matrix extent" +msgstr "nieliczbowy rozmiar macierzy" + +# Matrix/src/Mutils.c: 1000 +# error(_("invalid 'nrow' value (too large or NA)")) +#: utils-R.c:362 +msgid "invalid 'nrow' value (too large or NA)" +msgstr "niepoprawna wartość 'nrow' (zbyt duża lub wartość NA)" + +# Matrix/src/Mutils.c: 1002 +# error(_("invalid 'nrow' value (< 0)")) +#: utils-R.c:364 +msgid "invalid 'nrow' value (< 0)" +msgstr "niepoprawna wartość 'nrow' (< 0)" + +# Matrix/src/Mutils.c: 1008 +# error(_("invalid 'ncol' value (too large or NA)")) +#: utils-R.c:370 +msgid "invalid 'ncol' value (too large or NA)" +msgstr "niepoprawna wartość 'ncol' (zbyt duża lub wartość NA)" + +# Matrix/src/Mutils.c: 1010 +# error(_("invalid 'ncol' value (< 0)")) +#: utils-R.c:372 +msgid "invalid 'ncol' value (< 0)" +msgstr "niepoprawna wartość 'ncol' (< 0)" + +# Matrix/src/Mutils.c: 1028 +# warning(_("data length [%d] is not a sub-multiple or multiple of the number of rows [%d]"), lendat, nr) +#: utils-R.c:390 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of rows [%d]" +msgstr "" +"długość danych [%d] nie jest podwielokrotnością lub wielokrotnością liczby " +"wierszy [%d]" + +# Matrix/src/Mutils.c: 1031 +# warning(_("data length [%d] is not a sub-multiple or multiple of the number of columns [%d]"), lendat, nc) +#: utils-R.c:395 +#, c-format +msgid "" +"data length [%d] is not a sub-multiple or multiple of the number of columns " +"[%d]" +msgstr "" +"długość danych [%d] nie jest podwielokrotnością lub wielokrotnością liczby " +"kolumn [%d]" + +# Matrix/src/Mutils.c: 1034 +# warning(_("data length exceeds size of matrix")) +#: utils-R.c:399 +msgid "data length exceeds size of matrix" +msgstr "długość danych przekracza rozmiar macierzy" + +# Matrix/src/Mutils.c: 1040 +# error(_("too many elements specified")) +#: utils-R.c:404 +msgid "too many elements specified" +msgstr "określono zbyt dużo elementów" + +# Matrix/src/Mutils.c: 840 +# error(_("Argument 'ij' must be 2-column integer matrix")) +#: utils-R.c:545 +msgid "Argument ij must be 2-column integer matrix" +msgstr "Argument 'ij' musi być 2-kolumnową macierzą liczb całkowitych" + +# Matrix/src/Mutils.c: 856 +# error(_("subscript 'i' out of bounds in M[ij]")) +#: utils-R.c:570 +msgid "subscript 'i' out of bounds in M[ij]" +msgstr "indeks 'i' poza zakresem w 'M[ij]'" + +# Matrix/src/Mutils.c: 858 +# error(_("subscript 'j' out of bounds in M[ij]")) +#: utils-R.c:572 +msgid "subscript 'j' out of bounds in M[ij]" +msgstr "indeks 'j' poza zakresem w 'M[ij]'" + +# Matrix/src/Mutils.c: 897 +# error(_("'i' and 'j' arguments must be integer vectors of the same length")) +#: utils-R.c:626 +msgid "i and j must be integer vectors of the same length" +msgstr "" +"'i' oraz 'j' muszą być wektorami liczb całkowitych o tej samej długości" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:49 validity.c:82 validity.c:275 validity.c:294 validity.c:303 -#: validity.c:322 validity.c:348 validity.c:1382 validity.c:1406 +#: validity.c:40 validity.c:73 validity.c:264 validity.c:283 validity.c:292 +#: validity.c:311 validity.c:337 validity.c:1010 validity.c:1452 +#: validity.c:1476 #, fuzzy, c-format msgid "'%s' slot does not have length %d" msgstr "gniazdo 'Dim' musi mieć długość 2" -#: validity.c:52 validity.c:372 validity.c:425 validity.c:443 validity.c:476 -#: validity.c:494 validity.c:530 validity.c:532 validity.c:1029 validity.c:1102 -#: validity.c:1114 validity.c:1216 validity.c:1228 validity.c:1257 -#: validity.c:1308 validity.c:1357 validity.c:1396 validity.c:1416 -#: validity.c:1497 validity.c:1513 validity.c:1538 validity.c:1602 -#: validity.c:1622 validity.c:1624 validity.c:1651 -#, c-format -msgid "'%s' slot contains NA" -msgstr "" - # Matrix/src/dsyMatrix.c: 7 # (_("'dim' slot has length less than two")) # Matrix/src/dtrMatrix.c: 11 # (_("'dim' slot has length less than two")) -#: validity.c:54 validity.c:976 validity.c:1009 +#: validity.c:45 validity.c:965 validity.c:998 #, fuzzy, c-format msgid "'%s' slot has negative elements" msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" # Matrix/src/dgeMatrix.c: 19 # (_("'x' slot must be numeric \"double\"")) -#: validity.c:80 validity.c:208 +#: validity.c:71 validity.c:197 #, fuzzy, c-format msgid "'%s' slot is not a list" msgstr "gniazdo 'x' musi być liczbą typu \"double\"" # Matrix/src/Mutils.c: 287 # error(_("'s1' and 's2' must be \"character\" vectors")) -#: validity.c:98 +#: validity.c:89 #, fuzzy, c-format msgid "%s[[%d]] is not NULL or a vector" msgstr "'s1' oraz 's2' muszą być wektorami tekstowymi" -#: validity.c:101 +#: validity.c:92 #, c-format msgid "length of %s[[%d]] (%lld) is not equal to %s[%d] (%d)" msgstr "" -#: validity.c:214 +#: validity.c:203 #, c-format msgid "'%s' slot has no '%s' attribute" msgstr "" -#: validity.c:225 validity.c:288 validity.c:316 validity.c:387 validity.c:1044 -#: validity.c:1376 validity.c:1737 +#: validity.c:214 validity.c:277 validity.c:305 validity.c:376 validity.c:1115 +#: validity.c:1446 validity.c:1807 #, c-format msgid "%s[1] != %s[2] (matrix is not square)" msgstr "" -#: validity.c:250 validity.c:263 +#: validity.c:239 validity.c:252 #, c-format msgid "%s[1] differs from %s[2]" msgstr "" # Matrix/src/dgeMatrix.c: 19 # (_("'x' slot must be numeric \"double\"")) -#: validity.c:278 validity.c:297 validity.c:306 validity.c:325 +#: validity.c:267 validity.c:286 validity.c:295 validity.c:314 #, fuzzy, c-format msgid "'%s' slot is not \"%s\" or \"%s\"" msgstr "gniazdo 'x' musi być liczbą typu \"double\"" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:331 validity.c:335 +#: validity.c:320 validity.c:324 #, fuzzy, c-format msgid "'%s' slot is \"%s\" but '%s' slot does not have length %s" msgstr "gniazdo 'Dim' musi mieć długość 2" # Matrix/src/dgeMatrix.c: 19 # (_("'x' slot must be numeric \"double\"")) -#: validity.c:351 +#: validity.c:340 #, fuzzy, c-format msgid "'%s' slot is not %d or %d" msgstr "gniazdo 'x' musi być liczbą typu \"double\"" -#: validity.c:357 validity.c:360 +#: validity.c:346 validity.c:349 #, c-format msgid "%s-by-%s %s invalid for positive '%s' when %s=%d" msgstr "" -# Matrix/src/dgeMatrix.c: 11 -# (_("'Dim' slot must have length 2")) -#: validity.c:368 validity.c:418 validity.c:469 validity.c:891 validity.c:902 -#: validity.c:972 validity.c:1005 validity.c:1025 validity.c:1093 -#: validity.c:1141 validity.c:1207 validity.c:1253 validity.c:1392 -#: validity.c:1409 validity.c:1461 validity.c:1463 validity.c:1493 -#: validity.c:1505 validity.c:1528 validity.c:1644 validity.c:1681 -#: validity.c:1709 validity.c:1759 -#, fuzzy, c-format -msgid "'%s' slot does not have length %s" -msgstr "gniazdo 'Dim' musi mieć długość 2" - -# Matrix/src/dsyMatrix.c: 7 -# (_("'dim' slot has length less than two")) -# Matrix/src/dtrMatrix.c: 11 -# (_("'dim' slot has length less than two")) -#: validity.c:374 validity.c:445 validity.c:496 validity.c:534 validity.c:537 -#: validity.c:1031 validity.c:1104 validity.c:1116 validity.c:1218 -#: validity.c:1230 validity.c:1310 validity.c:1359 validity.c:1418 -#: validity.c:1540 validity.c:1653 -#, fuzzy, c-format -msgid "'%s' slot has elements not in {%s}" -msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" - -#: validity.c:397 validity.c:1107 validity.c:1119 validity.c:1221 -#: validity.c:1233 validity.c:1313 validity.c:1362 validity.c:1421 +#: validity.c:386 validity.c:1178 validity.c:1190 validity.c:1291 +#: validity.c:1303 validity.c:1383 validity.c:1432 validity.c:1491 #, c-format msgid "'%s' slot contains duplicates" msgstr "" -# Matrix/src/Csparse.c: 75 -# (_("first element of slot p must be zero")) -#: validity.c:421 validity.c:472 validity.c:1597 validity.c:1617 -#: validity.c:1619 -#, fuzzy, c-format -msgid "first element of '%s' slot is not 0" -msgstr "pierwszy element gniazda 'p' musi być zerem" - -# Matrix/src/Csparse.c: 86 -# (_("slot p must be non-decreasing")) -#: validity.c:427 validity.c:478 -#, fuzzy, c-format -msgid "'%s' slot is not nondecreasing" -msgstr "gniazdo 'p' musi być niemalejące" - -#: validity.c:429 validity.c:480 -#, c-format -msgid "first differences of '%s' slot exceed %s" -msgstr "" - -# Matrix/src/dsyMatrix.c: 7 -# (_("'dim' slot has length less than two")) -# Matrix/src/dtrMatrix.c: 11 -# (_("'dim' slot has length less than two")) -#: validity.c:435 validity.c:486 -#, fuzzy, c-format -msgid "'%s' slot has length less than %s" -msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" - # Matrix/src/Csparse.c: 97 # (_("slot j is not increasing inside a column")) -#: validity.c:448 validity.c:1543 +#: validity.c:437 validity.c:1613 #, fuzzy, c-format msgid "'%s' slot is not increasing within columns" msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" # Matrix/src/Csparse.c: 97 # (_("slot j is not increasing inside a column")) -#: validity.c:499 +#: validity.c:488 #, fuzzy, c-format msgid "'%s' slot is not increasing within rows" msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:523 validity.c:812 validity.c:838 validity.c:864 validity.c:1612 -#: validity.c:1614 +#: validity.c:512 validity.c:801 validity.c:827 validity.c:853 validity.c:1076 +#: validity.c:1682 validity.c:1684 #, fuzzy, c-format msgid "'%s' and '%s' slots do not have equal length" msgstr "gniazdo 'Dim' musi mieć długość 2" -#: validity.c:526 +#: validity.c:515 #, c-format msgid "'%s' slot has nonzero length but %s is 0" msgstr "" @@ -1544,8 +1100,8 @@ # (_("uplo='U' must not have sparse entries below the diagonal")) # Matrix/src/dtCMatrix.c: 63 # (_("uplo='U' must not have sparse entries below the diagonal")) -#: validity.c:566 validity.c:611 validity.c:657 validity.c:702 validity.c:746 -#: validity.c:781 +#: validity.c:555 validity.c:600 validity.c:646 validity.c:691 validity.c:735 +#: validity.c:770 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries below the diagonal" msgstr "uplo='U' nie może mieć rzadkich wpisów poniżej diagonali" @@ -1556,8 +1112,8 @@ # (_("uplo='L' must not have sparse entries above the diagonal")) # Matrix/src/dtCMatrix.c: 69 # (_("uplo='L' must not have sparse entries above the diagonal")) -#: validity.c:576 validity.c:624 validity.c:667 validity.c:715 validity.c:751 -#: validity.c:792 +#: validity.c:565 validity.c:613 validity.c:656 validity.c:704 validity.c:740 +#: validity.c:781 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries above the diagonal" msgstr "uplo='L' nie może mieć rzadkich wpisów powyżej diagonali" @@ -1568,54 +1124,116 @@ # (_("uplo='U' must not have sparse entries below the diagonal")) # Matrix/src/dtCMatrix.c: 63 # (_("uplo='U' must not have sparse entries below the diagonal")) -#: validity.c:614 validity.c:627 validity.c:705 validity.c:718 validity.c:784 -#: validity.c:795 +#: validity.c:603 validity.c:616 validity.c:694 validity.c:707 validity.c:773 +#: validity.c:784 #, fuzzy, c-format msgid "%s=\"%s\" but there are entries on the diagonal" msgstr "uplo='U' nie może mieć rzadkich wpisów poniżej diagonali" -#: validity.c:922 validity.c:946 validity.c:950 +#: validity.c:911 validity.c:935 validity.c:939 msgid "matrix has negative diagonal elements" msgstr "" -#: validity.c:966 validity.c:994 validity.c:998 +#: validity.c:955 validity.c:983 validity.c:987 msgid "matrix has nonunit diagonal elements" msgstr "" +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: validity.c:1007 validity.c:1032 validity.c:1826 +#, fuzzy, c-format +msgid "'%s' slot is not of type \"%s\" or \"%s\"" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" + +# Matrix/src/dgeMatrix.c: 19 +# (_("'x' slot must be numeric \"double\"")) +#: validity.c:1015 validity.c:1022 +#, fuzzy, c-format +msgid "'%s' slot is NA" +msgstr "gniazdo 'x' musi być liczbą typu \"double\"" + +# Matrix/src/dsyMatrix.c: 7 +# (_("'dim' slot has length less than two")) +# Matrix/src/dtrMatrix.c: 11 +# (_("'dim' slot has length less than two")) +#: validity.c:1017 validity.c:1024 +#, fuzzy, c-format +msgid "'%s' slot is negative" +msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" + +# Matrix/src/Mutils.c: 268 +# _("'%s' must be in '%s'") +#: validity.c:1026 +#, fuzzy, c-format +msgid "'%s' slot exceeds %s" +msgstr "'%s' musi być w '%s'" + +# Matrix/src/dsyMatrix.c: 7 +# (_("'dim' slot has length less than two")) +# Matrix/src/dtrMatrix.c: 11 +# (_("'dim' slot has length less than two")) +#: validity.c:1036 +#, fuzzy, c-format +msgid "'%s' slot has length greater than '%s' slot" +msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" + +# Matrix/src/Csparse.c: 97 +# (_("slot j is not increasing inside a column")) +#: validity.c:1046 validity.c:1674 validity.c:1696 validity.c:1698 +#, fuzzy, c-format +msgid "'%s' slot is not increasing" +msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" + +# Matrix/src/dsyMatrix.c: 7 +# (_("'dim' slot has length less than two")) +# Matrix/src/dtrMatrix.c: 11 +# (_("'dim' slot has length less than two")) +#: validity.c:1056 +#, fuzzy, c-format +msgid "'%s' slot has elements not in {%s} after truncation towards zero" +msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" + +# Matrix/src/Csparse.c: 97 +# (_("slot j is not increasing inside a column")) +#: validity.c:1059 +#, fuzzy, c-format +msgid "'%s' slot is not increasing after truncation towards zero" +msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" + # Matrix/src/dgeMatrix.c: 127 # error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), # tr ? "tcrossprod" : "crossprod") # Matrix/src/dgeMatrix.c: 184 # error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), # tr ? "tcrossprod" : "crossprod") -#: validity.c:1054 validity.c:1081 validity.c:1744 validity.c:1751 +#: validity.c:1125 validity.c:1152 validity.c:1814 validity.c:1821 #, fuzzy, c-format msgid "dimensions of '%s' slot are not identical to '%s'" msgstr "Wymiary 'x' oraz 'y' nie są zgodne dla '%s'" -#: validity.c:1056 +#: validity.c:1127 #, c-format msgid "'%s' slot is upper (not lower) triangular" msgstr "" -#: validity.c:1069 +#: validity.c:1140 #, c-format msgid "'%s' slot has nonunit diagonal elements" msgstr "" -#: validity.c:1083 +#: validity.c:1154 #, c-format msgid "'%s' slot is lower (not upper) triangular" msgstr "" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:1095 validity.c:1209 validity.c:1300 validity.c:1349 +#: validity.c:1166 validity.c:1279 validity.c:1370 validity.c:1419 #, fuzzy, c-format msgid "'%s' slot does not have length %s or length %s" msgstr "gniazdo 'Dim' musi mieć długość 2" -#: validity.c:1135 +#: validity.c:1206 msgid "matrix has more columns than rows" msgstr "" @@ -1623,7 +1241,7 @@ # (_("'dim' slot has length less than two")) # Matrix/src/dtrMatrix.c: 11 # (_("'dim' slot has length less than two")) -#: validity.c:1156 +#: validity.c:1226 #, fuzzy, c-format msgid "'%s' slot has fewer than %s rows" msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" @@ -1632,14 +1250,14 @@ # (_("'dim' slot has length less than two")) # Matrix/src/dtrMatrix.c: 11 # (_("'dim' slot has length less than two")) -#: validity.c:1158 +#: validity.c:1228 #, fuzzy, c-format msgid "'%s' slot has more than %s rows" msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:1160 validity.c:1183 +#: validity.c:1230 validity.c:1252 #, fuzzy, c-format msgid "'%s' slot does not have %s columns" msgstr "gniazdo 'Dim' musi mieć długość 2" @@ -1650,14 +1268,14 @@ # (_("uplo='L' must not have sparse entries above the diagonal")) # Matrix/src/dtCMatrix.c: 69 # (_("uplo='L' must not have sparse entries above the diagonal")) -#: validity.c:1167 +#: validity.c:1237 #, fuzzy, c-format msgid "'%s' slot must be lower trapezoidal but has entries above the diagonal" msgstr "uplo='L' nie może mieć rzadkich wpisów powyżej diagonali" # Matrix/src/dgeMatrix.c: 11 # (_("'Dim' slot must have length 2")) -#: validity.c:1181 +#: validity.c:1250 #, fuzzy, c-format msgid "'%s' slot does not have %s row" msgstr "gniazdo 'Dim' musi mieć długość 2" @@ -1668,114 +1286,114 @@ # (_("uplo='U' must not have sparse entries below the diagonal")) # Matrix/src/dtCMatrix.c: 63 # (_("uplo='U' must not have sparse entries below the diagonal")) -#: validity.c:1191 +#: validity.c:1259 #, fuzzy, c-format msgid "'%s' slot must be upper trapezoidal but has entries below the diagonal" msgstr "uplo='U' nie może mieć rzadkich wpisów poniżej diagonali" -#: validity.c:1194 +#: validity.c:1263 #, c-format msgid "'%s' slot has negative diagonal elements" msgstr "" -#: validity.c:1259 +#: validity.c:1329 #, c-format msgid "'%s' slot has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1268 +#: validity.c:1338 #, c-format msgid "'%s' slot has unpaired negative elements" msgstr "" -#: validity.c:1294 validity.c:1338 validity.c:1342 validity.c:1690 -#: validity.c:1722 +#: validity.c:1364 validity.c:1408 validity.c:1412 validity.c:1760 +#: validity.c:1792 msgid "Cholesky factor has negative diagonal elements" msgstr "" -#: validity.c:1385 +#: validity.c:1455 #, c-format msgid "%s[%d] (%s) is not in %s" msgstr "" -#: validity.c:1398 validity.c:1499 +#: validity.c:1468 validity.c:1569 #, c-format msgid "%s is not in {%s}" msgstr "" -#: validity.c:1435 +#: validity.c:1505 #, c-format msgid "%s is not representable as \"%s\"" msgstr "" -#: validity.c:1440 validity.c:1446 +#: validity.c:1510 validity.c:1516 #, c-format msgid "%s[%d] (%s) is not %d or %d" msgstr "" -#: validity.c:1443 validity.c:1559 validity.c:1562 validity.c:1565 +#: validity.c:1513 validity.c:1629 validity.c:1632 validity.c:1635 #, c-format msgid "%s[%d] (%s) is not %d" msgstr "" -#: validity.c:1468 +#: validity.c:1538 #, c-format msgid "%s has elements not in {%s}" msgstr "" -#: validity.c:1471 +#: validity.c:1541 #, c-format msgid "%s has elements not in {%s}\\{%s}" msgstr "" -#: validity.c:1474 +#: validity.c:1544 #, c-format msgid "%s is %d but columns are not stored in increasing order" msgstr "" -#: validity.c:1477 validity.c:1480 +#: validity.c:1547 validity.c:1550 #, c-format msgid "traversal of '%s' slot does not complete in exactly %s steps" msgstr "" -#: validity.c:1486 validity.c:1488 +#: validity.c:1556 validity.c:1558 #, c-format msgid "%s is not %d" msgstr "" -#: validity.c:1509 +#: validity.c:1579 #, c-format msgid "column '%s' is stored first but %s is not 0" msgstr "" # Matrix/src/Csparse.c: 97 # (_("slot j is not increasing inside a column")) -#: validity.c:1515 +#: validity.c:1585 #, fuzzy, c-format msgid "'%s' slot is not increasing when traversed in stored column order" msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" -#: validity.c:1517 +#: validity.c:1587 #, c-format msgid "'%s' slot allocates fewer than %s elements for column '%s'" msgstr "" -#: validity.c:1520 +#: validity.c:1590 #, c-format msgid "'%s' slot allocates more than %s elements for column '%s'" msgstr "" -#: validity.c:1534 +#: validity.c:1604 #, c-format msgid "first entry in column '%s' does not have row index '%s'" msgstr "" -#: validity.c:1568 validity.c:1571 +#: validity.c:1638 validity.c:1641 #, c-format msgid "%s[%d] (%s) is negative" msgstr "" -#: validity.c:1574 +#: validity.c:1644 #, c-format msgid "%s[%d] (%s) is not less than %s" msgstr "" @@ -1784,7 +1402,7 @@ # (_("'dim' slot has length less than two")) # Matrix/src/dtrMatrix.c: 11 # (_("'dim' slot has length less than two")) -#: validity.c:1592 +#: validity.c:1662 #, fuzzy, c-format msgid "'%s' slot has length less than %d" msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" @@ -1793,41 +1411,34 @@ # (_("'dim' slot has length less than two")) # Matrix/src/dtrMatrix.c: 11 # (_("'dim' slot has length less than two")) -#: validity.c:1594 +#: validity.c:1664 #, fuzzy, c-format msgid "'%s' slot has length greater than %s" msgstr "gniazdo 'dim' ma długość mniejszą niż dwa" # Matrix/src/Csparse.c: 75 # (_("first element of slot p must be zero")) -#: validity.c:1599 +#: validity.c:1669 #, fuzzy, c-format msgid "last element of '%s' slot is not %s" msgstr "pierwszy element gniazda 'p' musi być zerem" -# Matrix/src/Csparse.c: 97 -# (_("slot j is not increasing inside a column")) -#: validity.c:1604 validity.c:1626 validity.c:1628 -#, fuzzy, c-format -msgid "'%s' slot is not increasing" -msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" - -#: validity.c:1632 +#: validity.c:1702 #, c-format msgid "first differences of '%s' slot are less than those of '%s' slot" msgstr "" -#: validity.c:1635 +#: validity.c:1705 #, c-format msgid "supernode lengths exceed %s" msgstr "" -#: validity.c:1637 +#: validity.c:1707 #, c-format msgid "first differences of '%s' slot are not equal to supernode lengths" msgstr "" -#: validity.c:1657 +#: validity.c:1727 #, c-format msgid "" "'%s' slot is wrong within diagonal blocks (row and column indices do not " @@ -1836,18 +1447,11 @@ # Matrix/src/Csparse.c: 97 # (_("slot j is not increasing inside a column")) -#: validity.c:1660 +#: validity.c:1730 #, fuzzy, c-format msgid "'%s' slot is not increasing within supernodes" msgstr "gniazdo 'j' nie jest rosnące wewnątrz kolumny" -# Matrix/src/dgeMatrix.c: 19 -# (_("'x' slot must be numeric \"double\"")) -#: validity.c:1756 -#, fuzzy, c-format -msgid "'%s' slot is not of type \"%s\" or type \"%s\"" -msgstr "gniazdo 'x' musi być liczbą typu \"double\"" - # Matrix/src/cs_utils.c: 170 # error(_("invalid class of object to %s"), "Matrix_as_css") # Matrix/src/cs_utils.c: 185 @@ -1856,11 +1460,444 @@ # error(_("invalid class of object to %s"), "Matrix_as_csn") # Matrix/src/cs_utils.c: 218 # error(_("invalid class of object to %s"), "Matrix_as_csn") -#: validity.c:1775 +#: validity.c:1845 #, fuzzy, c-format msgid "invalid class \"%s\" object: %s" msgstr "niepoprawna klasa obiektu przekazanego do '%s'" +# Matrix/src/CHMfactor.c: 97 +# error(_("diagonal element %d of Cholesky factor is missing"), j) +#, c-format +#~ msgid "diagonal element %d of Cholesky factor is missing" +#~ msgstr "brakuje elementu diagonalnego %d czynnika Cholesky'ego" + +# Matrix/src/CHMfactor.c: 135 +# error(_("cholmod_factorize_p failed: status %d, minor %d of ncol %d"), +# c.status, f->minor, f->n) +#, c-format +#~ msgid "cholmod_factorize_p failed: status %d, minor %d of ncol %d" +#~ msgstr "" +#~ "'cholmod_factorize_p' nie powiódł się: status %d, minor %d liczba kolumn " +#~ "%d" + +# Matrix/src/CHMfactor.c: 140 +# error(_("cholmod_change_factor failed")) +#~ msgid "cholmod_change_factor failed" +#~ msgstr "'cholmod_change_factor' nie powiódł się" + +# Matrix/src/Csparse.c: 616 +# error(_("cholmod_write_sparse returned error code")) +#~ msgid "cholmod_write_sparse returned error code" +#~ msgstr "'cholmod_write_sparse' zwrócił kod błędu" + +# Matrix/src/Csparse.c: 689 +# warning(_("%s = '%s' (back-permuted) is experimental"), +# "resultKind", "diagBack") +#, c-format +#~ msgid "%s = '%s' (back-permuted) is experimental" +#~ msgstr "%s = '%s' (wstecznie permutowany) jest eksperymentalny" + +# Matrix/src/Csparse.c: 699 +# error(_("diag_tC(): invalid 'resultKind'")) +#~ msgid "diag_tC(): invalid 'resultKind'" +#~ msgstr "diag_tC(): niepoprawny 'resultKind'" + +# Matrix/src/chm_common.c: 383 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 577 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 812 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 862 +# error(_("complex sparse matrix code not yet written")) +#, fuzzy +#~ msgid "complex matrices are not yet supported" +#~ msgstr "kod dla zespolonych rzadkich macierzy nie został jeszcze napisany" + +# Matrix/src/chm_common.c: 67 +# error(_("Argument 'rho' must be an environment")) +#~ msgid "Argument rho must be an environment" +#~ msgstr "Argument 'rho' musi być środowiskiem" + +# Matrix/src/chm_common.c: 230 +# error(_("invalid class of object passed to 'as_cholmod_sparse' function")) +#~ msgid "invalid class of object to as_cholmod_sparse" +#~ msgstr "" +#~ "niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_sparse()'" + +# Matrix/src/chm_common.c: 232 +# error(_("invalid object passed to 'as_cholmod_sparse' function")) +#~ msgid "invalid object passed to as_cholmod_sparse" +#~ msgstr "niepoprawny obiekt przekazany do funkcji 'as_cholmod_sparse()'" + +# Matrix/src/chm_common.c: 259 +# error(_("'in_place' 'cholmod_sort' returned an error code")) +#~ msgid "in_place cholmod_sort returned an error code" +#~ msgstr "'in_place' funkcji 'cholmod_sort()' zwróciło kod błędu" + +# Matrix/src/chm_common.c: 265 +# error(_("'cholmod_sort' function returned an error code")) +#~ msgid "cholmod_sort returned an error code" +#~ msgstr "funkcja 'cholmod_sort' zwróciła kod błędu" + +# Matrix/src/chm_common.c: 346 +# error(_("chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)")) +#~ msgid "chm_sparse_to_SEXP(, *): invalid 'Rkind' (real kind code)" +#~ msgstr "" +#~ "chm_sparse_to_SEXP(, *): niepoprawny 'Rkind' (kod 'real kind')" + +# Matrix/src/chm_common.c: 354 +# error(_("unknown 'xtype' in \"cholmod_sparse\" object")) +#~ msgid "unknown xtype in cholmod_sparse object" +#~ msgstr "nieznany 'xtype' w obiekcie klasy \"cholmod_sparse\"" + +# Matrix/src/chm_common.c: 383 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 577 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 812 +# error(_("complex sparse matrix code not yet written")) +# Matrix/src/chm_common.c: 862 +# error(_("complex sparse matrix code not yet written")) +#~ msgid "complex sparse matrix code not yet written" +#~ msgstr "kod dla zespolonych rzadkich macierzy nie został jeszcze napisany" + +# Matrix/src/chm_common.c: 388 +# error(_("'symmetric' and 'triangular' both set")) +# Matrix/src/chm_common.c: 582 +# error(_("'symmetric' and 'triangular' both set")) +#~ msgid "Symmetric and triangular both set" +#~ msgstr "Ustawiono jednocześnie 'symmetric' oraz 'triangular'" + +# Matrix/src/chm_common.c: 428 +# error(_("invalid class of object passed to 'as_cholmod_triplet' function")) +#~ msgid "invalid class of object to as_cholmod_triplet" +#~ msgstr "" +#~ "niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_triplet()'" + +# Matrix/src/chm_common.c: 452 +# error(_("as_cholmod_triplet(): could not reallocate for internal 'diagU2N()' function")) +#~ msgid "as_cholmod_triplet(): could not reallocate for internal diagU2N()" +#~ msgstr "" +#~ "as_cholmod_triplet(): nie można ponownie przydzielić dla wewnętrznej " +#~ "funkcji 'diagU2N()'" + +# Matrix/src/chm_common.c: 549 +# error(_("unknown 'xtype' in \"cholmod_triplet\" object")) +#~ msgid "unknown xtype in cholmod_triplet object" +#~ msgstr "nieznany 'xtype' w obiekcie klasy \"cholmod_triplet\"" + +# Matrix/src/chm_common.c: 628 +# error(_("invalid class of object passed to 'as_cholmod_dense()' function")) +#~ msgid "invalid class of object to as_cholmod_dense" +#~ msgstr "" +#~ "niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_dense()'" + +# Matrix/src/chm_common.c: 731 +# error(_("Unable to initialize 'cholmod' function: error code %d"), res) +#, c-format +#~ msgid "Unable to initialize cholmod: error code %d" +#~ msgstr "Nie można zainicjować funkcji 'cholmod()': kod błędu %d" + +# Matrix/src/chm_common.c: 778 +# error(_("unknown 'Rkind'")) +#~ msgid "unknown 'Rkind'" +#~ msgstr "nieznany 'Rkind'" + +# Matrix/src/chm_common.c: 785 +# error(_("unknown 'xtype'")) +# Matrix/src/chm_common.c: 848 +# error(_("unknown 'xtype'")) +#~ msgid "unknown xtype" +#~ msgstr "nieznany 'xtype'" + +# Matrix/src/chm_common.c: 818 +# error(_("code for 'cholmod_dense()' function with holes not yet written")) +# Matrix/src/chm_common.c: 871 +# error(_("code for 'cholmod_dense()' functionwith holes not yet written")) +#~ msgid "code for cholmod_dense with holes not yet written" +#~ msgstr "" +#~ "kod dla funkcji 'cholmod_dense()' z dziurami nie jest jeszcze napisany" + +# Matrix/src/chm_common.c: 867 +# error(_("don't know if a dense pattern matrix makes sense")) +#~ msgid "don't know if a dense pattern matrix makes sense" +#~ msgstr "nie wiadomo, czy gęsty wzrór macierzy ma sens" + +# Matrix/src/chm_common.c: 934 +# error(_("invalid class of object passed to 'as_cholmod_factor' function")) +#, fuzzy +#~ msgid "object of invalid class to 'as_cholmod_factor()'" +#~ msgstr "" +#~ "niepoprawna klasa obiektu przekazanego do funkcji 'as_cholmod_factor()'" + +# Matrix/src/chm_common.c: 988 +# error(_("failure in 'as_cholmod_factor' function")) +#~ msgid "failure in as_cholmod_factor" +#~ msgstr "niepowodzenie w funkcji 'as_cholmod_factor()'" + +# Matrix/src/chm_common.c: 1016 +# error(_("CHOLMOD factorization was unsuccessful")) +#~ msgid "CHOLMOD factorization was unsuccessful" +#~ msgstr "Faktoryzacja 'CHOLMOD' nie powiodła się" + +# Matrix/src/chm_common.c: 1029 +# error(_("f->xtype of %d not recognized"), f->xtype) +#, c-format +#~ msgid "f->xtype of %d not recognized" +#~ msgstr "'f->xtype' dla %d nie został rozpoznany" + +# Matrix/src/chm_common.c: 1094 +# error(_("chm_diagN2U(): nrow=%d, ncol=%d"), +# n, chx->ncol) +#, c-format +#~ msgid "chm_diagN2U(): nrow=%d, ncol=%d" +#~ msgstr "chm_diagN2U(): nrow=%d, ncol=%d" + +# Matrix/src/chm_common.c: 1137 +# error(_("chm_diagN2U(x, uploT = %d): uploT should be +- 1"), uploT) +#, c-format +#~ msgid "chm_diagN2U(x, uploT = %d): uploT should be +- 1" +#~ msgstr "chm_diagN2U(x, uploT = %d): 'uploT' powinien wynosić +/- 1" + +# Matrix/src/dgCMatrix.c: 156 +# error(_("dgCMatrix_lusol requires a square, non-empty matrix")) +#~ msgid "dgCMatrix_lusol requires a square, non-empty matrix" +#~ msgstr "'dgCMatrix_lusol' wymaga kwadratowej, niepustej macierzy" + +# Matrix/src/dppMatrix.c: 81 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dpoMatrix.c: 92 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dpoMatrix.c: 117 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dsyMatrix.c: 85 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dtCMatrix.c: 90 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dtCMatrix.c: 106 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dgCMatrix.c: 158 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dgCMatrix.c: 184 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dgCMatrix.c: 438 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dgCMatrix.c: 471 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dtrMatrix.c: 99 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dgeMatrix.c: 423 +# error(_("Dimensions of system to be solved are inconsistent")) +# Matrix/src/dspMatrix.c: 79 +# error(_("Dimensions of system to be solved are inconsistent")) +#~ msgid "Dimensions of system to be solved are inconsistent" +#~ msgstr "Wymiary systemu, który ma być rozwiązany, są niespójne" + +# Matrix/src/dgCMatrix.c: 160 +# error(_("cs_lusol failed")) +#~ msgid "cs_lusol failed" +#~ msgstr "'cs_lusol' nie powiódł się" + +# Matrix/src/dgCMatrix.c: 181 +# error(_("'dgCMatrix_qrsol(., order)' function needs order in {0,..,3}")) +#~ msgid "dgCMatrix_qrsol(., order) needs order in {0,..,3}" +#~ msgstr "" +#~ "funkcja 'dgCMatrix_qrsol(., order)' potrzebuje zmiennej 'order' ze zbioru " +#~ "{0,..,3}" + +# Matrix/src/dgCMatrix.c: 190 +# error(_("'dgCMatrix_qrsol(<%d x %d>-matrix)' function requires a 'tall' rectangular matrix"), +# xc->m, xc->n) +#, c-format +#~ msgid "" +#~ "dgCMatrix_qrsol(<%d x %d>-matrix) requires a 'tall' rectangular matrix" +#~ msgstr "" +#~ "funkcja 'dgCMatrix_qrsol(macierz <%d x %d>)' wymaga długiej prostokątnej " +#~ "macierzy" + +# Matrix/src/dgCMatrix.c: 201 +# error(_("'cs_qrsol()' function failed inside 'dgCMatrix_qrsol()' function")) +#~ msgid "cs_qrsol() failed inside dgCMatrix_qrsol()" +#~ msgstr "" +#~ "funkcja 'cs_qrsol()' nie powiodła się wewnątrz funkcji 'dgCMatrix_qrsol()'" + +# Matrix/src/dgCMatrix.c: 469 +# error(_("'dgCMatrix_cholsol' function requires a 'short, wide' rectangular matrix")) +#~ msgid "dgCMatrix_cholsol requires a 'short, wide' rectangular matrix" +#~ msgstr "" +#~ "funkcja 'dgCMatrix_cholsol()' wymaga krótkiej lub szerokiej macierzy " +#~ "prostokątnej" + +# Matrix/src/dgCMatrix.c: 477 +# error(_("'cholmod_sdmult' function error (rhs)")) +#~ msgid "cholmod_sdmult error (rhs)" +#~ msgstr "błąd funkcji 'cholmod_sdmult' (prawa strona)" + +# Matrix/src/CHMfactor.c: 135 +# error(_("cholmod_factorize_p failed: status %d, minor %d of ncol %d"), +# c.status, f->minor, f->n) +#, c-format +#~ msgid "cholmod_factorize failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "'cholmod_factorize_p' nie powiódł się: status %d, minor %d liczba kolumn " +#~ "%d" + +# Matrix/src/dgCMatrix.c: 484 +# error(_("'cholmod_solve' function (CHOLMOD_A) failed: status %d, minor %d from ncol %d"), +# c.status, L->minor, L->n) +#, c-format +#~ msgid "cholmod_solve (CHOLMOD_A) failed: status %d, minor %d from ncol %d" +#~ msgstr "" +#~ "funkcja 'cholmod_solve' (CHOLMOD_A) nie powiodła się: status %d, minor %d " +#~ "z liczbą kolumn %d" + +# Matrix/src/dgCMatrix.c: 501 +# error(_("'cholmod_sdmult' function error (resid)")) +#~ msgid "cholmod_sdmult error (resid)" +#~ msgstr "błąd funkcji 'cholmod_sdmult' (reszta)" + +# Matrix/src/dgCMatrix.c: 293 +# error(_("'SuiteSparseQR_C_QR' function returned an error code")) +#~ msgid "SuiteSparseQR_C_QR returned an error code" +#~ msgstr "funkcja 'SuiteSparseQR_C_QR()' zwróciła kod błędu" + +# Matrix/src/dgeMatrix.c: 428 +# error(_("Lapack routine 'dgetrs()': system is exactly singular")) +#, fuzzy, c-format +#~ msgid "LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d" +#~ msgstr "procedura Lapack 'dgetrs()': system jest ściśle osobliwy" + +# Matrix/src/dppMatrix.c: 34 +# error(_("the leading minor of order %d is not positive definite"), +# info) +# Matrix/src/dpoMatrix.c: 40 +# error(_("the leading minor of order %d is not positive definite"), +# info) +#, fuzzy, c-format +#~ msgid "" +#~ "LAPACK routine '%s': leading principal minor of order %d is not positive" +#~ msgstr "wiodący minor rzędu %d nie jest dodatnio określony" + +# Matrix/src/init.c: 356 +# error(_("missing 'Matrix' namespace: should never happen")) +#, fuzzy +#~ msgid "missing 'Matrix' namespace; should never happen" +#~ msgstr "brakuje przestrzeni nazw 'Matrix': nie powinno się wydarzyć" + +# Matrix/src/init.c: 367 +# error(_("Matrix namespace not determined correctly")) +#, fuzzy +#~ msgid "'Matrix' namespace not determined correctly" +#~ msgstr "przestrzeń nazw macierzy nie została poprawnie określona" + +# Matrix/src/Csparse.c: 55 +# warning(_("Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix")) +#~ msgid "Csparse_sort(x): x is not a valid (apart from sorting) CsparseMatrix" +#~ msgstr "" +#~ "Csparse_sort(x): 'x' nie jest poprawnym (niezależnie od sortowania) " +#~ "obiektem klasy \"CsparseMatrix\"" + +# Matrix/src/cs_utils.c: 37 +# error(_("'csp_eye' function's argument 'n' must be positive")) +#~ msgid "csp_eye argument n must be positive" +#~ msgstr "argument 'n' w funkcji 'csp_eye()' musi być dodatni" + +# Matrix/src/cs_utils.c: 68 +# error(_("invalid class of 'x' argument in 'Matrix_as_cs(a, x)' function")) +#~ msgid "invalid class of 'x' in Matrix_as_cs(a, x)" +#~ msgstr "niepoprawna klasa argumentu 'x' w funkcji 'Matrix_as_cs(a, x)'" + +# Matrix/src/cs_utils.c: 170 +# error(_("invalid class of object to %s"), "Matrix_as_css") +# Matrix/src/cs_utils.c: 185 +# error(_("invalid class of object to %s"), "Matrix_as_css") +# Matrix/src/cs_utils.c: 205 +# error(_("invalid class of object to %s"), "Matrix_as_csn") +# Matrix/src/cs_utils.c: 218 +# error(_("invalid class of object to %s"), "Matrix_as_csn") +#, c-format +#~ msgid "invalid class of object to %s" +#~ msgstr "niepoprawna klasa obiektu przekazanego do '%s'" + +# Matrix/src/cs_utils.c: 139 +# error(_("cs matrix not compatible with class '%s'"), valid[ctype]) +#, c-format +#~ msgid "cs matrix not compatible with class '%s'" +#~ msgstr "'cs matrix' nie jest zgodne z klasą '%s'" + +# Matrix/src/cs_utils.c: 242 +# error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), +# cl) +# Matrix/src/cs_utils.c: 261 +# error(_("Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)"), +# cl) +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_css_to_SEXP(S, cl, ..)" +#~ msgstr "Niepoprawna klasa cl='%s' w 'Matrix_css_to_SEXP(S, cl, ..)'" + +# Matrix/src/cs_utils.c: 287 +# error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), +# cl) +# Matrix/src/cs_utils.c: 306 +# error(_("Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)"), +# cl) +#, c-format +#~ msgid "Inappropriate class cl='%s' in Matrix_csn_to_SEXP(S, cl, ..)" +#~ msgstr "Niepoprawna klasa cl='%s' w 'Matrix_csn_to_SEXP(S, cl, ..)'" + +# Matrix/src/dgeMatrix.c: 127 +# error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), +# tr ? "tcrossprod" : "crossprod") +# Matrix/src/dgeMatrix.c: 184 +# error(_("Dimensions of 'x' and 'y' are not compatible for '%s'"), +# tr ? "tcrossprod" : "crossprod") +#, c-format +#~ msgid "Dimensions of x and y are not compatible for %s" +#~ msgstr "Wymiary 'x' oraz 'y' nie są zgodne dla '%s'" + +# Matrix/src/dgeMatrix.c: 166 +# error(_("'y' argument must be numeric or integer")) +#, fuzzy +#~ msgid "Argument y must be numeric, integer or logical" +#~ msgstr "Argument 'y' musi być liczbą lub rzeczywistą lub całkowitą" + +# Matrix/src/dsyMatrix.c: 122 +# error(_("Matrices are not conformable for multiplication")) +# Matrix/src/dtrMatrix.c: 123 +# error(_("Matrices are not conformable for multiplication")) +# Matrix/src/dgeMatrix.c: 447 +# error(_("Matrices are not conformable for multiplication")) +# Matrix/src/dgeMatrix.c: 469 +# error(_("Matrices are not conformable for multiplication")) +# Matrix/src/dspMatrix.c: 153 +# error(_("Matrices are not conformable for multiplication")) +#~ msgid "Matrices are not conformable for multiplication" +#~ msgstr "Macierze nie są dostosowane do przemnożenia" + +# Matrix/src/dtrMatrix.c: 121 +# error(_("object of class \"dtrMatrix\" must be square")) +#~ msgid "dtrMatrix must be square" +#~ msgstr "obiekt klasy \"dtrMatrix\" musi być kwadratowy" + +# Matrix/src/dtpMatrix.c: 125 +# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), +# xDim[0], xDim[1], yDim[0], yDim[1]) +# Matrix/src/dtpMatrix.c: 153 +# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), +# aDim[0], aDim[1], bDim[0], bDim[1]) +# Matrix/src/dtpMatrix.c: 184 +# error(_("Dimensions of 'a' (%d,%d) and 'b' (%d,%d) do not conform"), +# xDim[0], xDim[1], yDim[0], yDim[1]) +#, c-format +#~ msgid "Dimensions of a (%d,%d) and b (%d,%d) do not conform" +#~ msgstr "Wymiary 'a' (%d,%d) oraz 'b' (%d,%d) nie pokrywają się" + +# Matrix/src/dtpMatrix.c: 132 +# error(_("right=TRUE is not yet implemented __ FIXME")) +#~ msgid "right=TRUE is not yet implemented __ FIXME" +#~ msgstr "'right = TRUE' nie jest jeszcze zaimplementowane __ NAPRAW_MNIE" + # Matrix/src/CHMfactor.c: 14 # error(_("cholmod_change_factor failed with status %d"), c.status) #, c-format @@ -2333,11 +2370,6 @@ #~ msgid "cs_sqr failed" #~ msgstr "funkcja 'cs_lusol()' nie powiodła się" -# Matrix/src/dgCMatrix.c: 160 -# error(_("cs_lusol failed")) -#~ msgid "cs_qr failed" -#~ msgstr "funkcja 'cs_qr' nie powiodła się " - # Matrix/src/dgCMatrix.c: 337 # error(_("LU decomposition applies only to square matrices")) #~ msgid "LU decomposition applies only to square matrices" diff -Nru rmatrix-1.6-1.1/src/CHMfactor.c rmatrix-1.6-5/src/CHMfactor.c --- rmatrix-1.6-1.1/src/CHMfactor.c 2023-07-29 15:43:57.000000000 +0000 +++ rmatrix-1.6-5/src/CHMfactor.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,73 +0,0 @@ - /* CHOLMOD factors */ -#include "CHMfactor.h" - -/** - * 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; -} - -/** - * 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; -} diff -Nru rmatrix-1.6-1.1/src/CHMfactor.h rmatrix-1.6-5/src/CHMfactor.h --- rmatrix-1.6-1.1/src/CHMfactor.h 2023-07-29 15:43:57.000000000 +0000 +++ rmatrix-1.6-5/src/CHMfactor.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,10 +0,0 @@ -#ifndef MATRIX_CHMFACTOR_H -#define MATRIX_CHMFACTOR_H - -#include "chm_common.h" -#include "Mutils.h" - -double chm_factor_ldetL2(CHM_FR f); -CHM_FR chm_factor_update(CHM_FR f, CHM_SP A, double fac); - -#endif diff -Nru rmatrix-1.6-1.1/src/Csparse.c rmatrix-1.6-5/src/Csparse.c --- rmatrix-1.6-1.1/src/Csparse.c 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/src/Csparse.c 2023-10-24 05:06:06.000000000 +0000 @@ -1,128 +1,206 @@ -/** @file Csparse.c - * The "CsparseMatrix" class from R package Matrix: - * - * Sparse matrices in compressed column-oriented form - */ +#include "Mdefines.h" +#include "cs-etc.h" +#include "cholmod-etc.h" #include "Csparse.h" -#include "chm_common.h" -#include "cs_utils.h" /* -> ./cs.h for cs_dmperm() */ -#define _t_Csparse_validate -#include "t_Csparse_validate.c" +/* .validateCsparse(x, sort.if.needed = TRUE) */ +SEXP CsparseMatrix_validate_maybe_sorting(SEXP x) +{ -#define _t_Csparse_sort -#include "t_Csparse_validate.c" +#define MKMS(_FORMAT_, ...) mkString(Matrix_sprintf(_FORMAT_, __VA_ARGS__)) -// R: .validateCsparse(x, sort.if.needed = FALSE) : -SEXP Csparse_validate2(SEXP x, SEXP maybe_modify) { - return Csparse_validate_(x, asLogical(maybe_modify)); -} + /* defined in ./chm_common.c : */ + SEXP checkpi(SEXP p, SEXP i, int m, int n); -// 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 dim = GET_SLOT(x, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; -/** "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 p = PROTECT(GET_SLOT(x, Matrix_pSym)), + i = PROTECT(GET_SLOT(x, Matrix_iSym)), + cpi = PROTECT(checkpi(p, i, m, n)); + + if (TYPEOF(cpi) == LGLSXP && !LOGICAL(cpi)[0]) { + cholmod_sparse *A = M2CHS(x, 1); + A->sorted = 0; + if (!cholmod_sort(A, &c)) + error(_("'%s' failed"), "cholmod_sort"); + int *pp = (int *) A->p, *pi = (int *) A->i, i0, ik, j, k, kend; + for (j = 1, k = 0; j <= n; ++j) { + kend = pp[j]; + i0 = -1; + while (k < kend) { + ik = pi[k]; + if (ik <= i0) { + UNPROTECT(3); /* cpi, i, p */ + return MKMS(_("'%s' slot is not increasing within columns after sorting"), + "i"); + } + i0 = ik; + ++k; + } + } + LOGICAL(cpi)[0] = 1; + } + + UNPROTECT(3); /* cpi, i, p */ + return cpi; } -/** @brief Horizontal Concatenation - cbind( , ) - */ -SEXP Csparse_horzcat(SEXP x, SEXP y) +static +int strmatch(const char *x, const char **valid) { -#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 = PROTECT( - 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); \ - UNPROTECT(1); - - CSPARSE_CAT_CLEANUP; - return retval; + int i = 0; + while (valid[i][0] != '\0') { + if (strcmp(x, valid[i]) == 0) + return i; + ++i; + } + return -1; } -/** @brief Vertical Concatenation - rbind( , ) - */ -SEXP Csparse_vertcat(SEXP x, SEXP y) +/* (diag(obj)) where obj=dCHMsimpl (LDLt) or obj=dtCMatrix (nonunit) */ +SEXP tCsparse_diag(SEXP obj, SEXP op) { - CSPARSE_CAT("vertcat"); - // TODO: currently drops dimnames - and we fix at R level; + static const char *valid[] = { + /* 0 */ "trace", + /* 1 */ "sumLog", + /* 2 */ "prod", + /* 3 */ "min", + /* 4 */ "max", + /* 5 */ "range", + /* 6 */ "diag", + /* 7 */ "diagBack", ""}; + int ivalid = -1; + if (TYPEOF(op) != STRSXP || LENGTH(op) < 1 || + (op = STRING_ELT(op, 0)) == NA_STRING || + (ivalid = strmatch(CHAR(op), valid)) < 0) + error(_("invalid '%s' to '%s'"), "op", __func__); + + SEXP uplo = getAttrib(obj, Matrix_uploSym); + char ul = (TYPEOF(uplo) == STRSXP && LENGTH(uplo) > 0) + ? *CHAR(STRING_ELT(uplo, 0)) : 'L'; + + SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)); + int *pp = INTEGER(p) + 1, j, k = 0, kend, n = (int) (XLENGTH(p) - 1), + len = (ivalid < 5) ? 1 : ((ivalid < 6) ? 2 : n); + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + double *px = REAL(x), tmp; + + SEXP ans = PROTECT(allocVector(REALSXP, len)); + double *pans = REAL(ans); + + switch (ivalid) { + case 0: /* trace */ + pans[0] = 0.0; + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend) + pans[0] += px[(ul == 'U') ? kend - 1 : k]; + k = kend; + } + break; + case 1: /* sumLog */ + pans[0] = 0.0; + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend) + pans[0] += log(px[(ul == 'U') ? kend - 1 : k]); + k = kend; + } + break; + case 2: /* prod */ + pans[0] = 1.0; + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend) + pans[0] *= px[(ul == 'U') ? kend - 1 : k]; + else + pans[0] *= 0.0; + k = kend; + } + break; + case 3: /* min */ + pans[0] = R_PosInf; + for (j = 0; j < n; ++j) { + kend = pp[j]; + tmp = (k < kend) ? px[(ul == 'U') ? kend - 1 : k] : 0.0; + if (ISNAN(tmp)) { + pans[0] = tmp; + break; + } + else if (tmp < pans[0]) + pans[0] = tmp; + k = kend; + } + break; + case 4: /* max */ + pans[0] = R_NegInf; + for (j = 0; j < n; ++j) { + kend = pp[j]; + tmp = (k < kend) ? px[(ul == 'U') ? kend - 1 : k] : 0.0; + if (ISNAN(tmp)) { + pans[0] = tmp; + break; + } + else if (tmp > pans[0]) + pans[0] = tmp; + k = kend; + } + break; + case 5: /* range */ + pans[0] = R_PosInf; + pans[1] = R_NegInf; + for (j = 0; j < n; ++j) { + kend = pp[j]; + tmp = (k < kend) ? px[(ul == 'U') ? kend - 1 : k] : 0.0; + if (ISNAN(tmp)) { + pans[0] = pans[1] = tmp; + break; + } + else if (tmp < pans[0]) + pans[0] = tmp; + else if (tmp > pans[1]) + pans[1] = tmp; + k = kend; + } + break; + case 6: /* diag */ + case 7: /* diagBack */ + { + + int *pperm = NULL; + if (ivalid == 7) { + SEXP perm = getAttrib(obj, Matrix_permSym); + if (TYPEOF(perm) == INTSXP && LENGTH(perm) == n) + pperm = INTEGER(perm); + } + for (j = 0; j < n; ++j) { + kend = pp[j]; + pans[(pperm) ? pperm[j] : j] = + (k < kend) ? px[(ul == 'U') ? kend - 1 : k] : 0.0; + k = kend; + } + break; + } + default: + break; + } - SEXP retval = PROTECT( - chm_sparse_to_SEXP(cholmod_vertcat(chx, chy, 1, &c), - 1, 0, Rkind, "", R_NilValue)); - CSPARSE_CAT_CLEANUP; - return retval; + UNPROTECT(3); + return ans; } -#define _d_Csp_ +enum x_slot_kind { + x_unknown = -2, /* NA */ + x_pattern = -1, /* n */ + x_double = 0, /* d */ + x_logical = 1, /* l */ + x_integer = 2, /* i */ + x_complex = 3}; /* z */ + +/* x[i, j] <- value where x=<.[gt]CMatrix> and value=<.sparseVector> */ +#define _n_Csp_ #include "t_Csparse_subassign.c" #define _l_Csp_ @@ -131,249 +209,115 @@ #define _i_Csp_ #include "t_Csparse_subassign.c" -#define _n_Csp_ +#define _d_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; -} - -// seed will *not* be used unless it's -1 (inverse perm.) or 0 ("no" / identity) perm. -static csd* Csparse_dmperm_raw(SEXP mat, SEXP seed) +/* dmperm(x, nAns, seed) */ +SEXP Csparse_dmperm(SEXP x, SEXP nans, SEXP seed) { - mat = PROTECT(duplicate(mat)); - CSP matx = AS_CSP__(mat); /* m x n ; compressed column, *double* 'x' or none */ - int iseed = asInteger(seed); - R_CheckStack(); - UNPROTECT(1); - return cs_dmperm(matx, iseed); // -> ./cs.c -} - -/* NB: cs.h defines the 'csd' struct as (NB: csi :== int in Matrix, for now) - - 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 ; -*/ - -/* MM: should allow to return the full info above - (Timothy Davis, p.126, explains why it's interesting ..) */ - -/* Here, return the full *named* list to R */ -SEXP Csparse_dmperm(SEXP mat, SEXP seed, SEXP nAns) { - csd *DMp = Csparse_dmperm_raw(mat, seed); - if(DMp == NULL) // "failure" in cs_dmperm() - return(R_NilValue); - int *dims = INTEGER(GET_SLOT(mat, Matrix_DimSym)), - m = dims[0], - n = dims[1], - n_ans = asInteger(nAns), - nb = DMp->nb; - - SEXP nms = PROTECT(allocVector(STRSXP, n_ans)); - SEXP ans = PROTECT(allocVector(VECSXP, n_ans)); - R_CheckStack(); - int *ip; - /* p : */SET_STRING_ELT(nms, 0, mkChar("p")); - SET_VECTOR_ELT(ans, 0, allocVector(INTSXP, m)); - ip = INTEGER(VECTOR_ELT(ans, 0)); - /* 0-based permutation: - * Memcpy(ip , (int*)(DMp->p), m); */ - // 1-based permutation: - for(int i=0; i < m; i++) ip[i] = DMp->p[i] + 1; - - /* q : */SET_STRING_ELT(nms, 1, mkChar("q")); - SET_VECTOR_ELT(ans, 1, allocVector(INTSXP, n)); - ip = INTEGER(VECTOR_ELT(ans, 1)); - /* 0-based permutation: - * Memcpy(ip , (int*)(DMp->q), m); */ - // 1-based permutation: - for(int i=0; i < n; i++) ip[i] = DMp->q[i] + 1; - - if(n_ans > 2) { - /* r : */ SET_STRING_ELT(nms, 2, mkChar("r")); - SET_VECTOR_ELT(ans, 2, allocVector(INTSXP, nb+1)); - Memcpy(INTEGER(VECTOR_ELT(ans, 2)), (int*)(DMp->r), nb+1); - - /* s : */ SET_STRING_ELT(nms, 3, mkChar("s")); - SET_VECTOR_ELT(ans, 3, allocVector(INTSXP, nb+1)); - Memcpy(INTEGER(VECTOR_ELT(ans, 3)), (int*)(DMp->s), nb+1); - if(n_ans > 4) { - /* rr5 :*/ SET_STRING_ELT(nms, 4, mkChar("rr5")); - SET_VECTOR_ELT(ans, 4, allocVector(INTSXP, 5)); - Memcpy(INTEGER(VECTOR_ELT(ans, 4)), (int*)(DMp->rr), 5); - - /* cc5 :*/ SET_STRING_ELT(nms, 5, mkChar("cc5")); - SET_VECTOR_ELT(ans, 5, allocVector(INTSXP, 5)); - Memcpy(INTEGER(VECTOR_ELT(ans, 5)), (int*)(DMp->cc), 5); - } - } - setAttrib(ans, R_NamesSymbol, nms); - DMp = cs_dfree(DMp); - UNPROTECT(2); - return ans; + Matrix_cs *A = M2CXS(x, 0); + MCS_XTYPE_SET(A->xtype); + Matrix_csd *D = Matrix_cs_dmperm(A, asInteger(seed)); + if (!D) + return R_NilValue; /* MJ: why not an error ... ? */ + int len = asInteger(nans); + if (len < 0) + len = 0; + else if (len > 6) + len = 6; + SEXP nms = PROTECT(allocVector(STRSXP, len)), + ans = PROTECT(allocVector(VECSXP, len)), tmp; + int k = len - 1; + switch (len) { + case 6: + SET_STRING_ELT(nms, k, mkChar("cc5")); + tmp = allocVector(INTSXP, 5); + memcpy(INTEGER(tmp), D->cc, 5 * sizeof(int)); + SET_VECTOR_ELT(ans, k, tmp); + k--; + case 5: + SET_STRING_ELT(nms, k, mkChar("rr5")); + tmp = allocVector(INTSXP, 5); + memcpy(INTEGER(tmp), D->rr, 5 * sizeof(int)); + SET_VECTOR_ELT(ans, k, tmp); + k--; + case 4: + SET_STRING_ELT(nms, k, mkChar("s")); + tmp = allocVector(INTSXP, D->nb + 1); + memcpy(INTEGER(tmp), D->s, (D->nb + 1) * sizeof(int)); + SET_VECTOR_ELT(ans, k, tmp); + k--; + case 3: + SET_STRING_ELT(nms, k, mkChar("r")); + tmp = allocVector(INTSXP, D->nb + 1); + memcpy(INTEGER(tmp), D->r, (D->nb + 1) * sizeof(int)); + SET_VECTOR_ELT(ans, k, tmp); + k--; + case 2: + SET_STRING_ELT(nms, k, mkChar("q")); + tmp = allocVector(INTSXP, A->n); + for (int j = 0, *q0 = D->q, *q1 = INTEGER(tmp); j < A->n; ++j) + q1[j] = q0[j] + 1; + SET_VECTOR_ELT(ans, k, tmp); + k--; + case 1: + SET_STRING_ELT(nms, k, mkChar("p")); + tmp = allocVector(INTSXP, A->m); + for (int i = 0, *p0 = D->p, *p1 = INTEGER(tmp); i < A->m; ++i) + p1[i] = p0[i] + 1; + SET_VECTOR_ELT(ans, k, tmp); + k--; + default: + break; + } + D = Matrix_cs_dfree(D); + setAttrib(ans, R_NamesSymbol, nms); + UNPROTECT(2); + return ans; } -/** - * 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 - */ -static -SEXP diag_tC_ptr(int n, int *x_p, double *x_x, Rboolean is_U, int *perm, -/* ^^^^^^ FIXME[Generalize] to int / ... -- via x_slot_kind ? */ - SEXP resultKind) +/* writeMM(obj, file) */ +SEXP Csparse_MatrixMarket(SEXP obj, SEXP path) { - 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] */ + static const char *valid[] = { VALID_CSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); + const char *class = valid[ivalid]; + + PROTECT_INDEX pid; + PROTECT_WITH_INDEX(obj, &pid); + if (class[0] == 'l' || class[1] == 'i') { + /* defined in ./coerce.c : */ + SEXP sparse_as_kind(SEXP, const char *, char); + REPROTECT(obj = sparse_as_kind(obj, class, 'd'), pid); + class = valid[R_check_class_etc(obj, valid)]; + } + if (class[1] == 't') { + /* defined in ./coerce.c : */ + SEXP sparse_as_general(SEXP, const char *); + REPROTECT(obj = sparse_as_general(obj, class), pid); + class = valid[R_check_class_etc(obj, valid)]; } - break; - - default: /* -1 from above */ - error(_("diag_tC(): invalid 'resultKind'")); - /* Wall: */ ans = R_NilValue; v = REAL(ans); - } - UNPROTECT(1); - return ans; -} + cholmod_sparse *A = M2CHS(obj, 1); + if (class[1] == 's') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + A->stype = (ul == 'U') ? 1 : -1; + } -/** - * 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; + const char *path_ = CHAR(asChar(path)); + FILE *f = fopen(path_, "w"); + if (!f) + error(_("failed to open file \"%s\" for writing"), path_); + if (!cholmod_write_sparse(f, A, (cholmod_sparse *) NULL, (char *) NULL, &c)) + error(_("'%s' failed"), "cholmod_write_sparse"); + fclose(f); - return diag_tC_ptr(n, x_p, x_x, is_U, perm, resultKind); + UNPROTECT(1); + return R_NilValue; } diff -Nru rmatrix-1.6-1.1/src/Csparse.h rmatrix-1.6-5/src/Csparse.h --- rmatrix-1.6-1.1/src/Csparse.h 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/src/Csparse.h 2023-09-26 21:39:15.000000000 +0000 @@ -1,23 +1,20 @@ #ifndef MATRIX_CSPARSE_H #define MATRIX_CSPARSE_H -#include "Mutils.h" +#include -SEXP Csparse_validate_(SEXP x, Rboolean maybe_modify); -SEXP Csparse_validate2(SEXP x, SEXP maybe_modify); -SEXP Csparse_sort(SEXP x); -SEXP Csparse_horzcat(SEXP x, SEXP y); -SEXP Csparse_vertcat(SEXP x, SEXP y); - -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 CsparseMatrix_validate_maybe_sorting(SEXP); -SEXP Csparse_MatrixMarket(SEXP x, SEXP fname); -SEXP Csparse_dmperm(SEXP mat, SEXP seed, SEXP nAns); +SEXP tCsparse_diag(SEXP, SEXP); -SEXP diag_tC(SEXP obj, SEXP resultKind); +SEXP nCsparse_subassign(SEXP, SEXP, SEXP, SEXP); +SEXP lCsparse_subassign(SEXP, SEXP, SEXP, SEXP); +SEXP iCsparse_subassign(SEXP, SEXP, SEXP, SEXP); +SEXP dCsparse_subassign(SEXP, SEXP, SEXP, SEXP); +SEXP zCsparse_subassign(SEXP, SEXP, SEXP, SEXP); -#endif +SEXP Csparse_dmperm(SEXP, SEXP, SEXP); + +SEXP Csparse_MatrixMarket(SEXP, SEXP); + +#endif /* MATRIX_CSPARSE_H */ diff -Nru rmatrix-1.6-1.1/src/Lapack-etc.h rmatrix-1.6-5/src/Lapack-etc.h --- rmatrix-1.6-1.1/src/Lapack-etc.h 2023-06-24 01:53:34.000000000 +0000 +++ rmatrix-1.6-5/src/Lapack-etc.h 2023-10-06 14:44:52.000000000 +0000 @@ -4,7 +4,7 @@ /* Copy and paste from WRE : */ // before any R headers, or define in PKG_CPPFLAGS -#ifndef USE_FC_LEN_T +#ifndef USE_FC_LEN_T # define USE_FC_LEN_T #endif #include @@ -18,4 +18,53 @@ # define FCONE #endif +#define ERROR_LAPACK_1(_ROUTINE_, _INFO_) \ +do { \ + if ((_INFO_) < 0) \ + error(_("LAPACK routine '%s': argument %d had illegal value"), \ + #_ROUTINE_, -(_INFO_)); \ +} while (0) + +#define ERROR_LAPACK_2(_ROUTINE_, _INFO_, _WARN_, _LETTER_) \ +do { \ + ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ + if ((_INFO_) > 0 && (_WARN_) > 0) { \ + if (_WARN_ > 1) \ + error (_("LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d"), \ + #_ROUTINE_, #_LETTER_, (_INFO_)); \ + else \ + warning(_("LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d"), \ + #_ROUTINE_, #_LETTER_, (_INFO_)); \ + } \ +} while (0) + +#define ERROR_LAPACK_3(_ROUTINE_, _INFO_, _WARN_, _NPROTECT_) \ +do { \ + ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ + if ((_INFO_) > 0 && (_WARN_) > 0) { \ + if (_WARN_ > 1) \ + error (_("LAPACK routine '%s': leading principal minor of order %d is not positive"), \ + #_ROUTINE_, (_INFO_)); \ + else { \ + warning(_("LAPACK routine '%s': leading principal minor of order %d is not positive"), \ + #_ROUTINE_, (_INFO_)); \ + UNPROTECT(_NPROTECT_); \ + return ScalarInteger(_INFO_); \ + } \ + } \ +} while (0) + +#define ERROR_LAPACK_4(_ROUTINE_, _INFO_, _RANK_, _WARN_) \ + do { \ + ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ + if ((_INFO_) > 0 && (_WARN_) > 0) { \ + if (_WARN_ > 1) \ + error (_("LAPACK routine '%s': matrix is rank deficient or not positive definite, the _computed_ rank is %d"), \ + #_ROUTINE_, (_RANK_)); \ + else \ + warning(_("LAPACK routine '%s': matrix is rank deficient or not positive definite, the _computed_ rank is %d"), \ + #_ROUTINE_, (_RANK_)); \ + } \ + } while (0) + #endif /* MATRIX_LAPACK_ETC_H */ diff -Nru rmatrix-1.6-1.1/src/Makevars rmatrix-1.6-5/src/Makevars --- rmatrix-1.6-1.1/src/Makevars 2020-02-15 17:44:50.000000000 +0000 +++ rmatrix-1.6-5/src/Makevars 2023-10-06 14:51:46.000000000 +0000 @@ -1,7 +1,7 @@ # -*- Makefile -*- -PKG_CPPFLAGS = -DNTIMER -I./SuiteSparse_config -DUSE_FC_LEN_T -## we use the BLAS and the LAPACK library: +PKG_CPPFLAGS = -I./SuiteSparse_config -DNTIMER +PKG_CFLAGS = $(C_VISIBILITY) PKG_LIBS = $(SUBLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) MkInclude = $(R_HOME)/etc${R_ARCH}/Makeconf diff -Nru rmatrix-1.6-1.1/src/Matrix-win.def rmatrix-1.6-5/src/Matrix-win.def --- rmatrix-1.6-1.1/src/Matrix-win.def 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/Matrix-win.def 2023-10-06 14:44:52.000000000 +0000 @@ -0,0 +1,3 @@ +LIBRARY Matrix.dll +EXPORTS + R_init_Matrix diff -Nru rmatrix-1.6-1.1/src/Mdefines.h rmatrix-1.6-5/src/Mdefines.h --- rmatrix-1.6-1.1/src/Mdefines.h 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/Mdefines.h 2023-10-24 20:28:51.000000000 +0000 @@ -1,12 +1,11 @@ #ifndef MATRIX_MDEFINES_H #define MATRIX_MDEFINES_H -#define Matrix_Domain "Matrix" -#define Matrix_CallocThreshold 10000 -#define Matrix_ErrorBufferSize 4096 +#include "version.h" -/* Eventually these will no longer be needed : */ -#undef Matrix_WithSPQR +#define Matrix_Domain "Matrix" +#define Matrix_CallocThreshold 8192 +#define Matrix_ErrorBufferSize 4096 /* NB: system headers should come before R headers */ @@ -18,12 +17,15 @@ #include #include #include +#include #ifdef INT_FAST64_MAX typedef int_fast64_t Matrix_int_fast64_t; +# define MATRIX_INT_FAST64_MIN INT_FAST64_MIN # define MATRIX_INT_FAST64_MAX INT_FAST64_MAX #else typedef long long Matrix_int_fast64_t; +# define MATRIX_INT_FAST64_MIN LLONG_MIN # define MATRIX_INT_FAST64_MAX LLONG_MAX #endif @@ -33,7 +35,6 @@ #include #include -#include /* Copy and paste from WRE : */ #ifdef ENABLE_NLS @@ -83,10 +84,7 @@ #ifndef R_DEFINES_H # 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 -#define HAS_SLOT(obj, name) R_has_slot(obj, name) /* Often used symbols, defined in ./init.c */ extern @@ -96,38 +94,25 @@ extern Rcomplex Matrix_zzero, Matrix_zone, Matrix_zna; /* 0+0i, 1+0i, NA+NAi */ -/* To become deprecated ... defensive code should PROTECT() more */ -#define class_P(x) CHAR(asChar(getAttrib(x, R_ClassSymbol))) -#define uplo_P(x) CHAR(STRING_ELT(GET_SLOT(x, Matrix_uploSym), 0)) -#define Uplo_P(x) (R_has_slot(x, Matrix_uploSym) ? uplo_P(x) : " ") -#define diag_P(x) CHAR(STRING_ELT(GET_SLOT(x, Matrix_diagSym), 0)) -#define Diag_P(x) (R_has_slot(x, Matrix_diagSym) ? diag_P(x) : " ") - -/* Ditto */ -#define slot_dup(dest, src, sym) \ - 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))) -#define slot_dup_if_not_null(dest, src, sym) \ - if (!isNull(GET_SLOT(src, sym))) \ - SET_SLOT(dest, sym, duplicate(GET_SLOT(src, sym))) - -#define MAXOF(x, y) ((x < y) ? y : x) -#define MINOF(x, y) ((x < y) ? x : y) +#define MINOF(x, y) ((x < y) ? x : y) +#define MAXOF(x, y) ((x < y) ? y : x) #define FIRSTOF(x, y) (x) #define SECONDOF(x, y) (y) +#define ISNA_PATTERN(_X_) (0) #define ISNA_LOGICAL(_X_) ((_X_) == NA_LOGICAL) #define ISNA_INTEGER(_X_) ((_X_) == NA_INTEGER) #define ISNA_REAL(_X_) (ISNAN(_X_)) #define ISNA_COMPLEX(_X_) (ISNAN((_X_).r) || ISNAN((_X_).i)) +#define ISNZ_PATTERN(_X_) ((_X_) != 0) #define ISNZ_LOGICAL(_X_) ((_X_) != 0) #define ISNZ_INTEGER(_X_) ((_X_) != 0) #define ISNZ_REAL(_X_) ((_X_) != 0.0) #define ISNZ_COMPLEX(_X_) ((_X_).r != 0.0 || (_X_).i != 0.0) +#define STRICTLY_ISNZ_PATTERN(_X_) \ + ( ISNZ_PATTERN(_X_)) #define STRICTLY_ISNZ_LOGICAL(_X_) \ (!ISNA_LOGICAL(_X_) && ISNZ_LOGICAL(_X_)) #define STRICTLY_ISNZ_INTEGER(_X_) \ @@ -137,6 +122,24 @@ #define STRICTLY_ISNZ_COMPLEX(_X_) \ (!ISNA_COMPLEX(_X_) && ISNZ_COMPLEX(_X_)) +#define NOTREAL_PATTERN(_X_) 0 +#define NOTREAL_LOGICAL(_X_) 0 +#define NOTREAL_INTEGER(_X_) 0 +#define NOTREAL_REAL(_X_) 0 +#define NOTREAL_COMPLEX(_X_) (_X_.i != 0.0) + +#define NOTCONJ_PATTERN(_X_, _Y_) \ + ((_X_ != 0) != (_Y_ != 0)) +#define NOTCONJ_LOGICAL(_X_, _Y_) \ + (_X_ != _Y_) +#define NOTCONJ_INTEGER(_X_, _Y_) \ + (_X_ != _Y_) +#define NOTCONJ_REAL(_X_, _Y_) \ + ((ISNAN(_X_)) ? !ISNAN(_Y_) : ISNAN(_Y_) || _X_ != _Y_) +#define NOTCONJ_COMPLEX(_X_, _Y_) \ + (((ISNAN(_X_.r)) ? !ISNAN(_Y_.r) : ISNAN(_Y_.r) || _X_.r != _Y_.r) || \ + ((ISNAN(_X_.i)) ? !ISNAN(_Y_.i) : ISNAN(_Y_.i) || _X_.r != -_Y_.r)) + #define INCREMENT_PATTERN(_X_, _Y_) \ do { \ _X_ = 1; \ @@ -173,18 +176,33 @@ _X_.i += _Y_.i; \ } while (0) -#define PM_AR21_UP(i, j) \ +#define ASSIGN_REAL(_X_, _Y_) \ + do { _X_ = _Y_ ; } while (0) +#define ASSIGN_COMPLEX(_X_, _Y_) \ + do { _X_.r = _Y_.r; _X_.i = _Y_.i; } while (0) + +#define SCALE1_REAL(_X_, _A_) \ + do { _X_ *= _A_; } while (0) +#define SCALE1_COMPLEX(_X_, _A_) \ + do { _X_.r *= _A_; _X_.i *= _A_; } while (0) + +#define SCALE2_REAL(_X_, _A_) \ + do { _X_ /= _A_; } while (0) +#define SCALE2_COMPLEX(_X_, _A_) \ + do { _X_.r /= _A_; _X_.i /= _A_; } while (0) + +#define PACKED_AR21_UP(i, j) \ ((R_xlen_t) ((i) + ((Matrix_int_fast64_t) (j) * ( (j) + 1)) / 2)) -#define PM_AR21_LO(i, j, m2) \ +#define PACKED_AR21_LO(i, j, m2) \ ((R_xlen_t) ((i) + ((Matrix_int_fast64_t) (j) * ((m2) - (j) - 1)) / 2)) -#define PM_LENGTH(m) \ +#define PACKED_LENGTH(m) \ ((R_xlen_t) ((m) + ((Matrix_int_fast64_t) (m) * ( (m) - 1)) / 2)) #define SHOW(...) __VA_ARGS__ #define HIDE(...) #define ERROR_INVALID_TYPE(_X_, _FUNC_) \ - error(_("invalid type \"%s\" in %s()"), \ + error(_("invalid type \"%s\" in '%s'"), \ type2char(TYPEOF(_X_)), _FUNC_) #define ERROR_INVALID_CLASS(_X_, _FUNC_) \ @@ -193,175 +211,95 @@ ERROR_INVALID_TYPE(_X_, _FUNC_); \ else { \ SEXP class = PROTECT(getAttrib(_X_, R_ClassSymbol)); \ - error(_("invalid class \"%s\" in %s()"), \ + error(_("invalid class \"%s\" in '%s'"), \ CHAR(STRING_ELT(class, 0)), _FUNC_); \ UNPROTECT(1); \ } \ } while (0) -/* For C-level isTriangular() : */ -#define RETURN_TRUE_OF_KIND(_KIND_) \ -do { \ - SEXP ans = PROTECT(allocVector(LGLSXP, 1)), \ - val = PROTECT(mkString(_KIND_)); \ - static SEXP sym = NULL; \ - if (!sym) \ - sym = install("kind"); \ - LOGICAL(ans)[0] = 1; \ - setAttrib(ans, sym, val); \ - UNPROTECT(2); /* val, ans */ \ - return ans; \ -} while (0) - -/* Define this to be CHOLMOD-compatible to some degree : */ -enum x_slot_kind { - x_unknown = -2, /* NA */ - x_pattern = -1, /* n */ - x_double = 0, /* d */ - x_logical = 1, /* l */ - x_integer = 2, /* i */ - x_complex = 3}; /* z */ - -#define Real_kind_(_x_) \ - (isReal(_x_) ? x_double : (isLogical(_x_) ? x_logical : x_pattern)) - -/* Requires 'x' slot, hence not for nsparseMatrix or indMatrix : */ -#define Real_kind(_x_) \ - (Real_kind_(GET_SLOT(_x_, Matrix_xSym))) - - -/* ==== CLASS LISTS ================================================= */ -/* Keep synchronized with ../inst/include/Matrix.h ! */ - -/* dpoMatrix->dsyMatrix, etc. */ -#define VALID_NONVIRTUAL_SHIFT(i, p2ind) \ - ((i >= 5) ? 0 : ((i >= 4) ? p2ind != 0 : ((i >= 2) ? 12 : 14))) - #define VALID_NONVIRTUAL_MATRIX \ /* 0 */ "dpoMatrix", "dppMatrix", \ /* 2 */ "corMatrix", "pcorMatrix", \ /* 4 */ "pMatrix", "indMatrix", \ -/* 6 */ "dgCMatrix", "dgRMatrix", "dgTMatrix", "dgeMatrix", "ddiMatrix", \ -/* 11 */ "dsCMatrix", "dsRMatrix", "dsTMatrix", "dsyMatrix", "dspMatrix", \ -/* 16 */ "dtCMatrix", "dtRMatrix", "dtTMatrix", "dtrMatrix", "dtpMatrix", \ +/* 6 */ "ngCMatrix", "ngRMatrix", "ngTMatrix", "ngeMatrix", "ndiMatrix", \ +/* 11 */ "nsCMatrix", "nsRMatrix", "nsTMatrix", "nsyMatrix", "nspMatrix", \ +/* 16 */ "ntCMatrix", "ntRMatrix", "ntTMatrix", "ntrMatrix", "ntpMatrix", \ /* 21 */ "lgCMatrix", "lgRMatrix", "lgTMatrix", "lgeMatrix", "ldiMatrix", \ /* 26 */ "lsCMatrix", "lsRMatrix", "lsTMatrix", "lsyMatrix", "lspMatrix", \ /* 31 */ "ltCMatrix", "ltRMatrix", "ltTMatrix", "ltrMatrix", "ltpMatrix", \ -/* 36 */ "ngCMatrix", "ngRMatrix", "ngTMatrix", "ngeMatrix", "ndiMatrix", \ -/* 41 */ "nsCMatrix", "nsRMatrix", "nsTMatrix", "nsyMatrix", "nspMatrix", \ -/* 46 */ "ntCMatrix", "ntRMatrix", "ntTMatrix", "ntrMatrix", "ntpMatrix", \ -/* 51 */ "igCMatrix", "igRMatrix", "igTMatrix", "igeMatrix", "idiMatrix", \ -/* 56 */ "isCMatrix", "isRMatrix", "isTMatrix", "isyMatrix", "ispMatrix", \ -/* 61 */ "itCMatrix", "itRMatrix", "itTMatrix", "itrMatrix", "itpMatrix", \ +/* 36 */ "igCMatrix", "igRMatrix", "igTMatrix", "igeMatrix", "idiMatrix", \ +/* 41 */ "isCMatrix", "isRMatrix", "isTMatrix", "isyMatrix", "ispMatrix", \ +/* 46 */ "itCMatrix", "itRMatrix", "itTMatrix", "itrMatrix", "itpMatrix", \ +/* 51 */ "dgCMatrix", "dgRMatrix", "dgTMatrix", "dgeMatrix", "ddiMatrix", \ +/* 56 */ "dsCMatrix", "dsRMatrix", "dsTMatrix", "dsyMatrix", "dspMatrix", \ +/* 61 */ "dtCMatrix", "dtRMatrix", "dtTMatrix", "dtrMatrix", "dtpMatrix", \ /* 66 */ "zgCMatrix", "zgRMatrix", "zgTMatrix", "zgeMatrix", "zdiMatrix", \ /* 71 */ "zsCMatrix", "zsRMatrix", "zsTMatrix", "zsyMatrix", "zspMatrix", \ /* 76 */ "ztCMatrix", "ztRMatrix", "ztTMatrix", "ztrMatrix", "ztpMatrix" #define VALID_NONVIRTUAL_VECTOR \ -/* 81 */ "dsparseVector", "lsparseVector", "nsparseVector", \ - "isparseVector", "zsparseVector" +/* 81 */ "nsparseVector", "lsparseVector", "isparseVector", \ + "dsparseVector", "zsparseVector" #define VALID_NONVIRTUAL VALID_NONVIRTUAL_MATRIX, VALID_NONVIRTUAL_VECTOR -#define VALID_NDENSE \ -"ngeMatrix", "ntrMatrix", "nsyMatrix", "ntpMatrix", "nspMatrix" - -#define VALID_LDENSE \ -"lgeMatrix", "ltrMatrix", "lsyMatrix", "ltpMatrix", "lspMatrix" - -#define VALID_DDENSE \ -"dgeMatrix", "dtrMatrix", "dsyMatrix", "dtpMatrix", "dspMatrix" +/* dpoMatrix->dsyMatrix, etc. */ +#define VALID_NONVIRTUAL_SHIFT(i, pToInd) \ + ((i >= 5) ? 0 : ((i >= 4) ? pToInd != 0 : ((i >= 2) ? 57 : 59))) -#define VALID_NSPARSE \ -"ngCMatrix", "ngRMatrix", "ngTMatrix", \ -"ntCMatrix", "ntRMatrix", "ntTMatrix", \ -"nsCMatrix", "nsRMatrix", "nsTMatrix" - -#define VALID_LSPARSE \ -"lgCMatrix", "lgRMatrix", "lgTMatrix", \ -"ltCMatrix", "ltRMatrix", "ltTMatrix", \ -"lsCMatrix", "lsRMatrix", "lsTMatrix" - -#define VALID_DSPARSE \ -"dgCMatrix", "dgRMatrix", "dgTMatrix", \ -"dtCMatrix", "dtRMatrix", "dtTMatrix", \ -"dsCMatrix", "dsRMatrix", "dsTMatrix" +#define VALID_DENSE \ +"ngeMatrix", "nsyMatrix", "nspMatrix", "ntrMatrix", "ntpMatrix", \ +"lgeMatrix", "lsyMatrix", "lspMatrix", "ltrMatrix", "ltpMatrix", \ +"igeMatrix", "isyMatrix", "ispMatrix", "itrMatrix", "itpMatrix", \ +"dgeMatrix", "dsyMatrix", "dspMatrix", "dtrMatrix", "dtpMatrix", \ +"zgeMatrix", "zsyMatrix", "zspMatrix", "ztrMatrix", "ztpMatrix" #define VALID_CSPARSE \ -"dgCMatrix", "dtCMatrix", "dsCMatrix", \ -"lgCMatrix", "ltCMatrix", "lsCMatrix", \ -"ngCMatrix", "ntCMatrix", "nsCMatrix" +"ngCMatrix", "nsCMatrix", "ntCMatrix", \ +"lgCMatrix", "lsCMatrix", "ltCMatrix", \ +"igCMatrix", "isCMatrix", "itCMatrix", \ +"dgCMatrix", "dsCMatrix", "dtCMatrix", \ +"zgCMatrix", "zsCMatrix", "ztCMatrix" #define VALID_RSPARSE \ -"dgRMatrix", "dtRMatrix", "dsRMatrix", \ -"lgRMatrix", "ltRMatrix", "lsRMatrix", \ -"ngRMatrix", "ntRMatrix", "nsRMatrix" +"ngRMatrix", "nsRMatrix", "ntRMatrix", \ +"lgRMatrix", "lsRMatrix", "ltRMatrix", \ +"igRMatrix", "isRMatrix", "itRMatrix", \ +"dgRMatrix", "dsRMatrix", "dtRMatrix", \ +"zgRMatrix", "zsRMatrix", "ztRMatrix" #define VALID_TSPARSE \ -"dgTMatrix", "dtTMatrix", "dsTMatrix", \ -"lgTMatrix", "ltTMatrix", "lsTMatrix", \ -"ngTMatrix", "ntTMatrix", "nsTMatrix" +"ngTMatrix", "nsTMatrix", "ntTMatrix", \ +"lgTMatrix", "lsTMatrix", "ltTMatrix", \ +"igTMatrix", "isTMatrix", "itTMatrix", \ +"dgTMatrix", "dsTMatrix", "dtTMatrix", \ +"zgTMatrix", "zsTMatrix", "ztTMatrix" #define VALID_DIAGONAL \ -"ddiMatrix", "ldiMatrix" +"ndiMatrix", "ldiMatrix", "idiMatrix", "ddiMatrix", "zdiMatrix" -/* Older ones : */ -#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", \ -/* subclasses of the 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" +/* What we want declared "everywhere" : */ -#define MATRIX_VALID_Csparse \ -MATRIX_VALID_dCsparse, \ -"lgCMatrix", "lsCMatrix", "ltCMatrix", \ -MATRIX_VALID_nCsparse, \ -"zgCMatrix", "zsCMatrix", "ztCMatrix" +#include "utils.h" -#define MATRIX_VALID_Tsparse \ -"dgTMatrix", "dsTMatrix", "dtTMatrix", \ -"lgTMatrix", "lsTMatrix", "ltTMatrix", \ -"ngTMatrix", "nsTMatrix", "ntTMatrix", \ -"zgTMatrix", "zsTMatrix", "ztTMatrix" +SEXP newObject(const char *); +void validObject(SEXP, const char *); -#define MATRIX_VALID_Rsparse \ -"dgRMatrix", "dsRMatrix", "dtRMatrix", \ -"lgRMatrix", "lsRMatrix", "ltRMatrix", \ -"ngRMatrix", "nsRMatrix", "ntRMatrix", \ -"zgRMatrix", "zsRMatrix", "ztRMatrix" +char typeToKind(SEXPTYPE); +SEXPTYPE kindToType(char); +size_t kindToSize(char); + +int DimNames_is_trivial(SEXP); +int DimNames_is_symmetric(SEXP); -#define MATRIX_VALID_tri_Csparse \ -"dtCMatrix", "ltCMatrix", "ntCMatrix", "ztCMatrix" +void symDN(SEXP, SEXP, int); +void revDN(SEXP, SEXP); -#define MATRIX_VALID_sym_Csparse \ -"dsCMatrix", "lsCMatrix", "nsCMatrix", "zsCMatrix" +SEXP get_symmetrized_DimNames(SEXP, int); +SEXP get_reversed_DimNames(SEXP); -#define MATRIX_VALID_CHMfactor \ -"dCHMsuper", "dCHMsimpl", "nCHMsuper", "nCHMsimpl" +void set_symmetrized_DimNames(SEXP, SEXP, int); +void set_reversed_DimNames(SEXP, SEXP); #endif /* MATRIX_MDEFINES_H */ diff -Nru rmatrix-1.6-1.1/src/Minlines.h rmatrix-1.6-5/src/Minlines.h --- rmatrix-1.6-1.1/src/Minlines.h 2023-06-24 01:53:34.000000000 +0000 +++ rmatrix-1.6-5/src/Minlines.h 2023-09-29 19:53:32.000000000 +0000 @@ -1,75 +1,6 @@ #ifndef MATRIX_MINLINES_H #define MATRIX_MINLINES_H -/** - * 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; -} - -static R_INLINE -int strmatch(const char *x, const char **valid) -{ - int i = 0; - while (valid[i][0] != '\0') { - if (strcmp(x, valid[i]) == 0) - return i; - ++i; - } - return -1; -} - -static R_INLINE -int strmatch2(const char *x, SEXP valid) -{ - int i, n = LENGTH(valid); - for (i = 0; i < n; ++i) - if (strcmp(x, CHAR(STRING_ELT(valid, i))) == 0) - return i; - return -1; -} +/* Currently none ... */ #endif /* MATRIX_MINLINES_H */ diff -Nru rmatrix-1.6-1.1/src/Mutils.c rmatrix-1.6-5/src/Mutils.c --- rmatrix-1.6-1.1/src/Mutils.c 2023-08-03 17:50:13.000000000 +0000 +++ rmatrix-1.6-5/src/Mutils.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1671 +0,0 @@ -#include "Mutils.h" - -/** - * A safe version of `NEW_OBJECT(MAKE_CLASS(what))`, protecting the - * intermediate R object. The caller must protect the return value - * of this function. - * - * @param A string specifying the name of a defined S4 class. - */ -SEXP NEW_OBJECT_OF_CLASS(const char *what) -{ - SEXP class = PROTECT(MAKE_CLASS(what)), obj = NEW_OBJECT(class); - UNPROTECT(1); - return obj; -} - -/* memset() but passing length and size rather than their product - which can overflow size_t ... hence _safer_ than Memzero() -*/ -void *Matrix_memset(void *dest, int ch, R_xlen_t length, size_t size) -{ - if (dest && length > 0 && size > 0) { - - char *dest_ = (char *) dest; - size_t N = SIZE_MAX / size; - -#if (SIZE_MAX < R_XLEN_T_MAX) - R_xlen_t S_M = (R_xlen_t) SIZE_MAX; - if (length <= S_M) { -#endif - - /* 'length' is representable as size_t : */ - - size_t n = (size_t) length; - if (n <= N) - memset(dest_, ch, n * size); - else { - size_t d = N * size; - while (n > N) { - memset(dest_, ch, d); - dest_ += d; - n -= d; - } - memset(dest_, ch, n * size); - } - -#if (SIZE_MAX < R_XLEN_T_MAX) - } else { - - /* 'length' would overflow size_t : */ - - size_t n, d = N * size; - while (length > S_M) { - n = SIZE_MAX; - while (n > N) { - memset(dest_, ch, d); - dest_ += d; - n -= d; - } - memset(dest_, ch, n * size); - length -= S_M; - } - n = (size_t) length; - while (n > N) { - memset(dest_, ch, d); - dest_ += d; - n -= d; - } - memset(dest_, ch, n * size); - - } -#endif - - } - - return dest; -} - -/* memcpy() but passing length and size rather than their product - which can overflow size_t ... hence _safer_ than Memcpy() -*/ -void *Matrix_memcpy(void *dest, const void *src, R_xlen_t length, size_t size) -{ - if (dest && src && length > 0 && size > 0) { - - char *dest_ = (char *) dest; - const char *src_ = (const char *) src; - - size_t N = SIZE_MAX / size; - -#if (SIZE_MAX < R_XLEN_T_MAX) - R_xlen_t S_M = (R_xlen_t) SIZE_MAX; - if (length <= S_M) { -#endif - - /* 'length' is representable as size_t : */ - - size_t n = (size_t) length; - if (n <= N) - memcpy(dest_, src_, n * size); - else { - size_t d = N * size; - while (n > N) { - memcpy(dest_, src_, d); - dest_ += d; - src_ += d; - n -= d; - } - memcpy(dest_, src_, n * size); - } - -#if (SIZE_MAX < R_XLEN_T_MAX) - } else { - - /* 'length' would overflow size_t : */ - - size_t n, d = N * size; - while (length > S_M) { - n = SIZE_MAX; - while (n > N) { - memcpy(dest_, src_, d); - dest_ += d; - src_ += d; - n -= d; - } - memcpy(dest_, src_, n * size); - length -= S_M; - } - n = (size_t) length; - while (n > N) { - memcpy(dest_, src_, d); - dest_ += d; - n -= d; - } - memcpy(dest_, src_, n * size); - - } -#endif - - } - - return dest; -} - - -/* More for 'Dimnames' ============================================== */ - -Rboolean DimNames_is_trivial(SEXP dn) -{ - if (!(isNull(VECTOR_ELT(dn, 0)) && - isNull(VECTOR_ELT(dn, 1)))) - return FALSE; - Rboolean res = TRUE; - SEXP ndn = PROTECT(getAttrib(dn, R_NamesSymbol)); - if (!isNull(ndn)) - res = FALSE; - UNPROTECT(1); - return res; -} - -Rboolean DimNames_is_symmetric(SEXP dn) -{ - /* NB: Assuming here that we have the 'Dimnames' slot - of a _valid_ Matrix, so that the elements are either - NULL or character vectors - - Keep synchronized with symmetricMatrix_validate() above, - (which must do slightly more)! */ - - SEXP rn, cn; - int n; - if (!isNull(rn = VECTOR_ELT(dn, 0)) && - !isNull(cn = VECTOR_ELT(dn, 1)) && - rn != cn && - ((n = LENGTH(rn)) != LENGTH(cn) || !equal_string_vectors(rn, cn, n))) - return FALSE; - Rboolean res = TRUE; - SEXP ndn = PROTECT(getAttrib(dn, R_NamesSymbol)); - const char *ndn0, *ndn1; - if (!isNull(ndn) && - *(ndn0 = CHAR(STRING_ELT(ndn, 0))) != '\0' && - *(ndn1 = CHAR(STRING_ELT(ndn, 1))) != '\0' && - strcmp(ndn0, ndn1) != 0) - res = FALSE; - UNPROTECT(1); - return res; -} - -SEXP R_DimNames_is_symmetric(SEXP dn) -{ - return ScalarLogical(DimNames_is_symmetric(dn)); -} - -/** - * @brief Produce symmetric `Dimnames` from possibly asymmetric ones. - * - * Roughly `dest[1:2] <- rep(src[j], 2)`, where `j` is either 1 or 2 - * depending on `J`. If `J` is 0 or 1, then `j = J+1`. If `J` is -1, - * then `j = 1` if and only if `src[[2]]` is `NULL` and `src[[1]]` - * is not. For speed, it is assumed that `dest` is newly allocated, - * i.e., that it is `list(NULL, NULL)`. - * - * @param dest,src Lists of length 2, typically the `Dimnames` slots - * of two square `Matrix` of equal size. - * @param J An integer, one of -1, 0, and 1. - */ -void symmDN(SEXP dest, SEXP src, int J /* -1|0|1 */) -{ - SEXP s; - if (J < 0) { - if (!isNull(s = VECTOR_ELT(src, J = 1)) || - !isNull(s = VECTOR_ELT(src, J = 0))) { - SET_VECTOR_ELT(dest, 0, s); - SET_VECTOR_ELT(dest, 1, s); - } else { - J = 1; - } - } else { - if (!isNull(s = VECTOR_ELT(src, J))) { - SET_VECTOR_ELT(dest, 0, s); - SET_VECTOR_ELT(dest, 1, s); - } - } - /* names(dimnames(.)) */ - PROTECT(s = getAttrib(src, R_NamesSymbol)); - if (!isNull(s)) { - SEXP destnms = PROTECT(allocVector(STRSXP, 2)); - if (*CHAR(s = STRING_ELT(s, J)) != '\0') { - SET_STRING_ELT(destnms, 0, s); - SET_STRING_ELT(destnms, 1, s); - } - setAttrib(dest, R_NamesSymbol, destnms); - UNPROTECT(1); - } - UNPROTECT(1); - return; -} - -/** - * @brief Reverse (or "transpose") `Dimnames`. - * - * Roughly `dest[1:2] <- src[2:1]`. For speed, it is assumed that - * `dest` is newly allocated, i.e., that it is `list(NULL, NULL)`. - * - * @param dest,src Lists of length 2, typically the `Dimnames` slots - * of two square `Matrix` of equal size. - */ -void revDN(SEXP dest, SEXP src) { - SEXP s; - if (!isNull(s = VECTOR_ELT(src, 0))) - SET_VECTOR_ELT(dest, 1, s); - if (!isNull(s = VECTOR_ELT(src, 1))) - SET_VECTOR_ELT(dest, 0, s); - PROTECT(s = getAttrib(src, R_NamesSymbol)); - if (!isNull(s)) { - SEXP srcnms = s, destnms = PROTECT(allocVector(STRSXP, 2)); - if (*CHAR(s = STRING_ELT(srcnms, 0)) != '\0') - SET_STRING_ELT(destnms, 1, s); - if (*CHAR(s = STRING_ELT(srcnms, 1)) != '\0') - SET_STRING_ELT(destnms, 0, s); - setAttrib(dest, R_NamesSymbol, destnms); - UNPROTECT(1); - } - UNPROTECT(1); - return; -} - -SEXP R_symmDN(SEXP dn) -{ - /* Be fast (do nothing!) when dimnames = list(NULL, NULL) */ - if (DimNames_is_trivial(dn)) - return dn; - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - symmDN(newdn, dn, -1); - UNPROTECT(1); - return newdn; -} - -SEXP R_revDN(SEXP dn) -{ - /* Be fast (do nothing!) when dimnames = list(NULL, NULL) */ - if (DimNames_is_trivial(dn)) - return dn; - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - revDN(newdn, dn); - UNPROTECT(1); - return newdn; -} - -SEXP get_symmetrized_DimNames(SEXP obj, int J) { - SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - if (DimNames_is_trivial(dn)) { - UNPROTECT(1); - return dn; - } - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - symmDN(newdn, dn, J); - UNPROTECT(2); - return newdn; -} - -SEXP get_reversed_DimNames(SEXP obj) { - SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - if (DimNames_is_trivial(dn)) { - UNPROTECT(1); - return dn; - } - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - revDN(newdn, dn); - UNPROTECT(2); - return newdn; -} - -void set_symmetrized_DimNames(SEXP obj, SEXP dn, int J) { - if (!DimNames_is_trivial(dn)) { - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - symmDN(newdn, dn, J); - SET_SLOT(obj, Matrix_DimNamesSym, newdn); - UNPROTECT(1); - } - return; -} - -void set_reversed_DimNames(SEXP obj, SEXP dn) { - if (!DimNames_is_trivial(dn)) { - SEXP newdn = PROTECT(allocVector(VECSXP, 2)); - revDN(newdn, dn); - SET_SLOT(obj, Matrix_DimNamesSym, newdn); - UNPROTECT(1); - } - return; -} - -void set_DimNames(SEXP obj, SEXP dn) -{ - if (!DimNames_is_trivial(dn)) { - SEXP s, newdn = PROTECT(allocVector(VECSXP, 2)); - if (!isNull(s = VECTOR_ELT(dn, 0))) - SET_VECTOR_ELT(newdn, 0, s); - if (!isNull(s = VECTOR_ELT(dn, 1))) - SET_VECTOR_ELT(newdn, 1, s); - PROTECT(s = getAttrib(dn, R_NamesSymbol)); - if (!isNull(s)) - setAttrib(newdn, R_NamesSymbol, s); - SET_SLOT(obj, Matrix_DimNamesSym, newdn); - UNPROTECT(2); - } - return; -} - - -/* For 'factors' ==================================================== */ - -SEXP get_factor(SEXP obj, const char *nm) -{ - SEXP factors = PROTECT(GET_SLOT(obj, Matrix_factorSym)), val = R_NilValue; - if (LENGTH(factors) > 0) { - SEXP valid = PROTECT(getAttrib(factors, R_NamesSymbol)); - int i = strmatch2(nm, valid); - if (i >= 0) - val = VECTOR_ELT(factors, i); - UNPROTECT(1); - } - UNPROTECT(1); - return val; -} - -void set_factor(SEXP obj, const char *nm, SEXP val) -{ - PROTECT(val); - SEXP factors; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(factors = GET_SLOT(obj, Matrix_factorSym), &pid); - if (LENGTH(factors) > 0) { - SEXP valid = PROTECT(getAttrib(factors, R_NamesSymbol)); - int i = strmatch2(nm, valid); - UNPROTECT(1); - if (i >= 0) { - SET_VECTOR_ELT(factors, i, val); - UNPROTECT(2); - return; - } - } - REPROTECT(factors = append_to_named_list(factors, nm, val), pid); - SET_SLOT(obj, Matrix_factorSym, factors); - UNPROTECT(2); - return; -} - -/** - * @brief Subassign by name to the `factors` slot of a `compMatrix`. - * - * Like `obj\@factors[[nm]] <- val`, but modifying `obj` (rather than a copy) - * _even if_ `obj` is referenced elsewhere, supporting "automagic" caching of - * factorizations by R functions taking `compMatrix` as an argument. - * _Use with care!_ - * - * @param obj A `compMatrix`. - * @param nm A length-1 `STRSXP` giving a factor name. - * @param val A `SEXP`, usually a `MatrixFactorization`. - * @param warn A length-1 `LGLSXP`. Warn if `obj` has no `factors` slot - * (in which case `obj` is untouched)? - * - * @return `val`. - */ -SEXP R_set_factor(SEXP obj, SEXP nm, SEXP val, SEXP warn) -{ - if (TYPEOF(nm) != STRSXP || LENGTH(nm) < 1 || - (nm = STRING_ELT(nm, 0)) == NA_STRING) - error(_("invalid factor name")); - else if (HAS_SLOT(obj, Matrix_factorSym)) - set_factor(obj, CHAR(nm), val); - else if (asLogical(warn) != 0) - warning(_("attempt to set factor on %s without '%s' slot"), - "Matrix", "factors"); - return val; -} - -/** - * @brief Empty the 'factors' slot of a 'compMatrix'. - * - * Like `obj\@factors <- list()`, but modifying `obj` (rather than a copy) - * _even if_ `obj` is referenced elsewhere, supporting "automagic" clearing - * of the `factors` slot by R functions taking `compMatrix` as an argument. - * _Use with care!_ - * - * @param obj A `compMatrix`. - * @param warn A length-1 LGLSXP. Warn if `obj` has no `factors` slot - * (in which case `obj` is untouched)? - * - * @return `TRUE` if `obj` has a nonempty `factors` slot, `FALSE` otherwise. - */ -SEXP R_empty_factors(SEXP obj, SEXP warn) -{ - /* If there is a nonempty 'factors' slot, then replace it with list() */ - if (HAS_SLOT(obj, Matrix_factorSym)) { - SEXP factors = PROTECT(GET_SLOT(obj, Matrix_factorSym)); - if (LENGTH(factors) > 0) { - PROTECT(factors = allocVector(VECSXP, 0)); - SET_SLOT(obj, Matrix_factorSym, factors); - UNPROTECT(2); - return ScalarLogical(1); /* slot was reset */ - } - UNPROTECT(1); - } else if (asLogical(warn) != 0) - warning(_("attempt to discard factors from %s without '%s' slot"), - "Matrix", "factors"); - return ScalarLogical(0); /* no-op */ -} - - -/* For permutations ================================================= */ - -/* Poor man's C translation of LAPACK dswap */ -static void dswap(int n, double *x, int incx, double *y, int incy) -{ - double tmp; - while (n--) { - tmp = *x; - *x = *y; - *y = tmp; - x += incx; - y += incy; - } - return; -} - -/* Poor man's C translation of LAPACK dsyswapr */ -static void dsyswapr(char uplo, int n, double *x, int k0, int k1) -{ - double tmp, *x0 = x + (R_xlen_t) k0 * n, *x1 = x + (R_xlen_t) k1 * n; - if (uplo == 'U') { - dswap(k0, x0, 1, x1, 1); - tmp = x0[k0]; - x0[k0] = x1[k1]; - x1[k1] = tmp; - dswap(k1 - k0 - 1, x0 + k0 + n, n, x1 + k0 + 1, 1); - dswap(n - k1 - 1, x1 + k0 + n, n, x1 + k1 + n, n); - } else { - dswap(k0, x + k0, n, x + k1, n); - tmp = x0[k0]; - x0[k0] = x1[k1]; - x1[k1] = tmp; - dswap(k1 - k0 - 1, x0 + k0 + 1, 1, x0 + k1 + n, n); - dswap(n - k1 - 1, x0 + k1 + 1, 1, x1 + k1 + 1, 1); - } - return; -} - -void rowPerm(double *x, int m, int n, int *p, int off, int invert) -{ - int i, k0, k1; - for (i = 0; i < m; ++i) - p[i] = -(p[i] - off + 1); - if (!invert) { - for (i = 0; i < m; ++i) { - if (p[i] > 0) - continue; - k0 = i; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - while (p[k1] < 0) { - dswap(n, x + k0, m, x + k1, m); - k0 = k1; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - } - } - } else { - for (i = 0; i < m; ++i) { - if (p[i] > 0) - continue; - k0 = i; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - while (k1 != k0) { - dswap(n, x + k0, m, x + k1, m); - p[k1] = -p[k1]; - k1 = p[k1] - 1; - } - } - } - for (i = 0; i < m; ++i) - p[i] = p[i] + off - 1; - return; -} - -void symPerm(double *x, int n, char uplo, int *p, int off, int invert) -{ - int i, k0, k1; - for (i = 0; i < n; ++i) - p[i] = -(p[i] - off + 1); - if (!invert) { - for (i = 0; i < n; ++i) { - if (p[i] > 0) - continue; - k0 = i; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - while (p[k1] < 0) { - if (k0 < k1) - dsyswapr(uplo, n, x, k0, k1); - else - dsyswapr(uplo, n, x, k1, k0); - k0 = k1; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - } - } - } else { - for (i = 0; i < n; ++i) { - if (p[i] > 0) - continue; - k0 = i; - p[k0] = -p[k0]; - k1 = p[k0] - 1; - while (k1 != k0) { - if (k0 < k1) - dsyswapr(uplo, n, x, k0, k1); - else - dsyswapr(uplo, n, x, k1, k0); - p[k1] = -p[k1]; - k1 = p[k1] - 1; - } - } - } - for (i = 0; i < n; ++i) - p[i] = p[i] + off - 1; - return; -} - -int isPerm(const int *p, int n, int off) -{ - int res = 1; - if (n <= 0) - return res; - int i, j; - char *work; - Matrix_Calloc(work, n, char); - for (i = 0; i < n; ++i) { - if (p[i] == NA_INTEGER || (j = p[i] - off) < 0 || j >= n || work[j]) { - res = 0; - break; - } - work[j] = 1; - } - Matrix_Free(work, n); - return res; -} - -int signPerm(const int *p, int n, int off) -{ - if (!isPerm(p, n, off)) - error(_("attempt to get sign of non-permutation")); - int sign = 1; - if (n <= 0) - return sign; - int i, pos = 0; - char *work; - Matrix_Calloc(work, n, char); - while (pos < n) { - work[pos] = 1; - i = p[pos] - off; - while (!work[i]) { /* transposition */ - sign = -sign; - work[i] = 1; - i = p[i] - off; - } - while (pos < n && work[pos]) - ++pos; - } - Matrix_Free(work, n); - return sign; -} - -void invertPerm(const int *p, int *ip, int n, int off, int ioff) -{ - if (!isPerm(p, n, off)) - error(_("attempt to invert non-permutation")); - int j; - for (j = 0; j < n; ++j) - ip[p[j] - off] = j + ioff; - return; -} - -void asPerm(const int *p, int *ip, int m, int n, int off, int ioff) -{ - int i, j, tmp; - for (i = 0; i < n; ++i) - ip[i] = i + ioff; - for (i = 0; i < m; ++i) { - j = p[i] - off; - if (j < 0 || j >= n) - error(_("invalid transposition vector")); - if (j != i) { - tmp = ip[j]; - ip[j] = ip[i]; - ip[i] = tmp; - } - } - return; -} - -SEXP R_isPerm(SEXP p, SEXP off) -{ - if (TYPEOF(p) != INTSXP) - error(_("'%s' is not of type \"%s\""), "p", "integer"); - if (TYPEOF(off) != INTSXP) - error(_("'%s' is not of type \"%s\""), "off", "integer"); - if (XLENGTH(off) != 1) - error(_("'%s' does not have length %d"), "off", 1); - int off_ = INTEGER(off)[0]; - if (off_ == NA_INTEGER) - error(_("'%s' is NA"), "off"); - R_xlen_t n_ = XLENGTH(p); - if (n_ > INT_MAX) - return ScalarLogical(0); - return ScalarLogical(isPerm(INTEGER(p), (int) n_, off_)); -} - -SEXP R_signPerm(SEXP p, SEXP off) -{ - if (TYPEOF(p) != INTSXP) - error(_("'%s' is not of type \"%s\""), "p", "integer"); - if (TYPEOF(off) != INTSXP) - error(_("'%s' is not of type \"%s\""), "off", "integer"); - if (XLENGTH(off) != 1) - error(_("'%s' does not have length %d"), "off", 1); - int off_ = INTEGER(off)[0]; - if (off_ == NA_INTEGER) - error(_("'%s' is NA"), "off"); - R_xlen_t n_ = XLENGTH(p); - if (n_ > INT_MAX) - error(_("attempt to get sign of non-permutation")); - return ScalarInteger(signPerm(INTEGER(p), (int) n_, off_)); -} - -SEXP R_invertPerm(SEXP p, SEXP off, SEXP ioff) -{ - if (TYPEOF(p) != INTSXP) - error(_("'%s' is not of type \"%s\""), "p", "integer"); - if (TYPEOF(off) != INTSXP || TYPEOF(ioff) != INTSXP) - error(_("'%s' or '%s' is not of type \"%s\""), "off", "ioff", "integer"); - if (XLENGTH(off) != 1 || XLENGTH(ioff) != 1) - error(_("'%s' or '%s' does not have length %d"), "off", "ioff", 1); - int off_ = INTEGER(off)[0], ioff_ = INTEGER(ioff)[0]; - if (off_ == NA_INTEGER || ioff_ == NA_INTEGER) - error(_("'%s' or '%s' is NA"), "off", "ioff"); - R_xlen_t n_ = XLENGTH(p); - if (n_ > INT_MAX) - error(_("attempt to invert non-permutation")); - SEXP ip = PROTECT(allocVector(INTSXP, n_)); - invertPerm(INTEGER(p), INTEGER(ip), (int) n_, off_, ioff_); - UNPROTECT(1); - return ip; -} - -SEXP R_asPerm(SEXP p, SEXP off, SEXP ioff, SEXP n) -{ - if (TYPEOF(p) != INTSXP) - error(_("'%s' is not of type \"%s\""), "p", "integer"); - R_xlen_t m_ = XLENGTH(p); - if (m_ > INT_MAX) - error(_("'%s' has length exceeding %s"), "p", "2^31-1"); - if (TYPEOF(off) != INTSXP || TYPEOF(ioff) != INTSXP) - error(_("'%s' or '%s' is not of type \"%s\""), "off", "ioff", "integer"); - if (XLENGTH(off) != 1 || XLENGTH(ioff) != 1) - error(_("'%s' or '%s' does not have length %d"), "off", "ioff", 1); - int off_ = INTEGER(off)[0], ioff_ = INTEGER(ioff)[0]; - if (off_ == NA_INTEGER || ioff_ == NA_INTEGER) - error(_("'%s' or '%s' is NA"), "off", "ioff"); - if (TYPEOF(n) != INTSXP) - error(_("'%s' is not of type \"%s\""), "n", "integer"); - if (XLENGTH(n) != 1) - error(_("'%s' does not have length %d"), "n", 1); - int n_ = INTEGER(n)[0]; - if (n_ == NA_INTEGER || n_ < m_) - error(_("'%s' is NA or less than %s"), "n", "length(p)"); - SEXP ip = PROTECT(allocVector(INTSXP, n_)); - asPerm(INTEGER(p), INTEGER(ip), (int) m_, n_, off_, ioff_); - UNPROTECT(1); - return ip; -} - - -/* For inheritance ================================================== */ - -char type2kind(SEXPTYPE type) -{ - switch (type) { - case LGLSXP: - return 'l'; - case INTSXP: -#ifdef MATRIX_ENABLE_IMATRIX - return 'i'; -#endif - case REALSXP: - return 'd'; -#ifdef MATRIX_ENABLE_ZMATRIX - case CPLXSXP: - return 'z'; -#endif - default: - error(_("unexpected type \"%s\" in %s()"), type2char(type), __func__); - return '\0'; - } -} - -SEXPTYPE kind2type(char kind) -{ - switch (kind) { - case 'n': - case 'l': - return LGLSXP; -#ifdef MATRIX_ENABLE_IMATRIX - case 'i': - return INTSXP; -#endif - case 'd': - return REALSXP; -#ifdef MATRIX_ENABLE_ZMATRIX - case 'z': - return CPLXSXP; -#endif - default: - error(_("unexpected kind \"%c\" in %s()"), kind, __func__); - return NILSXP; - } -} - -size_t kind2size(char kind) -{ - switch (kind) { - case 'n': - case 'l': -#ifdef MATRIX_ENABLE_IMATRIX - case 'i': -#endif - return sizeof(int); - case 'd': - return sizeof(double); -#ifdef MATRIX_ENABLE_ZMATRIX - case 'z': - return sizeof(Rcomplex); -#endif - default: - error(_("unexpected kind \"%c\" in %s()"), kind, __func__); - return 0; - } -} - -const char *Matrix_nonvirtual(SEXP obj, int strict) -{ - if (!IS_S4_OBJECT(obj)) - return ""; - static const char *valid[] = { VALID_NONVIRTUAL, "" }; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - return ""; - if (!strict) - ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); - return valid[ivalid]; -} - -SEXP R_Matrix_nonvirtual(SEXP obj, SEXP strict) -{ - return mkString(Matrix_nonvirtual(obj, asLogical(strict))); -} - -#define RETURN_AS_STRSXP(_C_) \ -do { \ - char c = _C_; \ - if (!c) \ - return mkString(""); \ - else { \ - char s[] = { c, '\0' }; \ - return mkString(s); \ - } \ -} while (0) - -char Matrix_kind(SEXP obj, int i2d) -{ - if (IS_S4_OBJECT(obj)) { - static const char *valid[] = { VALID_NONVIRTUAL, "" }; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - return '\0'; - ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); - const char *cl = valid[ivalid]; - return (cl[2] == 'd') ? 'n' : cl[0]; - } else { - switch (TYPEOF(obj)) { - case LGLSXP: - return 'l'; - case INTSXP: - return (i2d) ? 'd' : 'i'; - case REALSXP: - return 'd'; - case CPLXSXP: - return 'z'; - default: - return '\0'; - } - } -} - -SEXP R_Matrix_kind(SEXP obj, SEXP i2d) -{ - RETURN_AS_STRSXP(Matrix_kind(obj, asLogical(i2d))); -} - -char Matrix_shape(SEXP obj) -{ - if (!IS_S4_OBJECT(obj)) - return '\0'; - static const char *valid[] = { VALID_NONVIRTUAL, "" }; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - return '\0'; - ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); - const char *cl = valid[ivalid]; - return (cl[2] == 'd' || cl[3] != 'M') ? 'g' : cl[1]; -} - -SEXP R_Matrix_shape(SEXP obj) -{ - RETURN_AS_STRSXP(Matrix_shape(obj)); -} - -char Matrix_repr(SEXP obj) -{ - if (!IS_S4_OBJECT(obj)) - return '\0'; - static const char *valid[] = { VALID_NONVIRTUAL_MATRIX, "" }; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - return '\0'; - ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); - const char *cl = valid[ivalid]; - switch (cl[2]) { - case 'e': - case 'r': - case 'y': - return 'u'; /* unpackedMatrix */ - case 'p': - return 'p'; /* packedMatrix */ - case 'C': - case 'R': - case 'T': - return cl[2]; /* [CRT]sparseMatrix */ - case 'i': - return 'd'; /* diagonalMatrix */ - case 'd': - return 'i'; /* indMatrix */ - default: - return '\0'; - } -} - -SEXP R_Matrix_repr(SEXP obj) -{ - RETURN_AS_STRSXP(Matrix_repr(obj)); -} - -#undef RETURN_AS_STRSXP - - -/* For indexing ===================================================== */ - -SEXP R_index_triangle(SEXP n, SEXP packed, SEXP upper, SEXP diag) -{ - SEXP r; - int i, j, n_ = asInteger(n), packed_ = asLogical(packed), - upper_ = asLogical(upper), diag_ = asLogical(diag); - Matrix_int_fast64_t - nn = (Matrix_int_fast64_t) n_ * n_, - nx = (packed_) ? n_ + (nn - n_) / 2 : nn, - nr = (diag_) ? n_ + (nn - n_) / 2 : (nn - n_) / 2; - if (nx > 0x1.0p+53) - error(_("indices would exceed %s"), "2^53"); - if (nr > R_XLEN_T_MAX) - error(_("attempt to allocate vector of length exceeding %s"), - "R_XLEN_T_MAX"); - if (nx > INT_MAX) { - - PROTECT(r = allocVector(REALSXP, (R_xlen_t) nr)); - double k = 1.0, nr_ = (double) nr, *pr = REAL(r); - -#define DO_INDEX \ - do { \ - if (packed_) { \ - if (diag_) { \ - while (k <= nr_) \ - *(pr++) = k++; \ - } else if (upper_) { \ - for (j = 0; j < n_; ++j) { \ - for (i = 0; i < j; ++i) \ - *(pr++) = k++; \ - k++; \ - } \ - } else { \ - for (j = 0; j < n_; ++j) { \ - k++; \ - for (i = j+1; i < n_; ++i) \ - *(pr++) = k++; \ - } \ - } \ - } else if (diag_) { \ - if (upper_) { \ - for (j = 0; j < n_; ++j) { \ - for (i = 0; i <= j; ++i) \ - *(pr++) = k++; \ - k += n_-j-1; \ - } \ - } else { \ - for (j = 0; j < n_; ++j) { \ - k += j; \ - for (i = j; i < n_; ++i) \ - *(pr++) = k++; \ - } \ - } \ - } else { \ - if (upper_) { \ - for (j = 0; j < n_; ++j) { \ - for (i = 0; i < j; ++i) \ - *(pr++) = k++; \ - k += n_-j; \ - } \ - } else { \ - for (j = 0; j < n_; ++j) { \ - k += j+1; \ - for (i = j+1; i < n_; ++i) \ - *(pr++) = k++; \ - } \ - } \ - } \ - } while (0) - - DO_INDEX; - - } else { - - PROTECT(r = allocVector(INTSXP, (R_xlen_t) nr)); - int k = 1, nr_ = (int) nr, *pr = INTEGER(r); - - DO_INDEX; - -#undef DO_INDEX - - } - - UNPROTECT(1); - return r; -} - -SEXP R_index_diagonal(SEXP n, SEXP packed, SEXP upper) -{ - SEXP r; - int j, n_ = asInteger(n), packed_ = asLogical(packed), - upper_ = asLogical(upper); - Matrix_int_fast64_t - nn = (Matrix_int_fast64_t) n_ * n_, - nx = (packed_) ? n_ + (nn - n_) / 2 : nn; - if (nx > 0x1.0p+53) - error(_("indices would exceed %s"), "2^53"); - if (nx > INT_MAX) { - - PROTECT(r = allocVector(REALSXP, n_)); - double k = 1.0, *pr = REAL(r); - -#define DO_INDEX \ - do { \ - if (!packed_) { \ - for (j = 0; j < n_; ++j) { \ - *(pr++) = k++; \ - k += n_; \ - } \ - } else if (upper_) { \ - for (j = 0; j < n_; ++j) { \ - *(pr++) = k; \ - k += j+2; \ - } \ - } else { \ - for (j = 0; j < n_; ++j) { \ - *(pr++) = k; \ - k += n_-j; \ - } \ - } \ - } while (0) - - DO_INDEX; - - } else { - - PROTECT(r = allocVector(INTSXP, n_)); - int k = 1, *pr = INTEGER(r); - DO_INDEX; - -#undef DO_INDEX - - } - - UNPROTECT(1); - return r; -} - - -/* "Miscellaneous" ================================================== */ - -SEXP R_nnz(SEXP x, SEXP countNA, SEXP nnzmax) -{ - int do_countNA = asLogical(countNA); - R_xlen_t n = XLENGTH(x), nnz = 0; - double n_ = asReal(nnzmax); - if (!ISNAN(n_) && n_ >= 0.0 && n_ < (double) n) - n = (R_xlen_t) n_; - -#define DO_NNZ(_CTYPE_, _PTR_, _NA_, _NZ_, _STRICTLY_NZ_) \ - do { \ - _CTYPE_ *px = _PTR_(x); \ - if (do_countNA == NA_LOGICAL) { \ - while (n-- > 0) { \ - if (_NA_(*px)) \ - return ScalarInteger(NA_INTEGER); \ - if (_NZ_(*px)) \ - ++nnz; \ - ++px; \ - } \ - } else if (do_countNA != 0) { \ - while (n-- > 0) { \ - if (_NZ_(*px)) \ - ++nnz; \ - ++px; \ - } \ - } else { \ - while (n-- > 0) { \ - if (_STRICTLY_NZ_(*px)) \ - ++nnz; \ - ++px; \ - } \ - } \ - } while (0) - - switch (TYPEOF(x)) { - case LGLSXP: - DO_NNZ(int, LOGICAL, - ISNA_LOGICAL, ISNZ_LOGICAL, STRICTLY_ISNZ_LOGICAL); - break; - case INTSXP: - DO_NNZ(int, INTEGER, - ISNA_INTEGER, ISNZ_INTEGER, STRICTLY_ISNZ_INTEGER); - break; - case REALSXP: - DO_NNZ(double, REAL, - ISNA_REAL, ISNZ_REAL, STRICTLY_ISNZ_REAL); - break; - case CPLXSXP: - DO_NNZ(Rcomplex, COMPLEX, - ISNA_COMPLEX, ISNZ_COMPLEX, STRICTLY_ISNZ_COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x, __func__); - } - -#undef DO_NNZ - - return (nnz <= INT_MAX) - ? ScalarInteger((int) nnz) : ScalarReal((double) nnz); -} - -void conjugate(SEXP x) -{ - Rcomplex *px = COMPLEX(x); - R_xlen_t nx = XLENGTH(x); - while (nx--) { - (*px).i = -(*px).i; - ++px; - } - return; -} - -void zeroRe(SEXP x) -{ - Rcomplex *px = COMPLEX(x); - R_xlen_t nx = XLENGTH(x); - while (nx--) { - if (!ISNAN((*px).r)) - (*px).r = 0.0; - ++px; - } - return; -} - -void zeroIm(SEXP x) -{ - Rcomplex *px = COMPLEX(x); - R_xlen_t nx = XLENGTH(x); - while (nx--) { - if (!ISNAN((*px).i)) - (*px).i = 0.0; - ++px; - } - return; -} - -void na2one(SEXP x) -{ - R_xlen_t i, n = XLENGTH(x); - switch (TYPEOF(x)) { - case LGLSXP: - { - int *px = LOGICAL(x); - for (i = 0; i < n; ++i, ++px) - if (*px == NA_LOGICAL) - *px = 1; - break; - } - case INTSXP: - { - int *px = INTEGER(x); - for (i = 0; i < n; ++i, ++px) - if (*px == NA_INTEGER) - *px = 1; - break; - } - case REALSXP: - { - double *px = REAL(x); - for (i = 0; i < n; ++i, ++px) - if (ISNAN(*px)) - *px = 1.0; - break; - } - case CPLXSXP: - { - Rcomplex *px = COMPLEX(x); - for (i = 0; i < n; ++i, ++px) - if (ISNAN((*px).r) || ISNAN((*px).i)) - *px = Matrix_zone; - break; - } - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - return; -} - -/* That both 's1' and 's2' are STRSXP of length at least 'n' must be - checked by the caller ... see, e.g., symmetricMatrix_validate() above -*/ -Rboolean equal_string_vectors(SEXP s1, SEXP s2, int n) -{ - /* Only check the first 'n' elements, even if 's1' or 's2' is longer ... - - Note that 'R_compute_identical()' in src/main/identical.c - is careful to distinguish between NA_STRING and "NA" in STRSXP, - but we need not be here ... - - MJ: Why not? - */ - - for (int i = 0; i < n; ++i) - if (strcmp(CHAR(STRING_ELT(s1, i)), CHAR(STRING_ELT(s2, i))) != 0) - return FALSE; - return TRUE; -} - -SEXP append_to_named_list(SEXP x, const char *nm, SEXP val) -{ - PROTECT(val); - R_xlen_t n = XLENGTH(x); - SEXP y = PROTECT(allocVector(VECSXP, n + 1)), - ny = PROTECT(allocVector(STRSXP, n + 1)), - nval = PROTECT(mkChar(nm)); - if (n > 0) { - SEXP nx = PROTECT(getAttrib(x, R_NamesSymbol)); - R_xlen_t i; - for (i = 0; i < n; ++i) { - SET_VECTOR_ELT( y, i, VECTOR_ELT( x, i)); - SET_STRING_ELT(ny, i, STRING_ELT(nx, i)); - } - UNPROTECT(1); - } - SET_VECTOR_ELT( y, n, val); - SET_STRING_ELT(ny, n, nval); - setAttrib(y, R_NamesSymbol, ny); - UNPROTECT(4); - return y; -} - - -/* ================================================================== */ -/* ================================================================== */ - -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; -} - -/** - * 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: - { - /* Initialization must work whether Rcomplex is typedef-ed - to a struct { R < 4.3.0 } or to a union { R >= 4.3.0 } - */ - Rcomplex zna = { .r = NA_REAL, .i = 0.0 }; - for (i = 0; i < N; i++) - COMPLEX(ans)[i] = zna; - 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_ diff -Nru rmatrix-1.6-1.1/src/Mutils.h rmatrix-1.6-5/src/Mutils.h --- rmatrix-1.6-1.1/src/Mutils.h 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/Mutils.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,158 +0,0 @@ -#ifndef MATRIX_MUTILS_H -#define MATRIX_MUTILS_H - -#include "Mdefines.h" -#include "Minlines.h" - -#ifdef __cplusplus -extern "C" { -/* NB: this block must not include system or R headers */ -#endif - -SEXP NEW_OBJECT_OF_CLASS(const char *what); - -void *Matrix_memset(void *dest, int ch, R_xlen_t length, size_t size); -void *Matrix_memcpy(void *dest, const void *src, R_xlen_t length, size_t size); - -Rboolean DimNames_is_trivial(SEXP dn); -Rboolean DimNames_is_symmetric(SEXP dn); -SEXP R_DimNames_is_symmetric(SEXP dn); - -void symmDN(SEXP dest, SEXP src, int J); -SEXP R_symmDN(SEXP dn); -SEXP get_symmetrized_DimNames(SEXP obj, int J); -void set_symmetrized_DimNames(SEXP obj, SEXP dn, int J); - -void revDN(SEXP dest, SEXP src); -SEXP R_revDN(SEXP dn); -SEXP get_reversed_DimNames(SEXP obj); -void set_reversed_DimNames(SEXP obj, SEXP dn); - -void set_DimNames(SEXP obj, SEXP dn); - -SEXP get_factor(SEXP obj, const char *nm); -void set_factor(SEXP obj, const char *nm, SEXP val); -SEXP R_set_factor(SEXP obj, SEXP nm, SEXP val, SEXP warn); -SEXP R_empty_factors(SEXP obj, SEXP warn); - -void rowPerm(double *x, int m, int n, int *p, int off, int invert); -void symPerm(double *x, int n, char uplo, int *p, int off, int invert); - -int isPerm(const int *p, int n, int off); -int signPerm(const int *p, int n, int off); -void invertPerm(const int *p, int *ip, int n, int off, int ioff); -void asPerm(const int *p, int *ip, int m, int n, int off, int ioff); - -SEXP R_isPerm(SEXP p, SEXP off); -SEXP R_signPerm(SEXP p, SEXP off); -SEXP R_invertPerm(SEXP p, SEXP off, SEXP ioff); -SEXP R_asPerm(SEXP p, SEXP off, SEXP ioff, SEXP n); - -char type2kind(SEXPTYPE type); -SEXPTYPE kind2type(char kind); -size_t kind2size(char kind); - -const char *Matrix_nonvirtual(SEXP obj, int strict); -SEXP R_Matrix_nonvirtual(SEXP obj, SEXP strict); -char Matrix_kind(SEXP obj, int i2d); -SEXP R_Matrix_kind(SEXP obj, SEXP i2d); -char Matrix_shape(SEXP obj); -SEXP R_Matrix_shape(SEXP obj); -char Matrix_repr(SEXP obj); -SEXP R_Matrix_repr(SEXP obj); - -SEXP R_index_triangle(SEXP n, SEXP packed, SEXP upper, SEXP diag); -SEXP R_index_diagonal(SEXP n, SEXP packed, SEXP upper); - -SEXP R_nnz(SEXP x, SEXP countNA, SEXP nnzmax); - -void conjugate(SEXP x); -void zeroRe(SEXP x); -void zeroIm(SEXP x); -void na2one(SEXP x); - -Rboolean equal_string_vectors(SEXP s1, SEXP s2, int n); -SEXP append_to_named_list(SEXP x, const char *nm, SEXP val); - -SEXP Matrix_expand_pointers(SEXP pP); -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 Mmatrix(SEXP args); - -SEXP R_rbind2_vector(SEXP a, SEXP b); -SEXP R_all0(SEXP x); -SEXP R_any0(SEXP x); - - -/* ================================================================== */ -/* Defined elsewhere but used in a few places, hence "exported" here: */ -/* ================================================================== */ - -#define PACK(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_pack(_CTYPE_ *, const _CTYPE_ *, int, char, char) -PACK(d, double); -PACK(i, int); -PACK(z, Rcomplex); -#undef PACK - -#define UNPACK(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_unpack(_CTYPE_ *, const _CTYPE_ *, int, char, char) -UNPACK(d, double); -UNPACK(i, int); -UNPACK(z, Rcomplex); -#undef UNPACK - -#define UNPACKED_MAKE_TRIANGULAR(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_unpacked_make_triangular(_CTYPE_ *, int, int, char, char) -UNPACKED_MAKE_TRIANGULAR(d, double); -UNPACKED_MAKE_TRIANGULAR(i, int); -UNPACKED_MAKE_TRIANGULAR(z, Rcomplex); -#undef UNPACKED_MAKE_TRIANGULAR - -#define UNPACKED_MAKE_SYMMETRIC(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_unpacked_make_symmetric(_CTYPE_ *, int, char) -UNPACKED_MAKE_SYMMETRIC(d, double); -UNPACKED_MAKE_SYMMETRIC(i, int); -UNPACKED_MAKE_SYMMETRIC(z, Rcomplex); -#undef UNPACKED_MAKE_SYMMETRIC - -#define UNPACKED_MAKE_BANDED(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_unpacked_make_banded(_CTYPE_ *, int, int, int, int, char) -UNPACKED_MAKE_BANDED(d, double); -UNPACKED_MAKE_BANDED(i, int); -UNPACKED_MAKE_BANDED(z, Rcomplex); -#undef UNPACKED_MAKE_BANDED - -#define PACKED_MAKE_BANDED(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_packed_make_banded(_CTYPE_ *, int, int, int, char, char) -PACKED_MAKE_BANDED(d, double); -PACKED_MAKE_BANDED(i, int); -PACKED_MAKE_BANDED(z, Rcomplex); -#undef PACKED_MAKE_BANDED - -#define UNPACKED_COPY_DIAGONAL(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_unpacked_copy_diagonal(_CTYPE_ *, const _CTYPE_ *, \ - int, R_xlen_t, char, char) -UNPACKED_COPY_DIAGONAL(d, double); -UNPACKED_COPY_DIAGONAL(i, int); -UNPACKED_COPY_DIAGONAL(z, Rcomplex); -#undef UNPACKED_COPY_DIAGONAL - -#define PACKED_COPY_DIAGONAL(_PREFIX_, _CTYPE_) \ -void _PREFIX_ ## dense_packed_copy_diagonal(_CTYPE_ *, const _CTYPE_ *, \ - int, R_xlen_t, char, char, char) -PACKED_COPY_DIAGONAL(d, double); -PACKED_COPY_DIAGONAL(i, int); -PACKED_COPY_DIAGONAL(z, Rcomplex); -#undef PACKED_COPY_DIAGONAL - -SEXP unpacked_force(SEXP, int, char, char); -SEXP packed_transpose(SEXP, int, char); - -void validObject(SEXP, const char *); - -#ifdef __cplusplus -} -#endif - -#endif /* MATRIX_MUTILS_H */ diff -Nru rmatrix-1.6-1.1/src/Syms.h rmatrix-1.6-5/src/Syms.h --- rmatrix-1.6-1.1/src/Syms.h 2023-06-24 01:53:34.000000000 +0000 +++ rmatrix-1.6-5/src/Syms.h 2023-09-29 18:53:50.000000000 +0000 @@ -9,7 +9,7 @@ Matrix_VSym, Matrix_betaSym, Matrix_diagSym, - Matrix_factorSym, + Matrix_factorsSym, Matrix_iSym, Matrix_jSym, Matrix_lengthSym, @@ -19,6 +19,4 @@ Matrix_qSym, Matrix_sdSym, Matrix_uploSym, - Matrix_xSym, - - MatrixNamespace; + Matrix_xSym; diff -Nru rmatrix-1.6-1.1/src/abIndex.c rmatrix-1.6-5/src/abIndex.c --- rmatrix-1.6-1.1/src/abIndex.c 2015-03-30 10:23:42.000000000 +0000 +++ rmatrix-1.6-5/src/abIndex.c 2023-09-22 05:53:14.000000000 +0000 @@ -1,19 +1,6 @@ -/** @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 "Mdefines.h" #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_ diff -Nru rmatrix-1.6-1.1/src/abIndex.h rmatrix-1.6-5/src/abIndex.h --- rmatrix-1.6-1.1/src/abIndex.h 2009-12-22 21:11:49.000000000 +0000 +++ rmatrix-1.6-5/src/abIndex.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,10 +1,10 @@ -#ifndef MATRIX_AbstrINDEX_H -#define MATRIX_AbstrINDEX_H +#ifndef MATRIX_ABINDEX_H +#define MATRIX_ABINDEX_H -#include "Mutils.h" +#include -SEXP Matrix_rle_i(SEXP x_, SEXP force_); -SEXP Matrix_rle_d(SEXP x_, SEXP force_); +SEXP Matrix_rle_i(SEXP, SEXP); +SEXP Matrix_rle_d(SEXP, SEXP); -#endif +#endif /* MATRIX_ABINDEX_H */ diff -Nru rmatrix-1.6-1.1/src/attrib.c rmatrix-1.6-5/src/attrib.c --- rmatrix-1.6-1.1/src/attrib.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/attrib.c 2023-10-13 20:01:06.000000000 +0000 @@ -0,0 +1,236 @@ +#include "Mdefines.h" +#include "attrib.h" + +/* .... Dimnames .................................................... */ + +int DimNames_is_trivial(SEXP dn) +{ + return + isNull(VECTOR_ELT(dn, 0)) && + isNull(VECTOR_ELT(dn, 1)) && + isNull(getAttrib(dn, R_NamesSymbol)); +} + +int DimNames_is_symmetric(SEXP dn) +{ + SEXP rn, cn, ndn; + const char *nrn, *ncn; + int n; + + return + !((!isNull(rn = VECTOR_ELT(dn, 0)) && + !isNull(cn = VECTOR_ELT(dn, 1)) && + rn != cn && + ((n = LENGTH(rn)) != LENGTH(cn) || + !equal_character_vectors(rn, cn, n))) || + ((!isNull(ndn = getAttrib(dn, R_NamesSymbol)) && + *(nrn = CHAR(STRING_ELT(ndn, 0))) != '\0' && + *(ncn = CHAR(STRING_ELT(ndn, 1))) != '\0' && + strcmp(nrn, ncn) != 0))); +} + +SEXP R_DimNames_is_symmetric(SEXP dn) +{ + return ScalarLogical(DimNames_is_symmetric(dn)); +} + +void symDN(SEXP dest, SEXP src, int J /* -1|0|1 */) +{ + SEXP s; + if (J < 0) { + if (!isNull(s = VECTOR_ELT(src, J = 1)) || + !isNull(s = VECTOR_ELT(src, J = 0))) { + SET_VECTOR_ELT(dest, 0, s); + SET_VECTOR_ELT(dest, 1, s); + } else { + J = 1; + } + } else { + if (!isNull(s = VECTOR_ELT(src, J))) { + SET_VECTOR_ELT(dest, 0, s); + SET_VECTOR_ELT(dest, 1, s); + } + } + PROTECT(s = getAttrib(src, R_NamesSymbol)); + if (!isNull(s)) { + SEXP destnms = PROTECT(allocVector(STRSXP, 2)); + if (*CHAR(s = STRING_ELT(s, J)) != '\0') { + SET_STRING_ELT(destnms, 0, s); + SET_STRING_ELT(destnms, 1, s); + } + setAttrib(dest, R_NamesSymbol, destnms); + UNPROTECT(1); + } + UNPROTECT(1); + return; +} + +void revDN(SEXP dest, SEXP src) { + SEXP s; + if (!isNull(s = VECTOR_ELT(src, 0))) + SET_VECTOR_ELT(dest, 1, s); + if (!isNull(s = VECTOR_ELT(src, 1))) + SET_VECTOR_ELT(dest, 0, s); + PROTECT(s = getAttrib(src, R_NamesSymbol)); + if (!isNull(s)) { + SEXP srcnms = s, destnms = PROTECT(allocVector(STRSXP, 2)); + if (*CHAR(s = STRING_ELT(srcnms, 0)) != '\0') + SET_STRING_ELT(destnms, 1, s); + if (*CHAR(s = STRING_ELT(srcnms, 1)) != '\0') + SET_STRING_ELT(destnms, 0, s); + setAttrib(dest, R_NamesSymbol, destnms); + UNPROTECT(1); + } + UNPROTECT(1); + return; +} + +SEXP R_symDN(SEXP dn) +{ + if (DimNames_is_trivial(dn)) + return dn; + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + symDN(newdn, dn, -1); + UNPROTECT(1); + return newdn; +} + +SEXP R_revDN(SEXP dn) +{ + if (DimNames_is_trivial(dn)) + return dn; + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + revDN(newdn, dn); + UNPROTECT(1); + return newdn; +} + +SEXP get_symmetrized_DimNames(SEXP obj, int J) { + SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); + if (DimNames_is_trivial(dn)) { + UNPROTECT(1); + return dn; + } + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + symDN(newdn, dn, J); + UNPROTECT(2); + return newdn; +} + +SEXP get_reversed_DimNames(SEXP obj) { + SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); + if (DimNames_is_trivial(dn)) { + UNPROTECT(1); + return dn; + } + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + revDN(newdn, dn); + UNPROTECT(2); + return newdn; +} + +void set_symmetrized_DimNames(SEXP obj, SEXP dn, int J) { + if (!DimNames_is_trivial(dn)) { + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + symDN(newdn, dn, J); + SET_SLOT(obj, Matrix_DimNamesSym, newdn); + UNPROTECT(1); + } + return; +} + +void set_reversed_DimNames(SEXP obj, SEXP dn) { + if (!DimNames_is_trivial(dn)) { + SEXP newdn = PROTECT(allocVector(VECSXP, 2)); + revDN(newdn, dn); + SET_SLOT(obj, Matrix_DimNamesSym, newdn); + UNPROTECT(1); + } + return; +} + + +/* .... factors ..................................................... */ + +static +int strmatch(const char *x, SEXP valid) +{ + int i, n = LENGTH(valid); + for (i = 0; i < n; ++i) + if (strcmp(x, CHAR(STRING_ELT(valid, i))) == 0) + return i; + return -1; +} + +static +SEXP append_to_named_list(SEXP x, const char *nm, SEXP val) +{ + PROTECT(val); + R_xlen_t n = XLENGTH(x); + SEXP y = PROTECT(allocVector(VECSXP, n + 1)), + ny = PROTECT(allocVector(STRSXP, n + 1)), + nval = PROTECT(mkChar(nm)); + if (n > 0) { + SEXP nx = PROTECT(getAttrib(x, R_NamesSymbol)); + R_xlen_t i; + for (i = 0; i < n; ++i) { + SET_VECTOR_ELT( y, i, VECTOR_ELT( x, i)); + SET_STRING_ELT(ny, i, STRING_ELT(nx, i)); + } + UNPROTECT(1); + } + SET_VECTOR_ELT( y, n, val); + SET_STRING_ELT(ny, n, nval); + setAttrib(y, R_NamesSymbol, ny); + UNPROTECT(4); + return y; +} + +SEXP get_factor(SEXP obj, const char *nm) +{ + SEXP factors = PROTECT(GET_SLOT(obj, Matrix_factorsSym)), val = R_NilValue; + if (LENGTH(factors) > 0) { + SEXP valid = PROTECT(getAttrib(factors, R_NamesSymbol)); + int i = strmatch(nm, valid); + if (i >= 0) + val = VECTOR_ELT(factors, i); + UNPROTECT(1); + } + UNPROTECT(1); + return val; +} + +void set_factor(SEXP obj, const char *nm, SEXP val) +{ + PROTECT(val); + SEXP factors; + PROTECT_INDEX pid; + PROTECT_WITH_INDEX(factors = GET_SLOT(obj, Matrix_factorsSym), &pid); + if (LENGTH(factors) > 0) { + SEXP valid = PROTECT(getAttrib(factors, R_NamesSymbol)); + int i = strmatch(nm, valid); + UNPROTECT(1); + if (i >= 0) { + SET_VECTOR_ELT(factors, i, val); + UNPROTECT(2); + return; + } + } + REPROTECT(factors = append_to_named_list(factors, nm, val), pid); + SET_SLOT(obj, Matrix_factorsSym, factors); + UNPROTECT(2); + return; +} + +SEXP R_set_factor(SEXP obj, SEXP nm, SEXP val, SEXP warn) +{ + if (TYPEOF(nm) != STRSXP || LENGTH(nm) < 1 || + (nm = STRING_ELT(nm, 0)) == NA_STRING) + error(_("invalid factor name")); + else if (TYPEOF(getAttrib(obj, Matrix_factorsSym)) == VECSXP) + set_factor(obj, CHAR(nm), val); + else if (asLogical(warn) != 0) + warning(_("attempt to set factor on %s without '%s' slot"), + "Matrix", "factors"); + return val; +} diff -Nru rmatrix-1.6-1.1/src/attrib.h rmatrix-1.6-5/src/attrib.h --- rmatrix-1.6-1.1/src/attrib.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/attrib.h 2023-09-22 05:53:14.000000000 +0000 @@ -0,0 +1,11 @@ +#ifndef MATRIX_ATTRIB_H +#define MATRIX_ATTRIB_H + +#include + +SEXP R_DimNames_is_symmetric(SEXP); +SEXP R_symDN(SEXP); +SEXP R_revDN(SEXP); +SEXP R_set_factor(SEXP, SEXP, SEXP, SEXP); + +#endif /* MATRIX_ATTRIB_H */ diff -Nru rmatrix-1.6-1.1/src/bind.c rmatrix-1.6-5/src/bind.c --- rmatrix-1.6-1.1/src/bind.c 2023-08-04 19:17:49.000000000 +0000 +++ rmatrix-1.6-5/src/bind.c 2023-10-11 13:25:02.000000000 +0000 @@ -1,10 +1,14 @@ -#include "bind.h" +#include "Mdefines.h" #include "coerce.h" +#include "bind.h" static const char *valid[] = { VALID_NONVIRTUAL_MATRIX, "" }; -static void scanArgs(SEXP args, SEXP exprs, int margin, int level, - int *rdim, int *rdimnames, char *kind, char *repr) +static SEXP tagWasVector = NULL; + +static +void scanArgs(SEXP args, SEXP exprs, int margin, int level, + int *rdim, int *rdimnames, char *kind, char *repr) { SEXP a, e, s, tmp; int nS4 = 0, nDense = 0, @@ -22,11 +26,11 @@ s = CAR(a); if (s == R_NilValue) continue; - if (IS_S4_OBJECT(s)) { + if (TYPEOF(s) == S4SXP) { ++nS4; ivalid = R_check_class_etc(s, valid); if (ivalid < 0) { - if (margin == 1) + if (margin) ERROR_INVALID_CLASS(s, "cbind.Matrix"); else ERROR_INVALID_CLASS(s, "rbind.Matrix"); @@ -38,7 +42,7 @@ if (rdim[!margin] < 0) rdim[!margin] = sdim[!margin]; else if (sdim[!margin] != rdim[!margin]) { - if (margin == 1) + if (margin) error(_("number of rows of matrices must match")); else error(_("number of columns of matrices must match")); @@ -108,7 +112,7 @@ case 'd': if (INTEGER(GET_SLOT(s, Matrix_marginSym))[0] - 1 != margin) { anyN = 1; - if (margin == 1) + if (margin) anyCsparse = 1; else anyRsparse = 1; @@ -132,7 +136,7 @@ anyZ = 1; break; default: - if (margin == 1) + if (margin) ERROR_INVALID_TYPE(s, "cbind.Matrix"); else ERROR_INVALID_TYPE(s, "rbind.Matrix"); @@ -145,7 +149,7 @@ if (rdim[!margin] < 0) rdim[!margin] = sdim[!margin]; else if (rdim[!margin] != sdim[!margin]) { - if (margin == 1) + if (margin) error(_("number of rows of matrices must match")); else error(_("number of columns of matrices must match")); @@ -187,7 +191,7 @@ for (a = args, e = exprs; a != R_NilValue; a = CDR(a), e = CDR(e)) { s = CAR(a); - if ((s == R_NilValue && rdim[!margin] > 0) || IS_S4_OBJECT(s)) + if ((s == R_NilValue && rdim[!margin] > 0) || TYPEOF(s) == S4SXP) continue; if (s == R_NilValue) rdim[margin] += 1; @@ -202,7 +206,7 @@ error(_("dimensions cannot exceed %s"), "2^31-1"); rdim[margin] += 1; if (slen > rdim[!margin] || rdim[!margin] % (int) slen) { - if (margin == 1) + if (margin) warning(_("number of rows of result is not a multiple of vector length")); else warning(_("number of columns of result is not a multiple of vector length")); @@ -221,18 +225,15 @@ } if (anyZ) -#ifdef MATRIX_ENABLE_ZMATRIX *kind = 'z'; +#ifndef MATRIX_ENABLE_IMATRIX + else if (anyD || anyI) + *kind = 'd'; #else - error(_("complex matrices are not yet supported")); -#endif else if (anyD) *kind = 'd'; else if (anyI) -#ifdef MATRIX_ENABLE_IMATRIX *kind = 'i'; -#else - *kind = 'd'; #endif else if (anyL) *kind = 'l'; @@ -245,7 +246,7 @@ *repr = 'e'; else if (nDense == 0) { if (anyCsparse && anyRsparse) - *repr = (margin == 1) ? 'C' : 'R'; + *repr = (margin) ? 'C' : 'R'; else if (anyCsparse) *repr = 'C'; else if (anyRsparse) @@ -253,7 +254,7 @@ else if (anyTsparse) *repr = 'T'; else if (anyDiagonal) - *repr = (margin == 1) ? 'C' : 'R'; + *repr = (margin) ? 'C' : 'R'; else *repr = '\0'; } else { @@ -264,7 +265,7 @@ Matrix_int_fast64_t nnz = 0, len = 0, snnz = 0, slen = 0; for (a = args; a != R_NilValue && nnz < INT_MAX; a = CDR(a)) { s = CAR(a); - if (!IS_S4_OBJECT(s)) + if (TYPEOF(s) != S4SXP) continue; ivalid = R_check_class_etc(s, valid); scl = valid[ivalid + VALID_NONVIRTUAL_SHIFT(ivalid, 1)]; @@ -342,7 +343,7 @@ if (nnz > INT_MAX || nnz > len / 2) *repr = 'e'; else if (anyCsparse && anyRsparse) - *repr = (margin == 1) ? 'C' : 'R'; + *repr = (margin) ? 'C' : 'R'; else if (anyCsparse) *repr = 'C'; else if (anyRsparse) @@ -350,27 +351,30 @@ else if (anyTsparse) *repr = 'T'; else - *repr = (margin == 1) ? 'C' : 'R'; + *repr = (margin) ? 'C' : 'R'; } return; } -static void coerceArgs(SEXP args, int margin, - int *rdim, char kind, char repr) +static +void coerceArgs(SEXP args, int margin, + int *rdim, char kind, char repr) { - SEXP a, s, tmp; + SEXP a, s, t, tmp; int ivalid, isM; char scl_[] = "...Matrix"; const char *scl; for (a = args; a != R_NilValue; a = CDR(a)) { s = CAR(a); + t = TAG(a); + SET_TAG(a, R_NilValue); /* to be replaced only if 's' is a vector */ if (s == R_NilValue) continue; PROTECT_INDEX pid; PROTECT_WITH_INDEX(s, &pid); - if (IS_S4_OBJECT(s)) { + if (TYPEOF(s) == S4SXP) { ivalid = R_check_class_etc(s, valid); scl = valid[ivalid + VALID_NONVIRTUAL_SHIFT(ivalid, 1)]; switch (scl[2]) { @@ -380,10 +384,10 @@ case 'p': switch (repr) { case 'e': - REPROTECT(s = dense_as_kind(s, scl, kind), pid); + REPROTECT(s = dense_as_kind(s, scl, kind, 0), pid); scl_[0] = kind; scl_[1] = scl[1]; scl_[2] = scl[2]; REPROTECT(s = dense_as_general( - s, scl_, kind2type(kind) == kind2type(scl[0])), pid); + s, scl_, kindToType(kind) == kindToType(scl[0])), pid); break; case 'C': case 'R': @@ -423,16 +427,14 @@ } break; case 'i': - REPROTECT(s = diagonal_as_kind(s, scl, kind), pid); - scl_[0] = kind; scl_[1] = scl[1]; scl_[2] = scl[2]; switch (repr) { case 'e': - REPROTECT(s = diagonal_as_dense(s, scl_, 'g', 0, '\0'), pid); + REPROTECT(s = diagonal_as_dense(s, scl_, kind, 'g', 0, '\0'), pid); break; case 'C': case 'R': case 'T': - REPROTECT(s = diagonal_as_sparse(s, scl_, 'g', repr, '\0'), pid); + REPROTECT(s = diagonal_as_sparse(s, scl_, kind, 'g', repr, '\0'), pid); break; default: break; @@ -458,12 +460,15 @@ } else { tmp = getAttrib(s, R_DimSymbol); isM = TYPEOF(tmp) == INTSXP && LENGTH(tmp) == 2; - if (!isM && rdim[!margin] > 0 && XLENGTH(s) == 0) { - UNPROTECT(1); - continue; + if (!isM) { + if (rdim[!margin] > 0 && XLENGTH(s) == 0) { + UNPROTECT(1); + continue; + } + SET_TAG(a, (t != R_NilValue) ? t : tagWasVector); } - if (TYPEOF(s) != kind2type(kind)) - REPROTECT(s = coerceVector(s, kind2type(kind)), pid); + if (TYPEOF(s) != kindToType(kind)) + REPROTECT(s = coerceVector(s, kindToType(kind)), pid); if (repr != 'e') { if (!isM && XLENGTH(s) != rdim[!margin]) { static SEXP replen = NULL; @@ -486,8 +491,9 @@ return; } -static void bindArgs(SEXP args, int margin, SEXP res, - int *rdim, char kind, char repr) +static +void bindArgs(SEXP args, int margin, SEXP res, + int *rdim, char kind, char repr) { SEXP a, s; @@ -518,7 +524,7 @@ int k, m = rdim[0], n = rdim[1]; R_xlen_t mn = (R_xlen_t) m * n; - SEXP x = PROTECT(allocVector(kind2type(kind), mn)), tmp; + SEXP x = PROTECT(allocVector(kindToType(kind), mn)), tmp; SET_SLOT(res, Matrix_xSym, x); #define BIND_E(_CTYPE_, _PTR_, _MASK_) \ @@ -528,7 +534,7 @@ s = CAR(a); \ if (s == R_NilValue) \ continue; \ - if (!IS_S4_OBJECT(s)) \ + if (TYPEOF(s) != S4SXP) \ tmp = getAttrib(s, R_DimSymbol); \ else { \ s = GET_SLOT(s, Matrix_xSym); \ @@ -536,7 +542,7 @@ } \ mn = XLENGTH(s); \ ps = _PTR_(s); \ - if (margin == 1) { \ + if (margin) { \ if (!tmp || (TYPEOF(tmp) == INTSXP && LENGTH(tmp) == 2)) { \ Matrix_memcpy(px, ps, mn, sizeof(_CTYPE_)); \ px += mn; \ @@ -594,7 +600,7 @@ BIND_CASES(BIND_E); UNPROTECT(1); - } else if ((repr == 'C' && margin == 1) || (repr == 'R' && margin == 0)) { + } else if ((repr == 'C' && margin) || (repr == 'R' && !margin)) { SEXP p = PROTECT(allocVector(INTSXP, (R_xlen_t) rdim[margin] + 1)); int *pp = INTEGER(p); @@ -653,14 +659,14 @@ if (kind == 'n') BIND_C1R0(int, LOGICAL, HIDE); else { - SEXP x = PROTECT(allocVector(kind2type(kind), nnz)), sx; + SEXP x = PROTECT(allocVector(kindToType(kind), nnz)), sx; SET_SLOT(res, Matrix_xSym, x); BIND_CASES(BIND_C1R0); UNPROTECT(1); } UNPROTECT(2); - } else if ((repr == 'C' && margin == 0) || (repr == 'R' && margin == 1)) { + } else if ((repr == 'C' && !margin) || (repr == 'R' && margin)) { SEXP p = PROTECT(allocVector(INTSXP, (R_xlen_t) rdim[!margin] + 1)); int *pp = INTEGER(p); @@ -727,7 +733,7 @@ if (kind == 'n') BIND_C0R1(int, LOGICAL, HIDE); else { - SEXP x = PROTECT(allocVector(kind2type(kind), nnz)), sx; + SEXP x = PROTECT(allocVector(kindToType(kind), nnz)), sx; SET_SLOT(res, Matrix_xSym, x); BIND_CASES(BIND_C0R1); UNPROTECT(1); @@ -773,16 +779,16 @@ psj = INTEGER(sj); \ _MASK_(psx = _PTR_(sx)); \ k = XLENGTH(si); \ - if (margin == 0) { \ + if (margin) { \ while (k--) { \ - *(pi++) = *(psi++) + pos; \ - *(pj++) = *(psj++); \ + *(pi++) = *(psi++); \ + *(pj++) = *(psj++) + pos; \ _MASK_(*(px++) = *(psx++)); \ } \ } else { \ while (k--) { \ - *(pi++) = *(psi++); \ - *(pj++) = *(psj++) + pos; \ + *(pi++) = *(psi++) + pos; \ + *(pj++) = *(psj++); \ _MASK_(*(px++) = *(psx++)); \ } \ } \ @@ -795,7 +801,7 @@ if (kind == 'n') BIND_T(int, LOGICAL, HIDE); else { - SEXP x = PROTECT(allocVector(kind2type(kind), nnz)), sx; + SEXP x = PROTECT(allocVector(kindToType(kind), nnz)), sx; SET_SLOT(res, Matrix_xSym, x); BIND_CASES(BIND_T); UNPROTECT(1); @@ -816,7 +822,7 @@ } SET_SLOT(res, Matrix_permSym, p); UNPROTECT(1); - if (margin == 1) + if (margin) INTEGER(GET_SLOT(res, Matrix_marginSym))[0] = 2; } @@ -830,8 +836,12 @@ return; } -static SEXP bind(SEXP args, SEXP exprs, int margin, int level) +static +SEXP bind(SEXP args, SEXP exprs, int margin, int level) { + if (!tagWasVector) + tagWasVector = install(".__WAS_VECTOR__."); /* for now, a hack */ + int rdim[2], rdimnames[2]; char kind = '\0', repr = '\0'; scanArgs(args, exprs, margin, level, @@ -855,7 +865,7 @@ rcl[2] = repr; coerceArgs(args, margin, rdim, kind, repr); } - SEXP res = PROTECT(NEW_OBJECT_OF_CLASS(rcl)); + SEXP res = PROTECT(newObject(rcl)); bindArgs(args, margin, res, rdim, kind, repr); SEXP dim = PROTECT(GET_SLOT(res, Matrix_DimSym)); @@ -866,7 +876,7 @@ if (rdimnames[0] || rdimnames[1]) { SEXP dimnames = PROTECT(GET_SLOT(res, Matrix_DimNamesSym)), marnames = R_NilValue, nms[2], nms_, a, e, s, tmp; - int i, ivalid, r, pos = 0, nprotect = 1; + int i, ivalid, r = -1, pos = 0, nprotect = 1; const char *scl; if (rdimnames[margin]) { PROTECT(marnames = allocVector(STRSXP, rdim[margin])); @@ -878,7 +888,7 @@ if (s == R_NilValue && rdim[!margin] > 0) continue; nms[0] = nms[1] = R_NilValue; - if (IS_S4_OBJECT(s)) { + if (TYPEOF(s) == S4SXP) { ivalid = R_check_class_etc(s, valid); scl = valid[ivalid + VALID_NONVIRTUAL_SHIFT(ivalid, 1)]; tmp = GET_SLOT(s, Matrix_DimSym); @@ -903,23 +913,24 @@ r = 1; if (rdim[!margin] > 0 && XLENGTH(s) == rdim[!margin]) nms[!margin] = getAttrib(s, R_NamesSymbol); - if (TAG(a) != R_NilValue) - nms[margin] = coerceVector(TAG(a), STRSXP); - else if (level == 2) { - PROTECT(nms_ = allocVector(EXPRSXP, 1)); - SET_VECTOR_ELT(nms_, 0, CAR(e)); - nms[margin] = coerceVector(nms_, STRSXP); - UNPROTECT(1); - } else if (level == 1 && TYPEOF(CAR(e)) == SYMSXP) - nms[margin] = coerceVector(CAR(e), STRSXP); - } else - continue; + } + } + if (TAG(a) != R_NilValue) { /* only if 's' is or was a vector */ + if (TAG(a) != tagWasVector) + nms[margin] = coerceVector(TAG(a), STRSXP); + else if (level == 2) { + PROTECT(nms_ = allocVector(EXPRSXP, 1)); + SET_VECTOR_ELT(nms_, 0, CAR(e)); + nms[margin] = coerceVector(nms_, STRSXP); + UNPROTECT(1); + } else if (level == 1 && TYPEOF(CAR(e)) == SYMSXP) + nms[margin] = coerceVector(CAR(e), STRSXP); } if (rdimnames[!margin] && nms[!margin] != R_NilValue) { SET_VECTOR_ELT(dimnames, !margin, nms[!margin]); + rdimnames[!margin] = 0; if (!rdimnames[margin]) break; - rdimnames[!margin] = 1; } if (rdimnames[ margin] && nms[ margin] != R_NilValue) for (i = 0; i < r; ++i) diff -Nru rmatrix-1.6-1.1/src/bind.h rmatrix-1.6-5/src/bind.h --- rmatrix-1.6-1.1/src/bind.h 2023-07-29 14:27:00.000000000 +0000 +++ rmatrix-1.6-5/src/bind.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,8 +1,8 @@ #ifndef MATRIX_BIND_H #define MATRIX_BIND_H -#include "Mutils.h" +#include -SEXP R_bind(SEXP args); +SEXP R_bind(SEXP); -#endif +#endif /* MATRIX_BIND_H */ diff -Nru rmatrix-1.6-1.1/src/chm_common.c rmatrix-1.6-5/src/chm_common.c --- rmatrix-1.6-1.1/src/chm_common.c 2023-07-29 04:32:26.000000000 +0000 +++ rmatrix-1.6-5/src/chm_common.c 2024-01-06 06:57:56.000000000 +0000 @@ -1,1297 +1,1246 @@ -/** @file chm_common.c - */ +#include "Mdefines.h" #include "chm_common.h" -/* defined in Csparse.c : */ -Rboolean isValid_Csparse(SEXP); - -SEXP get_SuiteSparse_version(void) { - 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(void) { - 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(void) { - 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) +/* NB: mostly parallel to CsparseMatrix_validate in ./validity.c */ +SEXP checkpi(SEXP p, SEXP i, int m, int n) { - 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; -} +#define MKMS(_FORMAT_, ...) mkString(Matrix_sprintf(_FORMAT_, __VA_ARGS__)) -/* 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((size_t) 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; + if (TYPEOF(p) != INTSXP) + return MKMS(_("'%s' slot is not of type \"%s\""), + "p", "integer"); + if (XLENGTH(p) - 1 != n) + return MKMS(_("'%s' slot does not have length %s"), + "p", "Dim[2]+1"); + int *pp = INTEGER(p); + if (pp[0] != 0) + return MKMS(_("first element of '%s' slot is not 0"), + "p"); + int j; + for (j = 1; j <= n; ++j) { + if (pp[j] == NA_INTEGER) + return MKMS(_("'%s' slot contains NA"), + "p"); + if (pp[j] < pp[j - 1]) + return MKMS(_("'%s' slot is not nondecreasing"), + "p"); + if (pp[j] - pp[j - 1] > m) + return MKMS(_("first differences of '%s' slot exceed %s"), + "p", "Dim[1]"); + } - /* copy all the characteristics of src to dest */ - memcpy(dest, src, sizeof(cholmod_sparse)); + if (TYPEOF(i) != INTSXP) + return MKMS(_("'%s' slot is not of type \"%s\""), + "i", "integer"); + if (XLENGTH(i) < pp[n]) + return MKMS(_("'%s' slot has length less than %s"), + "i", "p[length(p)]"); + int *pi = INTEGER(i), k, kend, ik, i0, sorted = 1; + for (j = 1, k = 0; j <= n; ++j) { + kend = pp[j]; + i0 = -1; + while (k < kend) { + ik = pi[k]; + if (ik == NA_INTEGER) + return MKMS(_("'%s' slot contains NA"), + "i"); + if (ik < 0 || ik >= m) + return MKMS(_("'%s' slot has elements not in {%s}"), + "i", "0,...,Dim[1]-1"); + if (ik < i0) + sorted = 0; + else if (ik == i0) + return MKMS(_("'%s' slot is not increasing within columns after sorting"), + "i"); + i0 = ik; + ++k; + } + } - /* R_alloc the vector storage for dest and copy the contents from src */ - np1 = (size_t) src->ncol + 1; - nnz = (size_t) 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); + SEXP ans = allocVector(LGLSXP, 1); + LOGICAL(ans)[0] = sorted; + return ans; } /** - Copy cholmod_triplet to an R_alloc()ed version of it + * Coerce from CHMfactor to (cholmod_factor *) + * + * Sets the members of a pointed-to cholmod_factor struct, using "data" + * obtained from slots of a CHMfactor. The result should _not_ be + * freed using cholmod_free_factor, as the resulting members point to + * memory controlled by R, not by CHOLMOD. + * + * @param L a pointer to a cholmod_factor struct, to be modified in-place. + * @param from an S4 object inheriting from virtual class CHMfactor. + * + * @return L. */ -static void chTr2Ralloc(CHM_TR dest, CHM_TR src) +/* NB: mostly parallel to M2CHF in ./cholmod-etc.c */ +cholmod_factor *sexp_as_cholmod_factor(cholmod_factor *L, SEXP from) { - size_t nnz; - - /* copy all the (non-pointer) characteristics of src to dest */ - memcpy(dest, src, sizeof(cholmod_triplet)); + static const char *valid[] = { + "dCHMsuper", "dCHMsimpl", "nCHMsuper", "nCHMsimpl", "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + const char *class = valid[ivalid]; + memset(L, 0, sizeof(cholmod_factor)); + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)), + type = PROTECT(GET_SLOT(from, install("type"))), + perm = PROTECT(GET_SLOT(from, Matrix_permSym)), + colcount = PROTECT(GET_SLOT(from, install("colcount"))); + L->n = INTEGER(dim)[0]; + L->minor = L->n; /* FIXME: could be wrong for from <- new(...) */ + L->ordering = INTEGER(type)[0]; + if (L->ordering != CHOLMOD_NATURAL) + L->Perm = INTEGER(perm); + else { + /* cholmod_check_factor allows L->Perm == NULL, + but cholmod_copy_factor does not test, so it segfaults ... + */ + int n = (int) L->n, *Perm = (int *) R_alloc(L->n, sizeof(int)); + for (int j = 0; j < n; ++j) + Perm[j] = j; + L->Perm = Perm; + } + L->ColCount = INTEGER(colcount); + L->is_super = INTEGER(type)[2]; + if (L->is_super) { + L->is_ll = 1; + L->is_monotonic = 1; + SEXP super = PROTECT(GET_SLOT(from, install("super"))), + pi = PROTECT(GET_SLOT(from, install("pi"))), + px = PROTECT(GET_SLOT(from, install("px"))), + s = PROTECT(GET_SLOT(from, install("s"))); + L->super = INTEGER(super); + L->pi = INTEGER(pi); + L->px = INTEGER(px); + L->s = INTEGER(s); + L->nsuper = LENGTH(super) - 1; + L->ssize = ((int *) L->pi)[L->nsuper]; + L->xsize = ((int *) L->px)[L->nsuper]; + L->maxcsize = INTEGER(type)[4]; + L->maxesize = INTEGER(type)[5]; + UNPROTECT(4); + } else { + L->is_ll = INTEGER(type)[1]; + L->is_monotonic = INTEGER(type)[3]; + if (class[0] != 'n') { + SEXP p = PROTECT(GET_SLOT(from, Matrix_pSym)), + i = PROTECT(GET_SLOT(from, Matrix_iSym)), + nz = PROTECT(GET_SLOT(from, install("nz"))), + nxt = PROTECT(GET_SLOT(from, install("nxt"))), + prv = PROTECT(GET_SLOT(from, install("prv"))); + L->p = INTEGER(p); + L->i = INTEGER(i); + L->nz = INTEGER(nz); + L->next = INTEGER(nxt); + L->prev = INTEGER(prv); + L->nzmax = ((int *) L->p)[L->n]; + UNPROTECT(5); + } + } + L->itype = CHOLMOD_INT; + L->dtype = CHOLMOD_DOUBLE; + if (class[0] != 'n') { + SEXP x = GET_SLOT(from, Matrix_xSym); + switch (TYPEOF(x)) { + case CPLXSXP: + L->x = COMPLEX(x); + L->xtype = CHOLMOD_COMPLEX; + break; + case REALSXP: + L->x = REAL(x); + L->xtype = CHOLMOD_REAL; + break; + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + } - /* R_alloc the vector storage for dest and copy the contents from src */ - nnz = (size_t) 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); + if (!cholmod_check_factor(L, &c)) + error(_("'%s' failed in '%s'"), "cholmod_check_factor", __func__); + UNPROTECT(4); + return L; } /** - * 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. + * Coerce from CsparseMatrix to (cholmod_sparse *) * - * @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) + * Sets the members of a pointed-to cholmod_sparse struct, using "data" + * obtained from slots of a CsparseMatrix. The result should _not_ be + * freed using cholmod_free_sparse, as the resulting members point to + * memory controlled by R, not by CHOLMOD. + * + * @param A a pointer to a cholmod_sparse struct, to be modified in-place. + * @param from an S4 object inheriting from virtual class CsparseMatrix. + * @param checkUnit a boolean indicating if the unit diagonal of formally + * unit triangular CsparseMatrix should be allocated. + * @param sortInPlace a boolean indicating if unsorted CsparseMatrix + * should be sorted in place to avoid an allocation. + * + * @return A. */ -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); +/* NB: mostly parallel to M2CHS in ./cholmod-etc.c */ +cholmod_sparse *sexp_as_cholmod_sparse(cholmod_sparse *A, SEXP from, + Rboolean checkUnit, Rboolean sortInPlace) +{ + /* MJ: Do users really ever pass invalid 'from' ... ? + If not, then the code here could be simplified tremendously ... + */ + + static const char *valid[] = { + "dgCMatrix", "dsCMatrix", "dtCMatrix", + "lgCMatrix", "lsCMatrix", "ltCMatrix", + "ngCMatrix", "nsCMatrix", "ntCMatrix", "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + const char *class = valid[ivalid]; + memset(A, 0, sizeof(cholmod_sparse)); + + SEXP dim = GET_SLOT(from, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + + SEXP p = PROTECT(GET_SLOT(from, Matrix_pSym)), + i = PROTECT(GET_SLOT(from, Matrix_iSym)), + cpi = PROTECT(checkpi(p, i, m, n)); + if (TYPEOF(cpi) != LGLSXP) + error(_("'%s' failed in '%s': %s"), + "checkpi", __func__, CHAR(STRING_ELT(cpi, 0))); + int *pp = INTEGER(p), *pi = INTEGER(i), sorted = LOGICAL(cpi)[0]; + size_t np = (size_t) XLENGTH(p), ni = (size_t) XLENGTH(i); + if (!sorted && !sortInPlace) { + int *tmp; + tmp = (int *) R_alloc(np, sizeof(int)); + memcpy(tmp, pp, np * sizeof(int)); + pp = tmp; + tmp = (int *) R_alloc(ni, sizeof(int)); + memcpy(tmp, pi, ni * sizeof(int)); + pi = tmp; } - } - - 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 */ + A->nrow = m; + A->ncol = n; + A->p = pp; + A->i = pi; + A->nzmax = ni; + A->stype = 0; + A->itype = CHOLMOD_INT; + A->xtype = CHOLMOD_PATTERN; + A->dtype = CHOLMOD_DOUBLE; + A->sorted = LOGICAL(cpi)[0]; + A->packed = 1; + + if (ni > pp[n]) { /* overallocated */ + A->packed = 0; + int *tmp = (int *) R_alloc(n, sizeof(int)); + for (int j = 0; j < n; ++j) + tmp[j] = pp[j + 1] - pp[j]; + A->nz = tmp; + } + if (class[1] == 's') { + SEXP uplo = GET_SLOT(from, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + A->stype = (ul == 'U') ? 1 : -1; + } + if (class[0] != 'n') { + SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); + size_t nx = (size_t) XLENGTH(x); + switch (class[0]) { + case 'l': + case 'i': + { + int *px = (TYPEOF(x) == LGLSXP) ? LOGICAL(x) : INTEGER(x); + double *rtmp = (double *) R_alloc(nx, sizeof(double)); + for (size_t ix = 0; ix < nx; ++ix) + rtmp[ix] = (px[ix] == NA_INTEGER) + ? NA_REAL : (double) px[ix]; + A->x = rtmp; + A->xtype = CHOLMOD_REAL; + break; + } + case 'd': + { + double *px = REAL(x); + if (!sorted && !sortInPlace) { + double *rtmp = (double *) R_alloc(nx, sizeof(double)); + memcpy(rtmp, px, nx * sizeof(double)); + px = rtmp; + } + A->x = px; + A->xtype = CHOLMOD_REAL; + break; + } + case 'z': + { + Rcomplex *px = COMPLEX(x); + if (!sorted && !sortInPlace) { + Rcomplex *rtmp = (Rcomplex *) R_alloc(nx, sizeof(Rcomplex)); + memcpy(rtmp, px, nx * sizeof(Rcomplex)); + px = rtmp; + } + A->x = px; + A->xtype = CHOLMOD_COMPLEX; + break; + } + default: + break; + } + UNPROTECT(1); /* x */ + } + if (!sorted && !cholmod_sort(A, &c)) + error(_("'%s' failed in '%s'"), "cholmod_sort", __func__); + if (checkUnit && class[1] == 't' && n > 0) { + SEXP diag = GET_SLOT(from, Matrix_diagSym); + char di = *CHAR(STRING_ELT(diag, 0)); + if (di != 'N') { + double one[] = { 1.0, 0.0 }; + cholmod_sparse + *eye = cholmod_speye(n, n, A->xtype, &c), + *A1a = cholmod_add(A, eye, one, one, 1, 1, &c); + memcpy(A, A1a, sizeof(cholmod_sparse)); + A->p = (int *) R_alloc(A1a->ncol + 1, sizeof(int)); + memcpy(A->p, A1a->p, (A1a->ncol + 1) * sizeof(int)); + A->i = (int *) R_alloc(A1a->nzmax, sizeof(int)); + memcpy(A->i, A1a->i, A1a->nzmax * sizeof(int)); + if (A1a->xtype != CHOLMOD_PATTERN) { + size_t size = (A1a->xtype == CHOLMOD_REAL) + ? sizeof(double) : sizeof(Rcomplex); + A->x = R_alloc(A1a->nzmax, size); + memcpy(A->x, A1a->x, A1a->nzmax * size); + } + cholmod_free_sparse(&eye, &c); + cholmod_free_sparse(&A1a, &c); + } + } - return ans; + UNPROTECT(3); /* cpi, i, p */ + return A; } /** - * 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. + * Coerce from TsparseMatrix to (cholmod_triplet *) * - * @param a (cholmod_sparse) matrix to be converted - * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 R_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. + * Sets the members of a pointed-to cholmod_triplet struct, using "data" + * obtained from slots of a TsparseMatrix. The result should _not_ be + * freed using cholmod_free_sparse, as the resulting members point to + * memory controlled by R, not by CHOLMOD. + * + * @param A a pointer to a cholmod_triplet struct, to be modified in-place. + * @param from an S4 object inheriting from virtual class TsparseMatrix. + * @param checkUnit a boolean indicating if the unit diagonal of formally + * unit triangular TsparseMatrix should be allocated. * - * @return SEXP containing a copy of a + * @return A. */ -SEXP chm_sparse_to_SEXP(CHM_SP a, int dofree, int uploT, int Rkind, - const char* diag, SEXP dn) +cholmod_triplet *sexp_as_cholmod_triplet(cholmod_triplet *A, SEXP from, + Rboolean checkUnit) { - PROTECT(dn); /* dn is usually UNPROTECTed before the call */ - - /* ensure a is sorted and packed */ - - Rboolean longi = (a->itype) == CHOLMOD_LONG; - if (!a->sorted || !a->packed) - longi ? cholmod_l_sort(a, &cl) : cholmod_sort(a, &c); - - SEXP ans; - char *cls = "";/* -Wall */ - 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); - - /* 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) R_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)")); + static const char *valid[] = { + "dgTMatrix", "dsTMatrix", "dtTMatrix", + "lgTMatrix", "lsTMatrix", "ltTMatrix", + "ngTMatrix", "nsTMatrix", "ntTMatrix", "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + const char *class = valid[ivalid]; + memset(A, 0, sizeof(cholmod_triplet)); + + SEXP dim = GET_SLOT(from, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + + SEXP i = PROTECT(GET_SLOT(from, Matrix_pSym)), + j = PROTECT(GET_SLOT(from, Matrix_iSym)); + int *pi = INTEGER(i), *pj = INTEGER(j); + size_t nnz0 = (size_t) XLENGTH(i), nnz1 = nnz0; + + if (checkUnit && class[1] == 't') { + SEXP diag = GET_SLOT(from, Matrix_diagSym); + char di = *CHAR(STRING_ELT(diag, 0)); + if (di != 'N') + nnz1 += n; } - 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 + if (nnz0 < nnz1) { + int *tmp; + tmp = (int *) R_alloc(nnz1, sizeof(int)); + memcpy(tmp, pi, nnz1 * sizeof(int)); + pi = tmp; + tmp = (int *) R_alloc(nnz1, sizeof(int)); + memcpy(tmp, pj, nnz1 * sizeof(int)); + pj = tmp; + + pi += nnz0; pj += nnz0; + for (int d = 0; d < n; ++d) + *(pi++) = *(pj++) = d; + pi -= nnz1; pj -= nnz1; + } + A->nrow = m; + A->ncol = n; + A->i = pi; + A->j = pj; + A->nzmax = nnz1; + A->nnz = nnz1; + A->stype = 0; + A->itype = CHOLMOD_INT; + A->xtype = CHOLMOD_PATTERN; + A->dtype = CHOLMOD_DOUBLE; + + if (class[1] == 's') { + SEXP uplo = GET_SLOT(from, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + A->stype = (ul == 'U') ? 1 : -1; + } + if (class[0] != 'n') { + SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); + switch (class[0]) { + case 'l': + case 'i': + { + int *px = (TYPEOF(x) == LGLSXP) ? LOGICAL(x) : INTEGER(x); + double *rtmp = (double *) R_alloc(nnz1, sizeof(double)); + for (size_t k = 0; k < nnz0; ++k) + rtmp[k] = (px[k] == NA_INTEGER) + ? NA_REAL : (double) px[k]; + for (size_t k = nnz0; k < nnz1; ++k) + rtmp[k] = 1.0; + A->x = rtmp; + A->xtype = CHOLMOD_REAL; + break; + } + case 'd': + { + double *px = REAL(x); + if (nnz0 < nnz1) { + double *rtmp = (double *) R_alloc(nnz1, sizeof(double)); + memcpy(rtmp, px, nnz0 * sizeof(double)); + for (size_t k = nnz0; k < nnz1; ++k) + rtmp[k] = 1.0; + px = rtmp; + } + A->x = px; + A->xtype = CHOLMOD_REAL; + break; + } + case 'z': + { + Rcomplex *px = COMPLEX(x); + if (nnz0 < nnz1) { + Rcomplex *rtmp = (Rcomplex *) R_alloc(nnz1, sizeof(Rcomplex)); + memcpy(rtmp, px, nnz0 * sizeof(Rcomplex)); + for (size_t k = nnz0; k < nnz1; ++k) + rtmp[k] = Matrix_zone; + px = rtmp; + } + A->x = px; + A->xtype = CHOLMOD_COMPLEX; + break; + } + default: + break; + } + UNPROTECT(1); /* x */ + } -/** -* 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); - } + UNPROTECT(2); /* j, i */ + return A; } - /** - * 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. + * Coerce from [nlidz]geMatrix or vector to (cholmod_dense *) + * + * Sets the members of a pointed-to cholmod_dense struct, using "data" + * obtained from slots of a [nlidz]geMatrix. The result should _not_ be + * freed using cholmod_free_dense, as the resulting members point to + * memory controlled by R, not by CHOLMOD. + * + * @param A a pointer to a cholmod_dense struct, to be modified in-place. + * @param from an S4 object inheriting from class [nlidz]geMatrix _or_ + * a traditional vector of type "logical", "integer", "double", or + * "complex" (to be handled as a 1-column matrix if not a matrix). * - * @return ans containing pointers to the slots of x, *unless* - * check_Udiag and x is unitriangular. + * @return A. */ -CHM_TR as_cholmod_triplet(CHM_TR ans, SEXP x, Rboolean check_Udiag) +/* NB: mostly parallel to M2CHD in ./cholmod-etc.c */ +cholmod_dense *sexp_as_cholmod_dense(cholmod_dense *A, SEXP from) { - 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.; + static const char *valid[] = { + "dgeMatrix", "lgeMatrix", "ngeMatrix", "" }; + int ivalid = R_check_class_etc(from, valid); + memset(A, 0, sizeof(cholmod_dense)); + + int m, n; + if (ivalid < 0) { + switch (TYPEOF(from)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + break; + default: + ERROR_INVALID_TYPE(from, __func__); + break; + } + SEXP dim = getAttrib(from, R_DimSymbol); + if (TYPEOF(dim) == INTSXP && LENGTH(dim) == 2) { + m = INTEGER(dim)[0]; + n = INTEGER(dim)[1]; + } else { + m = LENGTH(from); + n = 1; + } + } else { + SEXP dim = GET_SLOT(from, Matrix_DimSym); + m = INTEGER(dim)[0]; + n = INTEGER(dim)[1]; + from = GET_SLOT(from, Matrix_xSym); + } + + A->nrow = m; + A->ncol = n; + A->nzmax = A->nrow * A->ncol; + A->d = A->nrow; + A->dtype = CHOLMOD_DOUBLE; + + size_t nx = (size_t) XLENGTH(from); + switch (TYPEOF(from)) { + case LGLSXP: + case INTSXP: + { + int *px = (TYPEOF(from) == LGLSXP) ? LOGICAL(from) : INTEGER(from), + pattern = ivalid == 2; + double *rtmp = (double *) R_alloc(nx + 1, sizeof(double)); + for (size_t ix = 0; ix < nx; ++ix) + rtmp[ix] = (px[ix] == NA_INTEGER) + ? ((pattern) ? 1.0 : NA_REAL) : (double) px[ix]; + A->x = rtmp; + A->xtype = CHOLMOD_REAL; break; - } - case 1: { /* "l" */ - int *a_x = tmp->x; - a_x[k+m] = 1; + } + case REALSXP: + A->x = REAL(from); + A->xtype = CHOLMOD_REAL; break; - } - case 2: /* "n" */ + case CPLXSXP: + A->x = COMPLEX(from); + A->xtype = CHOLMOD_COMPLEX; break; - case 3: { /* "z" */ - double *a_x = tmp->x; - a_x[2*(k+m) ] = 1.; - a_x[2*(k+m)+1] = 0.; + default: + ERROR_INVALID_TYPE(from, __func__); 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; + return A; } /** - * 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. + * Coerce from (double *) to (cholmod_dense *) with given dimensions + * + * An analogue of base::matrix(data, nrow, ncol), + * where typeof(data)=="double" and length(data)==nrow*ncol. * - * @param a matrix to be converted - * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 R_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. + * @param A a pointer to a cholmod_dense struct, to be modified in-place. + * @param data a pointer to an nrow*ncol*sizeof(double) block of memory. + * @param nrow the desired number of rows. + * @param ncol the desired number of columns. * - * @return SEXP containing a copy of a + * @return A. */ -SEXP chm_triplet_to_SEXP(CHM_TR a, int dofree, int uploT, int Rkind, - const char* diag, SEXP dn) +cholmod_dense *numeric_as_cholmod_dense(cholmod_dense *A, + double *data, int nrow, int ncol) { - 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) R_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; + memset(A, 0, sizeof(cholmod_dense)); + A->nrow = nrow; + A->ncol = ncol; + A->nzmax = A->nrow * A->ncol; + A->d = A->nrow; + A->x = data; + A->xtype = CHOLMOD_REAL; + A->dtype = CHOLMOD_DOUBLE; + return A; } -#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. + * Coerce from (cholmod_factor *) to CHMfactor * - * In most cases this function is called through the macro AS_CHM_DN. - * It is unusual to call it directly. + * Allocates an S4 object inheriting from virtual class CHMfactor + * and copies into the slots from members of a pointed-to cholmod_factor + * struct. The specific class of the result is determined by struct + * members xtype and is_super. + * + * @param L a pointer to a cholmod_factor struct. + * @param doFree a flag indicating if and how to free L before returning. + * (0) don't free, (>0) free with cholmod_free_factor, (<0) free with + * R_Free. * - * @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. + * @return A CHMfactor. */ -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) +/* NB: mostly parallel to CHF2M in ./cholmod-etc.c */ +SEXP cholmod_factor_as_sexp(cholmod_factor *L, int doFree) { - _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 */ +#define FREE_THEN(_EXPR_) \ + do { \ + if (doFree != 0) { \ + if (doFree < 0) \ + R_Free(L); \ + else if (L->itype == CHOLMOD_INT) \ + cholmod_free_factor(&L, &c); \ + else \ + cholmod_l_free_factor(&L, &cl); \ + _EXPR_; \ + } \ + } while (0) + + if (L->itype != CHOLMOD_INT) + FREE_THEN(error(_("wrong '%s'"), "itype")); + if (L->xtype != CHOLMOD_PATTERN && + L->xtype != CHOLMOD_REAL && L->xtype != CHOLMOD_COMPLEX) + FREE_THEN(error(_("wrong '%s'"), "xtype")); + if (L->dtype != CHOLMOD_DOUBLE) + FREE_THEN(error(_("wrong '%s'"), "dtype")); + if (L->n > INT_MAX) + FREE_THEN(error(_("dimensions cannot exceed %s"), "2^31-1")); + if (L->super) { + if (L->maxcsize > INT_MAX) + FREE_THEN(error(_("'%s' would overflow type \"%s\""), + "maxcsize", "integer")); + } else { + if (L->n == INT_MAX) + FREE_THEN(error(_("n+1 would overflow type \"%s\""), + "integer")); + } + if (L->minor < L->n) { + if (L->is_ll) + FREE_THEN(error(_("leading principal minor of order %d is not positive"), + (int) L->minor + 1)); + else + FREE_THEN(error(_("leading principal minor of order %d is zero"), + (int) L->minor + 1)); + } + char class[] = ".CHM....."; + class[0] = (L->xtype == CHOLMOD_PATTERN) + ? 'n' : ((L->xtype == CHOLMOD_COMPLEX) ? 'z' : 'd'); + memcpy(class + 4, (L->is_super) ? "super" : "simpl", 5); + SEXP to = PROTECT(newObject(class)), + dim = PROTECT(GET_SLOT(to, Matrix_DimSym)); + INTEGER(dim)[0] = INTEGER(dim)[1] = (int) L->n; + if (L->ordering != CHOLMOD_NATURAL) { + SEXP perm = PROTECT(allocVector(INTSXP, L->n)); + memcpy(INTEGER(perm), L->Perm, L->n * sizeof(int)); + SET_SLOT(to, Matrix_permSym, perm); + UNPROTECT(1); + } + SEXP type = PROTECT(allocVector(INTSXP, 6)), + colcount = PROTECT(allocVector(INTSXP, L->n)); + INTEGER(type)[0] = L->ordering; + INTEGER(type)[1] = (L->is_super) ? 1 : L->is_ll; + INTEGER(type)[2] = (L->is_super) ? 1 : 0; + INTEGER(type)[3] = (L->is_super) ? 1 : L->is_monotonic; + INTEGER(type)[4] = (L->is_super) ? (int) L->maxcsize : 0; + INTEGER(type)[5] = (L->is_super) ? (int) L->maxesize : 0; + memcpy(INTEGER(colcount), L->ColCount, L->n * sizeof(int)); + SET_SLOT(to, install("type"), type); + SET_SLOT(to, install("colcount"), colcount); + if (L->is_super) { + SEXP super = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + pi = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + px = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + s = PROTECT(allocVector(INTSXP, L->ssize)); + memcpy(INTEGER(super), L->super, (L->nsuper + 1) * sizeof(int)); + memcpy(INTEGER(pi), L->pi, (L->nsuper + 1) * sizeof(int)); + memcpy(INTEGER(px), L->px, (L->nsuper + 1) * sizeof(int)); + memcpy(INTEGER(s), L->s, L->ssize * sizeof(int)); + SET_SLOT(to, install("super"), super); + SET_SLOT(to, install("pi"), pi); + SET_SLOT(to, install("px"), px); + SET_SLOT(to, install("s"), s); + UNPROTECT(4); + } else if (L->xtype != CHOLMOD_PATTERN) { + SEXP p = PROTECT(allocVector(INTSXP, L->n + 1)), + i = PROTECT(allocVector(INTSXP, L->nzmax)), + nz = PROTECT(allocVector(INTSXP, L->n)), + nxt = PROTECT(allocVector(INTSXP, L->n + 2)), + prv = PROTECT(allocVector(INTSXP, L->n + 2)); + memcpy(INTEGER(p), L->p, (L->n + 1) * sizeof(int)); + memcpy(INTEGER(i), L->i, L->nzmax * sizeof(int)); + memcpy(INTEGER(nz), L->nz, L->n * sizeof(int)); + memcpy(INTEGER(nxt), L->next, (L->n + 2) * sizeof(int)); + memcpy(INTEGER(prv), L->prev, (L->n + 2) * sizeof(int)); + SET_SLOT(to, Matrix_pSym, p); + SET_SLOT(to, Matrix_iSym, i); + SET_SLOT(to, install("nz"), nz); + SET_SLOT(to, install("nxt"), nxt); + SET_SLOT(to, install("prv"), prv); + UNPROTECT(5); + } + if (L->xtype != CHOLMOD_PATTERN) { + SEXP x; + R_xlen_t nx = (R_xlen_t) ((L->is_super) ? L->xsize : L->nzmax); + if (L->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, nx)); + memcpy(COMPLEX(x), L->x, (size_t) nx * sizeof(Rcomplex)); + } else { + PROTECT(x = allocVector(REALSXP, nx)); + memcpy(REAL(x), L->x, (size_t) nx * sizeof(double)); + } + SET_SLOT(to, Matrix_xSym, x); + UNPROTECT(1); + } - /* 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 -} + FREE_THEN(); -/* 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); +#undef FREE_THEN - va_start(ap, fmt); - Rprintf((char *)fmt, ap); - va_end(ap); - return 0; + UNPROTECT(4); + return to; } /** - * Initialize the CHOLMOD library and replace the print and error functions - * by R-specific versions. + * Coerce from (cholmod_sparse *) to CsparseMatrix * - * @param c pointer to a cholmod_common structure to be initialized + * Allocates an S4 object inheriting from virtual class CsparseMatrix + * and copies into the slots from members of a pointed-to cholmod_sparse + * struct. The specific class of the result is determined by struct + * members xtype and stype and by arguments ttype and doLogic. + * + * @param A a pointer to a cholmod_sparse struct. + * @param doFree a flag indicating if and how to free A before returning. + * (0) don't free, (>0) free with cholmod_free_sparse, (<0) free with + * R_Free. + * @param ttype a flag indicating if the result should be a .tCMatrix. + * (0) not .tCMatrix, (>0) .tCMatrix with uplo="U", (<0) .tCMatrix + * with uplo="L". If ttype=0, then the result is a .gCMatrix or + * .sCMatrix depending on stype. (0) .gCMatrix, (>0) .sCMatrix with + * uplo="U", (<0) .sCMatrix with uplo="L". + * @param doLogic a flag indicating if the result should be a l.CMatrix + * if xtype=CHOLMOD_REAL. + * @param diagString a null-terminated string or NULL. The diag slot + * of a .tCMatrix result is "N" if and only if diagString is NULL + * or diagString[0] is 'N'. + * @param dimnames an R object specifying the Dimnames slot of the result, + * unused if not a list of length 2. * - * @return TRUE if successful + * @return A CsparseMatrix. */ -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; +/* NB: mostly parallel to CHS2M in ./cholmod-etc.c */ +SEXP cholmod_sparse_as_sexp(cholmod_sparse *A, int doFree, + int ttype, int doLogic, const char *diagString, + SEXP dimnames) +{ + +#define FREE_THEN(_EXPR_) \ + do { \ + if (doFree != 0) { \ + if (doFree < 0) \ + R_Free(A); \ + else if (A->itype == CHOLMOD_INT) \ + cholmod_free_sparse(&A, &c); \ + else \ + cholmod_l_free_sparse(&A, &cl); \ + _EXPR_; \ + } \ + } while (0) + + if (A->itype != CHOLMOD_INT) + FREE_THEN(error(_("wrong '%s'"), "itype")); + if (A->xtype != CHOLMOD_PATTERN && + A->xtype != CHOLMOD_REAL && A->xtype != CHOLMOD_COMPLEX) + FREE_THEN(error(_("wrong '%s'"), "xtype")); + if (A->dtype != CHOLMOD_DOUBLE) + FREE_THEN(error(_("wrong '%s'"), "dtype")); + if (A->nrow > INT_MAX || A->ncol > INT_MAX) + FREE_THEN(error(_("dimensions cannot exceed %s"), "2^31-1")); + if (A->stype != 0 || !A->sorted || !A->packed) + cholmod_sort(A, &c); + int m = (int) A->nrow, n = (int) A->ncol, nnz = ((int *) A->p)[A->ncol]; + R_xlen_t n1a = (R_xlen_t) n + 1; + char class[] = "..CMatrix"; + class[0] = (A->xtype == CHOLMOD_PATTERN) + ? 'n' : ((A->xtype == CHOLMOD_COMPLEX) ? 'z' : ((doLogic) ? 'l' : 'd')); + class[1] = (ttype != 0) ? 't' : ((A->stype != 0) ? 's' : 'g'); + SEXP to = PROTECT(newObject(class)), + dim = PROTECT(GET_SLOT(to, Matrix_DimSym)), + p = PROTECT(allocVector(INTSXP, n1a)), + i = PROTECT(allocVector(INTSXP, nnz)); + INTEGER(dim)[0] = m; + INTEGER(dim)[1] = n; + memcpy(INTEGER(p), A->p, (size_t) n1a * sizeof(int)); + memcpy(INTEGER(i), A->i, (size_t) nnz * sizeof(int)); + SET_SLOT(to, Matrix_pSym, p); + SET_SLOT(to, Matrix_iSym, i); + if (A->xtype != CHOLMOD_PATTERN) { + SEXP x; + if (A->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, nnz)); + memcpy(COMPLEX(x), A->x, (size_t) nnz * sizeof(Rcomplex)); + } else if (!doLogic) { + PROTECT(x = allocVector(REALSXP, nnz)); + memcpy(REAL(x), A->x, (size_t) nnz * sizeof(double)); + } else { + PROTECT(x = allocVector(LGLSXP, nnz)); + int *px = LOGICAL(x); + double *py = (double *) A->x; + for (int k = 0; k < nnz; ++k) + px[k] = (ISNAN(py[k])) ? NA_LOGICAL : (py[k] != 0.0); + } + SET_SLOT(to, Matrix_xSym, x); + UNPROTECT(1); + } + if (ttype < 0 || A->stype < 0) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); + } + if (ttype != 0 && diagString && diagString[0] != 'N') { + SEXP diag = PROTECT(mkString("U")); + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); + } + if (TYPEOF(dimnames) == VECSXP && LENGTH(dimnames) == 2) + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + + FREE_THEN(); + +#undef FREE_THEN + + UNPROTECT(4); + return to; } /** - * Copy the contents of a to an appropriate denseMatrix object and, - * optionally, free a or free both a and its pointer to its contents. + * Coerce from (cholmod_triplet *) to TsparseMatrix * - * @param a matrix to be converted - * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 R_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" + * Allocates an S4 object inheriting from virtual class TsparseMatrix + * and copies into the slots from members of a pointed-to cholmod_triplet + * struct. The specific class of the result is determined by struct + * members xtype and stype and by arguments ttype and doLogic. + * + * @param A a pointer to a cholmod_triplet struct. + * @param doFree a flag indicating if and how to free A before returning. + * (0) don't free, (>0) free with cholmod_free_triplet, (<0) free with + * R_Free. + * @param ttype a flag indicating if the result should be a .tTMatrix. + * (0) not .tTMatrix, (>0) .tTMatrix with uplo="U", (<0) .tTMatrix + * with uplo="L". If ttype=0, then the result is a .gTMatrix or + * .sTMatrix depending on stype. (0) .gTMatrix, (>0) .sTMatrix with + * uplo="U", (<0) .sTMatrix with uplo="L". + * @param doLogic a flag indicating if the result should be an l.TMatrix + * if xtype=CHOLMOD_REAL. + * @param diagString a null-terminated string or NULL. The diag slot + * of a .tTMatrix result is "N" if and only if diagString is NULL + * or diagString[0] is 'N'. + * @param dimnames an R object specifying the Dimnames slot of the result, + * unused if not a list of length 2. * - * @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) R_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; + * @return A TsparseMatrix. */ - 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); +SEXP cholmod_triplet_as_sexp(cholmod_triplet *A, int doFree, + int ttype, int doLogic, const char *diagString, + SEXP dimnames) +{ + +#define FREE_THEN(_EXPR_) \ + do { \ + if (doFree != 0) { \ + if (doFree < 0) \ + R_Free(A); \ + else if (A->itype == CHOLMOD_INT) \ + cholmod_free_triplet(&A, &c); \ + else \ + cholmod_l_free_triplet(&A, &cl); \ + _EXPR_; \ + } \ + } while (0) + + if (A->itype != CHOLMOD_INT) + FREE_THEN(error(_("wrong '%s'"), "itype")); + if (A->xtype != CHOLMOD_PATTERN && + A->xtype != CHOLMOD_REAL && A->xtype != CHOLMOD_COMPLEX) + FREE_THEN(error(_("wrong '%s'"), "xtype")); + if (A->dtype != CHOLMOD_DOUBLE) + FREE_THEN(error(_("wrong '%s'"), "dtype")); + if (A->nrow > INT_MAX || A->ncol > INT_MAX) + FREE_THEN(error(_("dimensions cannot exceed %s"), "2^31-1")); + int m = (int) A->nrow, n = (int) A->ncol; + R_xlen_t nnz = (R_xlen_t) A->nnz; + char class[] = "..TMatrix"; + class[0] = (A->xtype == CHOLMOD_PATTERN) + ? 'n' : ((A->xtype == CHOLMOD_COMPLEX) ? 'z' : ((doLogic) ? 'l' : 'd')); + class[1] = (ttype != 0) ? 't' : ((A->stype != 0) ? 's' : 'g'); + SEXP to = PROTECT(newObject(class)), + dim = PROTECT(GET_SLOT(to, Matrix_DimSym)), + i = PROTECT(allocVector(INTSXP, nnz)), + j = PROTECT(allocVector(INTSXP, nnz)); + INTEGER(dim)[0] = m; + INTEGER(dim)[1] = n; + memcpy(INTEGER(i), A->i, (size_t) nnz * sizeof(int)); + memcpy(INTEGER(j), A->j, (size_t) nnz * sizeof(int)); + if (A->stype != 0) { + int tmp, *pi = INTEGER(i), *pj = INTEGER(j); + for (R_xlen_t k = 0; k < nnz; ++k) { + tmp = pi[k]; + pi[k] = pj[k]; + pj[k] = tmp; } - 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]; - } + } + SET_SLOT(to, Matrix_iSym, i); + SET_SLOT(to, Matrix_jSym, j); + if (A->xtype != CHOLMOD_PATTERN) { + SEXP x; + if (A->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, nnz)); + memcpy(COMPLEX(x), A->x, (size_t) nnz * sizeof(Rcomplex)); + } else if (!doLogic) { + PROTECT(x = allocVector(REALSXP, nnz)); + memcpy(REAL(x), A->x, (size_t) nnz * sizeof(double)); } else { - for (i=0; i < ntot; i++) - m_x[i] = ISNAN(a_x[i]) ? NA_LOGICAL : (a_x[i] != 0); + PROTECT(x = allocVector(LGLSXP, nnz)); + int *px = LOGICAL(x); + double *py = (double *) A->x; + for (R_xlen_t k = 0; k < nnz; ++k) + px[k] = (ISNAN(py[k])) ? NA_LOGICAL : (py[k] != 0.0); } - break; - } + SET_SLOT(to, Matrix_xSym, x); + UNPROTECT(1); } - 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; -} + if (ttype < 0 || A->stype < 0) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); + } + if (ttype != 0 && diagString && diagString[0] != 'N') { + SEXP diag = PROTECT(mkString("U")); + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); + } + if (TYPEOF(dimnames) == VECSXP && LENGTH(dimnames) == 2) + SET_SLOT(to, Matrix_DimNamesSym, dimnames); -/** - * 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 R_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; + FREE_THEN(); + +#undef FREE_THEN + + UNPROTECT(4); + return to; } /** - * Copy the contents of a to a numeric R object and, optionally, free a - * or free both a and its pointer to its contents. + * Coerce from (cholmod_dense *) to [dz]geMatrix * - * @param a cholmod_dense structure to be converted - * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 R_Free a + * Allocates an S4 object of class [dz]geMatrix + * and copies into the slots from members of a pointed-to cholmod_dense + * struct. The specific class of the result is determined by struct + * member xtype. + * + * @param A a pointer to a cholmod_dense struct. + * @param doFree a flag indicating if and how to free A before returning. + * (0) don't free, (>0) free with cholmod_free_dense, (<0) free with + * R_Free. * - * @return SEXP containing a copy of a in the sense of as.vector(a) + * @return A [dz]geMatrix. */ -SEXP chm_dense_to_vector(CHM_DN a, int dofree) +/* NB: mostly parallel to CHD2M in ./cholmod-etc.c */ +SEXP cholmod_dense_as_sexp(cholmod_dense *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; -} +#define FREE_THEN(_EXPR_) \ + do { \ + if (doFree != 0) { \ + if (doFree < 0) \ + R_Free(A); \ + else \ + cholmod_free_dense(&A, &c); \ + _EXPR_; \ + } \ + } while (0) + + if (A->xtype != CHOLMOD_REAL && A->xtype != CHOLMOD_COMPLEX) + FREE_THEN(error(_("wrong '%s'"), "xtype")); + if (A->dtype != CHOLMOD_DOUBLE) + FREE_THEN(error(_("wrong '%s'"), "dtype")); + if (A->d != A->nrow) /* MJ: currently no need to support this case */ + FREE_THEN(error(_("leading dimension not equal to number of rows"))); + if (A->nrow > INT_MAX || A->ncol > INT_MAX) + FREE_THEN(error(_("dimensions cannot exceed %s"), "2^31-1")); + int m = (int) A->nrow, n = (int) A->ncol; + if ((Matrix_int_fast64_t) m * n > R_XLEN_T_MAX) + FREE_THEN(error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX")); + char class[] = ".geMatrix"; + class[0] = (A->xtype == CHOLMOD_COMPLEX) ? 'z' : 'd'; + SEXP to = PROTECT(newObject(class)), + dim = PROTECT(GET_SLOT(to, Matrix_DimSym)); + INTEGER(dim)[0] = m; + INTEGER(dim)[1] = n; + SEXP x; + if (A->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, (R_xlen_t) m * n)); + memcpy(COMPLEX(x), A->x, (size_t) m * n * sizeof(Rcomplex)); + } else { + PROTECT(x = allocVector(REALSXP, (R_xlen_t) m * n)); + memcpy(REAL(x), A->x, (size_t) m * n * sizeof(double)); + } + SET_SLOT(to, Matrix_xSym, x); -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; -} + FREE_THEN(); -/** - * 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 ctype = R_check_class_etc(x, valid); - if (ctype < 0) - error(_("object of invalid class to 'as_cholmod_factor()'")); - memset(ans, 0, sizeof(cholmod_factor)); - - SEXP tmp = GET_SLOT(x, install("type")); - int *type = INTEGER(tmp); - - ans->ordering = type[0]; - ans->is_super = type[2]; - - tmp = GET_SLOT(x, install("colcount")); - ans->n = LENGTH(tmp); - ans->minor = ans->n; - ans->ColCount = INTEGER(tmp); - - if (ans->ordering != CHOLMOD_NATURAL) - ans->Perm = INTEGER(GET_SLOT(x, Matrix_permSym)); - else { - int j, n = (int) ans->n, *Perm = (int *) R_alloc(ans->n, sizeof(int)); - for (j = 0; j < n; ++j) - Perm[j] = j; - ans->Perm = Perm; - } - - ans->itype = CHOLMOD_INT; - ans->dtype = CHOLMOD_DOUBLE; - if (ctype >= 2) - ans->xtype = CHOLMOD_PATTERN; - else { - ans->xtype = CHOLMOD_REAL; - ans->x = REAL(GET_SLOT(x, Matrix_xSym)); - } - - if (ans->is_super) { - tmp = GET_SLOT(x, install("super")); - ans->nsuper = LENGTH(tmp) - 1; - ans->super = INTEGER(tmp); - ans->pi = INTEGER(GET_SLOT(x, install("pi"))); - ans->px = INTEGER(GET_SLOT(x, install("px"))); - ans->s = INTEGER(GET_SLOT(x, install("s"))); - ans->ssize = ((int *) ans->pi)[ans->nsuper]; - ans->xsize = ((int *) ans->px)[ans->nsuper]; - ans->maxcsize = type[4]; - ans->maxesize = type[5]; - ans->is_ll = 1; - ans->is_monotonic = 1; - } else { - 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"))); - ans->nzmax = ((int *) ans->p)[ans->n]; - ans->is_ll = type[1]; - ans->is_monotonic = type[3]; - } - - if (do_check && !cholmod_check_factor(ans, &c)) - error(_("failure in as_cholmod_factor")); - return ans; +#undef FREE_THEN + + UNPROTECT(3); + return to; } -// 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. + * Log determinant from Cholesky factorization * - * In most cases this function is called through the macro AS_CHM_FR. - * It is unusual to call it directly. + * Computes log(det(A)) given the Cholesky factorization of A as + * P1 * A * P1' = L1 * D * L1' = L * L', L = L1 * sqrt(D). The + * result is computed as sum(log(diag(D))) or 2*sum(log(diag(L))), + * depending on members is_super and is_ll of the supplied struct. + * Note that CHOLMOD does not require diag(D) to be positive and + * that this routine does not check (FIXME). * - * @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. + * @param L a pointer to a cholmod_factor struct. It is assumed that + * L->xtype=CHOLMOD_REAL. */ -CHM_FR as_cholmod_factor(CHM_FR ans, SEXP x) { - return as_cholmod_factor3(ans, x, /* do_check = */ TRUE); +double cholmod_factor_ldetA(cholmod_factor *L) +{ + int i, j, p; + double ans = 0; + if (L->is_super) { + int *lpi = (int *) L->pi, *lsup = (int *) L->super; + for (i = 0; i < L->nsuper; i++) { + int nrp1 = 1 + lpi[i + 1] - lpi[i], + nc = lsup[i + 1] - lsup[i]; + double *x = (double *) L->x + ((int *) L->px)[i]; + for (R_xlen_t jn = 0, j = 0; j < nc; j++, jn += nrp1) + ans += 2.0 * log(fabs(x[jn])); + } + } else { + int *li = (int *) L->i, *lp = (int *) L->p; + double *lx = (double *) L->x; + for (j = 0; j < L->n; j++) { + for (p = lp[j]; li[p] != j && p < lp[j + 1]; p++) + ; + if (li[p] != j) { + error(_("invalid simplicial Cholesky factorization: structural zero on main diagonal in column %d"), + j); + break; + } + ans += log(lx[p] * ((L->is_ll) ? lx[p] : 1.0)); + } + } + return ans; } - /** - * Copy the contents of f to an appropriate CHMfactor object and, - * optionally, free f or free both f and its pointer to its contents. + * Update a Cholesky factorization * - * @param f cholmod_factor object to be converted - * @param dofree 0 - don't free a; > 0 cholmod_free a; < 0 R_Free a + * Updates in-place the Cholesky factorization of a symmetric matrix + * X+alpha*I with the Cholesky factorization of + * (1) A+beta*I, where A is a symmetric matrix sharing the nonzero pattern + * of X, or + * (2) A*A'+beta*I, where A is a general matrix sharing the nonzero pattern + * of Y, assuming that X = Y*Y'. + * + * @param L a pointer to a cholmod_factor struct, to be modified in-place. + * @param A a pointer to a cholmod_sparse struct. + * @param beta a multiplier, typically positive, to guarantee strict + * diagonal dominance. * - * @return SEXP containing a copy of a + * @return L. */ -SEXP chm_factor_to_SEXP(CHM_FR f, int dofree) +cholmod_factor *cholmod_factor_update(cholmod_factor *L, cholmod_sparse *A, + double beta) { - 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 */ R_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 */ - type = INTEGER(ALLOC_SLOT(ans, install("type"), INTSXP, 6)); - type[0] = f->ordering; type[1] = f->is_ll; - type[2] = f->is_super; type[3] = f->is_monotonic; - type[4] = f->maxcsize; type[5] = f->maxesize; - Memcpy(INTEGER(ALLOC_SLOT(ans, install("colcount"), INTSXP, f->n)), - (int*)f->ColCount, f->n); - if (f->ordering != CHOLMOD_NATURAL) { - Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_permSym, INTSXP, f->n)), - (int*)f->Perm, f->n); - } - if (f->is_super) { - 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; + int ll = L->is_ll; + double z[2]; + z[0] = beta; + z[1] = 0.0; + if (!cholmod_factorize_p(A, z, NULL, 0, L, &c)) + error(_("'%s' failed in '%s'"), "cholmod_factorize_p", __func__); + if (L->is_ll != ll && + !cholmod_change_factor(L->xtype, ll, L->is_super, 1, 1, L, &c)) + error(_("'%s' failed in '%s'"), "cholmod_change_factor", __func__); + return L; } -#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) +#if 0 +static +int R_cholmod_print_function(const char *fmt, ...) { - 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 */ + va_list(ap); + va_start(ap, fmt); + Rprintf((char *) fmt, ap); + va_end(ap); + return 0; +} +#endif - /* 1) drop the first column-entry == diagonal entry */ - i_from++; +static +void R_cholmod_error_handler(int status, const char *file, int line, + const char *message) +{ + R_cholmod_common_envget(); + if (status < 0) + 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); +} + +int R_cholmod_start(cholmod_common *Common) +{ + int ans = cholmod_start(Common); + if (!ans) + error(_("'%s' failed in '%s'"), "cholmod_start", __func__); +#if 0 + /* No longer, with SuiteSparse 5.7.1 : */ + Common->print_function = +# if 0 + R_cholmod_print_function; +# else + NULL; +# endif +#endif + Common->error_handler = R_cholmod_error_handler; + return ans; +} - /* 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); - } +int R_cholmod_finish(cholmod_common *Common) +{ + int ans = cholmod_finish(Common); + if (!ans) + error(_("'%s' failed in '%s'"), "cholmod_finish", __func__); + return ans; +} - /* the column pointers are modified the same in both cases :*/ - for(i=1; i <= n; i++) - _p(i) -= i; +SEXP cholmod_common_env; -#undef _i -#undef _x -#undef _p +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, + postorderSym, + m0_ordSym; + +SEXP R_cholmod_common_envini(SEXP rho) { + if (!isEnvironment(rho)) + ERROR_INVALID_TYPE(rho, __func__); + cholmod_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"); + postorderSym = install("postorder"); + m0_ordSym = install("m0.ord"); + R_cholmod_common_envset(); + return R_NilValue; +} + +void R_cholmod_common_envset(void) { + SEXP rho = cholmod_common_env, tmp; + +#define SET_FRAME_FROM_MEMBER(_MEMBER_, _KIND_) \ + do { \ + PROTECT(tmp = Scalar ## _KIND_(c. _MEMBER_)); \ + defineVar(_MEMBER_ ## Sym, tmp, rho); \ + UNPROTECT(1); \ + } while (0) + + SET_FRAME_FROM_MEMBER(dbound, Real); + SET_FRAME_FROM_MEMBER(grow0, Real); + SET_FRAME_FROM_MEMBER(grow1, Real); + SET_FRAME_FROM_MEMBER(grow2, Integer); + SET_FRAME_FROM_MEMBER(maxrank, Integer); + SET_FRAME_FROM_MEMBER(supernodal_switch, Real); + SET_FRAME_FROM_MEMBER(supernodal, Logical); + SET_FRAME_FROM_MEMBER(final_asis, Logical); + SET_FRAME_FROM_MEMBER(final_super, Logical); + SET_FRAME_FROM_MEMBER(final_ll, Logical); + SET_FRAME_FROM_MEMBER(final_pack, Logical); + SET_FRAME_FROM_MEMBER(final_monotonic, Logical); + SET_FRAME_FROM_MEMBER(final_resymbol, Logical); + SET_FRAME_FROM_MEMBER(prefer_zomplex, Logical); + SET_FRAME_FROM_MEMBER(prefer_upper, Logical); + SET_FRAME_FROM_MEMBER(quick_return_if_not_posdef, Logical); + SET_FRAME_FROM_MEMBER(nmethods, Integer); + SET_FRAME_FROM_MEMBER(postorder, Logical); + + PROTECT(tmp = ScalarInteger(c.method[0].ordering)); + defineVar(m0_ordSym, tmp, rho); + UNPROTECT(1); + + return; +} + +void R_cholmod_common_envget(void) { + SEXP rho = cholmod_common_env, tmp; + +#define GET_MEMBER_FROM_FRAME(_MEMBER_, _KIND_) \ + do { \ + PROTECT(tmp = findVarInFrame(rho, _MEMBER_ ## Sym)); \ + c. _MEMBER_ = as ## _KIND_(tmp); \ + UNPROTECT(1); \ + } while (0) + + GET_MEMBER_FROM_FRAME(dbound, Real); + GET_MEMBER_FROM_FRAME(grow0, Real); + GET_MEMBER_FROM_FRAME(grow1, Real); + GET_MEMBER_FROM_FRAME(grow2, Integer); + GET_MEMBER_FROM_FRAME(maxrank, Integer); + GET_MEMBER_FROM_FRAME(supernodal_switch, Real); + GET_MEMBER_FROM_FRAME(supernodal, Logical); + GET_MEMBER_FROM_FRAME(final_asis, Logical); + GET_MEMBER_FROM_FRAME(final_super, Logical); + GET_MEMBER_FROM_FRAME(final_ll, Logical); + GET_MEMBER_FROM_FRAME(final_pack, Logical); + GET_MEMBER_FROM_FRAME(final_monotonic, Logical); + GET_MEMBER_FROM_FRAME(final_resymbol, Logical); + GET_MEMBER_FROM_FRAME(prefer_zomplex, Logical); + GET_MEMBER_FROM_FRAME(prefer_upper, Logical); + GET_MEMBER_FROM_FRAME(quick_return_if_not_posdef, Logical); + GET_MEMBER_FROM_FRAME(nmethods, Integer); + GET_MEMBER_FROM_FRAME(postorder, Logical); + + PROTECT(tmp = findVarInFrame(rho, m0_ordSym)); + c.method[0].ordering = asInteger(tmp); + UNPROTECT(1); - if(do_realloc) /* shorten (i- and x-slots from nnz to n_nnz */ - cholmod_reallocate_sparse(n_nnz, chx, &c); - return; + return; } diff -Nru rmatrix-1.6-1.1/src/chm_common.h rmatrix-1.6-5/src/chm_common.h --- rmatrix-1.6-1.1/src/chm_common.h 2023-04-21 20:59:55.000000000 +0000 +++ rmatrix-1.6-5/src/chm_common.h 2023-11-27 20:27:27.000000000 +0000 @@ -1,91 +1,33 @@ -#ifndef CHM_COMMON_H -#define CHM_COMMON_H +#ifndef MATRIX_CHM_COMMON_H +#define MATRIX_CHM_COMMON_H -#include "SuiteSparse_config/SuiteSparse_config.h" -#include "CHOLMOD/Include/cholmod.h" -#include "Mutils.h" -// -> R_check_class() et al - -#ifdef Matrix_WithSPQR -# 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(void); -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 CHM_set_common_env(SEXP rho); -void CHM_store_common(void); -void CHM_restore_common(void); -#endif +#include "cholmod-etc.h" + +cholmod_factor * sexp_as_cholmod_factor (cholmod_factor *, SEXP); +cholmod_sparse * sexp_as_cholmod_sparse (cholmod_sparse *, SEXP, + Rboolean, Rboolean); +cholmod_triplet * sexp_as_cholmod_triplet(cholmod_triplet *, SEXP, + Rboolean); +cholmod_dense * sexp_as_cholmod_dense (cholmod_dense *, SEXP); +cholmod_dense *numeric_as_cholmod_dense (cholmod_dense *, double *, + int, int); + +SEXP cholmod_factor_as_sexp (cholmod_factor *, int); +SEXP cholmod_sparse_as_sexp (cholmod_sparse *, int, + int, int, const char *, SEXP); +SEXP cholmod_triplet_as_sexp(cholmod_triplet *, int, + int, int, const char *, SEXP); +SEXP cholmod_dense_as_sexp (cholmod_dense *, int); + +double cholmod_factor_ldetA (cholmod_factor *); +cholmod_factor *cholmod_factor_update(cholmod_factor *, cholmod_sparse *, + double); + +int R_cholmod_start (cholmod_common *); +int R_cholmod_finish(cholmod_common *); + +SEXP R_cholmod_common_envini(SEXP); +void R_cholmod_common_envset(void); +void R_cholmod_common_envget(void); + +#endif /* MATRIX_CHM_COMMON_H */ diff -Nru rmatrix-1.6-1.1/src/cholmod-etc.c rmatrix-1.6-5/src/cholmod-etc.c --- rmatrix-1.6-1.1/src/cholmod-etc.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/cholmod-etc.c 2024-01-06 06:57:56.000000000 +0000 @@ -0,0 +1,358 @@ +#include "Mdefines.h" +#include "idz.h" +#include "cholmod-etc.h" + +cholmod_common c ; +cholmod_common cl; + +cholmod_factor *M2CHF(SEXP obj, int values) +{ + cholmod_factor *L = (cholmod_factor *) R_alloc(1, sizeof(cholmod_factor)); + memset(L, 0, sizeof(cholmod_factor)); + SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + type = PROTECT(GET_SLOT(obj, install("type"))), + perm = PROTECT(GET_SLOT(obj, Matrix_permSym)), + colcount = PROTECT(GET_SLOT(obj, install("colcount"))), + x = PROTECT(getAttrib(obj, Matrix_xSym)); + L->n = INTEGER(dim)[0]; + L->minor = L->n; /* FIXME: could be wrong for obj <- new(...) */ + L->ordering = INTEGER(type)[0]; + if (L->ordering != CHOLMOD_NATURAL) + L->Perm = INTEGER(perm); + else { + /* cholmod_check_factor allows L->Perm == NULL, + but cholmod_copy_factor does not test, so it segfaults ... + */ + int n = (int) L->n, *Perm = (int *) R_alloc(L->n, sizeof(int)); + for (int j = 0; j < n; ++j) + Perm[j] = j; + L->Perm = Perm; + } + L->ColCount = INTEGER(colcount); + L->is_super = INTEGER(type)[2]; + if (L->is_super) { + L->is_ll = 1; + L->is_monotonic = 1; + SEXP super = PROTECT(GET_SLOT(obj, install("super"))), + pi = PROTECT(GET_SLOT(obj, install("pi"))), + px = PROTECT(GET_SLOT(obj, install("px"))), + s = PROTECT(GET_SLOT(obj, install("s"))); + L->super = INTEGER(super); + L->pi = INTEGER(pi); + L->px = INTEGER(px); + L->s = INTEGER(s); + L->nsuper = LENGTH(super) - 1; + L->ssize = ((int *) L->pi)[L->nsuper]; + L->xsize = ((int *) L->px)[L->nsuper]; + L->maxcsize = INTEGER(type)[4]; + L->maxesize = INTEGER(type)[5]; + UNPROTECT(4); + } else { + L->is_ll = INTEGER(type)[1]; + L->is_monotonic = INTEGER(type)[3]; + if (values && x != R_NilValue) { + SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, Matrix_iSym)), + nz = PROTECT(GET_SLOT(obj, install("nz"))), + nxt = PROTECT(GET_SLOT(obj, install("nxt"))), + prv = PROTECT(GET_SLOT(obj, install("prv"))); + L->p = INTEGER(p); + L->i = INTEGER(i); + L->nz = INTEGER(nz); + L->next = INTEGER(nxt); + L->prev = INTEGER(prv); + L->nzmax = ((int *) L->p)[L->n]; + UNPROTECT(5); + } + } + L->itype = CHOLMOD_INT; + L->dtype = CHOLMOD_DOUBLE; + if (values && x != R_NilValue) { + switch (TYPEOF(x)) { + case CPLXSXP: + L->x = COMPLEX(x); + L->xtype = CHOLMOD_COMPLEX; + break; + case REALSXP: + L->x = REAL(x); + L->xtype = CHOLMOD_REAL; + break; + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + } + UNPROTECT(5); + return L; +} + +cholmod_sparse *M2CHS(SEXP obj, int values) +{ + cholmod_sparse *A = (cholmod_sparse *) R_alloc(1, sizeof(cholmod_sparse)); + memset(A, 0, sizeof(cholmod_sparse)); + SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, Matrix_iSym)), + x = PROTECT(getAttrib(obj, Matrix_xSym)); + A->nrow = INTEGER(dim)[0]; + A->ncol = INTEGER(dim)[1]; + A->p = INTEGER(p); + A->i = INTEGER(i); + A->nzmax = ((int *) A->p)[A->ncol]; + A->stype = 0; + A->itype = CHOLMOD_INT; + A->xtype = CHOLMOD_PATTERN; + A->dtype = CHOLMOD_DOUBLE; + A->sorted = 1; + A->packed = 1; + if (values && x != R_NilValue) { + switch (TYPEOF(x)) { + case CPLXSXP: + A->x = COMPLEX(x); + A->xtype = CHOLMOD_COMPLEX; + break; + case REALSXP: + A->x = REAL(x); + A->xtype = CHOLMOD_REAL; + break; + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + } + UNPROTECT(4); + return A; +} + +cholmod_dense *M2CHD(SEXP obj, int trans) +{ + cholmod_dense *A = (cholmod_dense *) R_alloc(1, sizeof(cholmod_dense)); + memset(A, 0, sizeof(cholmod_dense)); + SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + int m = INTEGER(dim)[0], n = INTEGER(dim)[1]; + A->nrow = ((trans) ? n : m); + A->ncol = ((trans) ? m : n); + A->nzmax = A->nrow * A->ncol; + A->d = A->nrow; + A->dtype = CHOLMOD_DOUBLE; + switch (TYPEOF(x)) { + case CPLXSXP: + { + Rcomplex *px = COMPLEX(x); + if (!trans) + A->x = px; + else { + Rcomplex *py = R_Calloc(A->nzmax, Rcomplex); + ztranspose2(py, px, m, n); + A->x = py; /* NB: caller must do R_Free(A->x) */ + } + A->xtype = CHOLMOD_COMPLEX; + break; + } + case REALSXP: + { + double *px = REAL(x); + if (!trans) + A->x = px; + else { + double *py = R_Calloc(A->nzmax, double); + dtranspose2(py, px, m, n); + A->x = py; /* NB: caller must do R_Free(A->x) */ + } + A->xtype = CHOLMOD_REAL; + break; + } + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + UNPROTECT(2); + return A; +} + +SEXP CHF2M(cholmod_factor *L, int values) +{ + if (L->itype != CHOLMOD_INT) + error(_("wrong '%s'"), "itype"); + if (values && L->xtype != CHOLMOD_REAL && L->xtype != CHOLMOD_COMPLEX) + error(_("wrong '%s'"), "xtype"); + if (values && L->dtype != CHOLMOD_DOUBLE) + error(_("wrong '%s'"), "dtype"); + if (L->n > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + if (L->super) { + if (L->maxcsize > INT_MAX) + error(_("'%s' would overflow type \"%s\""), + "maxcsize", "integer"); + } else { + if (L->n == INT_MAX) + error(_("n+1 would overflow type \"%s\""), + "integer"); + } + if (L->minor < L->n) { + if (L->is_ll) + error(_("leading principal minor of order %d is not positive"), + (int) L->minor + 1); + else + error(_("leading principal minor of order %d is zero"), + (int) L->minor + 1); + } + char cl[] = ".CHM....."; + cl[0] = (!values) ? 'n' : ((L->xtype == CHOLMOD_COMPLEX) ? 'z' : 'd'); + memcpy(cl + 4, (L->is_super) ? "super" : "simpl", 5); + SEXP obj = PROTECT(newObject(cl)), + dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + INTEGER(dim)[0] = INTEGER(dim)[1] = (int) L->n; + if (L->ordering != CHOLMOD_NATURAL) { + SEXP perm = PROTECT(allocVector(INTSXP, L->n)); + Matrix_memcpy(INTEGER(perm), L->Perm, L->n, sizeof(int)); + SET_SLOT(obj, Matrix_permSym, perm); + UNPROTECT(1); + } + SEXP type = PROTECT(allocVector(INTSXP, 6)), + colcount = PROTECT(allocVector(INTSXP, L->n)); + INTEGER(type)[0] = L->ordering; + INTEGER(type)[1] = (L->is_super) ? 1 : L->is_ll; + INTEGER(type)[2] = (L->is_super) ? 1 : 0; + INTEGER(type)[3] = (L->is_super) ? 1 : L->is_monotonic; + INTEGER(type)[4] = (L->is_super) ? (int) L->maxcsize : 0; + INTEGER(type)[5] = (L->is_super) ? (int) L->maxesize : 0; + Matrix_memcpy(INTEGER(colcount), L->ColCount, L->n, sizeof(int)); + SET_SLOT(obj, install("type"), type); + SET_SLOT(obj, install("colcount"), colcount); + if (L->is_super) { + SEXP super = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + pi = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + px = PROTECT(allocVector(INTSXP, L->nsuper + 1)), + s = PROTECT(allocVector(INTSXP, L->ssize)); + Matrix_memcpy(INTEGER(super), L->super, L->nsuper + 1, sizeof(int)); + Matrix_memcpy(INTEGER(pi), L->pi, L->nsuper + 1, sizeof(int)); + Matrix_memcpy(INTEGER(px), L->px, L->nsuper + 1, sizeof(int)); + Matrix_memcpy(INTEGER(s), L->s, L->ssize, sizeof(int)); + SET_SLOT(obj, install("super"), super); + SET_SLOT(obj, install("pi"), pi); + SET_SLOT(obj, install("px"), px); + SET_SLOT(obj, install("s"), s); + UNPROTECT(4); + } else if (values) { + SEXP p = PROTECT(allocVector(INTSXP, L->n + 1)), + i = PROTECT(allocVector(INTSXP, L->nzmax)), + nz = PROTECT(allocVector(INTSXP, L->n)), + nxt = PROTECT(allocVector(INTSXP, L->n + 2)), + prv = PROTECT(allocVector(INTSXP, L->n + 2)); + Matrix_memcpy(INTEGER(p), L->p, L->n + 1, sizeof(int)); + Matrix_memcpy(INTEGER(i), L->i, L->nzmax, sizeof(int)); + Matrix_memcpy(INTEGER(nz), L->nz, L->n, sizeof(int)); + Matrix_memcpy(INTEGER(nxt), L->next, L->n + 2, sizeof(int)); + Matrix_memcpy(INTEGER(prv), L->prev, L->n + 2, sizeof(int)); + SET_SLOT(obj, Matrix_pSym, p); + SET_SLOT(obj, Matrix_iSym, i); + SET_SLOT(obj, install("nz"), nz); + SET_SLOT(obj, install("nxt"), nxt); + SET_SLOT(obj, install("prv"), prv); + UNPROTECT(5); + } + if (values) { + SEXP x; + R_xlen_t nx = (R_xlen_t) ((L->is_super) ? L->xsize : L->nzmax); + if (L->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, nx)); + Matrix_memcpy(COMPLEX(x), L->x, nx, sizeof(Rcomplex)); + } else { + PROTECT(x = allocVector(REALSXP, nx)); + Matrix_memcpy(REAL(x), L->x, nx, sizeof(double)); + } + SET_SLOT(obj, Matrix_xSym, x); + UNPROTECT(1); + } + UNPROTECT(4); + return obj; +} + +SEXP CHS2M(cholmod_sparse *A, int values, char shape) +{ + if (A->itype != CHOLMOD_INT) + error(_("wrong '%s'"), "itype"); + if (values && A->xtype != CHOLMOD_REAL && A->xtype != CHOLMOD_COMPLEX) + error(_("wrong '%s'"), "xtype"); + if (values && A->dtype != CHOLMOD_DOUBLE) + error(_("wrong '%s'"), "dtype"); + if (A->nrow > INT_MAX || A->ncol > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + if (A->stype != 0 || !A->sorted || !A->packed) + cholmod_sort(A, &c); + char cl[] = "..CMatrix"; + cl[0] = (!values) ? 'n' : ((A->xtype == CHOLMOD_COMPLEX) ? 'z' : 'd'); + cl[1] = shape; + int m = (int) A->nrow, n = (int) A->ncol, nnz = ((int *) A->p)[A->ncol]; + R_xlen_t n1a = (R_xlen_t) n + 1; + SEXP obj = PROTECT(newObject(cl)), + dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + p = PROTECT(allocVector(INTSXP, n1a)), + i = PROTECT(allocVector(INTSXP, nnz)); + INTEGER(dim)[0] = m; + INTEGER(dim)[1] = n; + Matrix_memcpy(INTEGER(p), A->p, n1a, sizeof(int)); + Matrix_memcpy(INTEGER(i), A->i, nnz, sizeof(int)); + SET_SLOT(obj, Matrix_pSym, p); + SET_SLOT(obj, Matrix_iSym, i); + if (values) { + SEXP x; + if (A->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, nnz)); + Matrix_memcpy(COMPLEX(x), A->x, nnz, sizeof(Rcomplex)); + } else { + PROTECT(x = allocVector(REALSXP, nnz)); + Matrix_memcpy(REAL(x), A->x, nnz, sizeof(double)); + } + SET_SLOT(obj, Matrix_xSym, x); + UNPROTECT(1); + } + UNPROTECT(4); + return obj; +} + +SEXP CHD2M(cholmod_dense *A, int trans, char shape) +{ + if (A->xtype != CHOLMOD_REAL && A->xtype != CHOLMOD_COMPLEX) + error(_("wrong '%s'"), "xtype"); + if (A->dtype != CHOLMOD_DOUBLE) + error(_("wrong '%s'"), "dtype"); + if (A->d != A->nrow) /* MJ: currently no need to support this case */ + error(_("leading dimension not equal to number of rows")); + if (A->nrow > INT_MAX || A->ncol > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + int m = (int) A->nrow, n = (int) A->ncol; + if ((Matrix_int_fast64_t) m * n > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + char cl[] = "...Matrix"; + cl[0] = (A->xtype == CHOLMOD_COMPLEX) ? 'z' : 'd'; + cl[1] = shape; + cl[2] = (shape == 'g') + ? 'e' : ((shape == 's') ? 'y' : ((shape == 'p') ? 'o' : 'r')); + SEXP obj = PROTECT(newObject(cl)), + dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + INTEGER(dim)[0] = (trans) ? n : m; + INTEGER(dim)[1] = (trans) ? m : n; + SEXP x; + if (A->xtype == CHOLMOD_COMPLEX) { + PROTECT(x = allocVector(CPLXSXP, (R_xlen_t) m * n)); + Rcomplex *px = COMPLEX(x), *py = (Rcomplex *) A->x; + if (!trans) + Matrix_memcpy(px, py, (R_xlen_t) m * n, sizeof(Rcomplex)); + else + ztranspose2(px, py, m, n); + } else { + PROTECT(x = allocVector(REALSXP, (R_xlen_t) m * n)); + double *px = REAL(x), *py = (double *) A->x; + if (!trans) + Matrix_memcpy(px, py, (R_xlen_t) m * n, sizeof(double)); + else + dtranspose2(px, py, m, n); + } + SET_SLOT(obj, Matrix_xSym, x); + UNPROTECT(3); + return obj; +} diff -Nru rmatrix-1.6-1.1/src/cholmod-etc.h rmatrix-1.6-5/src/cholmod-etc.h --- rmatrix-1.6-1.1/src/cholmod-etc.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/cholmod-etc.h 2023-10-10 17:29:10.000000000 +0000 @@ -0,0 +1,19 @@ +#ifndef MATRIX_CHOLMOD_ETC_H +#define MATRIX_CHOLMOD_ETC_H + +#include +#include "SuiteSparse_config/SuiteSparse_config.h" +#include "CHOLMOD/Include/cholmod.h" + +extern cholmod_common c ; +extern cholmod_common cl; + +cholmod_factor *M2CHF(SEXP, int); +cholmod_sparse *M2CHS(SEXP, int); +cholmod_dense *M2CHD(SEXP, int); + +SEXP CHF2M(cholmod_factor *, int); +SEXP CHS2M(cholmod_sparse *, int, char); +SEXP CHD2M(cholmod_dense *, int, char); + +#endif /* MATRIX_CHOLMOD_ETC_H */ diff -Nru rmatrix-1.6-1.1/src/coerce.c rmatrix-1.6-5/src/coerce.c --- rmatrix-1.6-1.1/src/coerce.c 2023-08-04 19:24:54.000000000 +0000 +++ rmatrix-1.6-5/src/coerce.c 2023-10-24 05:06:06.000000000 +0000 @@ -1,18 +1,322 @@ +#include /* trunc */ +#include "Mdefines.h" +#include "idz.h" #include "coerce.h" +SEXP vector_as_dense(SEXP from, const char *zzz, char ul, char di, + int m, int n, int byrow, SEXP dimnames) +{ + SEXPTYPE tf = TYPEOF(from); + char cl[] = "...Matrix"; + cl[0] = (zzz[0] == '.') + ? typeToKind(tf) + : ((zzz[0] == ',') ? ((tf == CPLXSXP) ? 'z' : 'd') : zzz[0]); + cl[1] = zzz[1]; + cl[2] = zzz[2]; +#ifndef MATRIX_ENABLE_IMATRIX + if (cl[0] == 'i') + cl[0] = 'd'; +#endif + SEXPTYPE tt = kindToType(cl[0]); + PROTECT(from = coerceVector(from, tt)); + + if (cl[1] != 'g' && m != n) + error(_("attempt to construct non-square %s"), + (cl[1] == 's') ? "symmetricMatrix" : "triangularMatrix"); + + Matrix_int_fast64_t mn = (Matrix_int_fast64_t) m * n; + if (((cl[2] != 'p') ? mn : (mn + n) / 2) > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP to = PROTECT(newObject(cl)); + + SEXP dim = GET_SLOT(to, Matrix_DimSym); + int *pdim = INTEGER(dim); + pdim[0] = m; + pdim[1] = n; + + if (cl[1] != 's') + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + else + set_symmetrized_DimNames(to, dimnames, -1); + + if (cl[1] != 'g' && ul != 'U') { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); + } + + if (cl[1] == 't' && di != 'N') { + SEXP diag = PROTECT(mkString("U")); + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); + } + + /* FIXME: add argument 'new' and conditionally avoid allocation */ + SEXP x = PROTECT(allocVector(tt, (cl[2] != 'p') ? mn : (mn + n) / 2)); + R_xlen_t k, r = XLENGTH(from); + int i, j, recycle = r < mn; + +#define VAD_SUBCASES(_PREFIX_, _CTYPE_, _PTR_, _NA_) \ + do { \ + _CTYPE_ *dest = _PTR_(x), *src = _PTR_(from); \ + if (r == 0) { \ + while (mn-- > 0) \ + *(dest++) = _NA_; \ + } else if (r == 1) { \ + while (mn-- > 0) \ + *(dest++) = *src; \ + } else if (cl[2] != 'p') { \ + if (!recycle) { \ + if (!byrow) \ + Matrix_memcpy(dest, src, mn, sizeof(_CTYPE_)); \ + else \ + _PREFIX_ ## transpose2(dest, src, n, m); \ + } else { \ + if (!byrow) { \ + k = 0; \ + while (mn-- > 0) { \ + if (k == r) k = 0; \ + *(dest++) = src[k++]; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + k = j; \ + for (i = 0; i < m; ++i) { \ + k %= r; \ + *(dest++) = src[k]; \ + k += n; \ + } \ + } \ + } \ + } \ + } else if (ul == 'U') { \ + if (!byrow) { \ + k = 0; \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i <= j; ++i) { \ + if (recycle) k %= r; \ + *(dest++) = src[k++]; \ + } \ + k += n - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + k = j; \ + for (i = 0; i <= j; ++i) { \ + if (recycle) k %= r; \ + *(dest++) = src[k]; \ + k += n; \ + } \ + } \ + } \ + } else { \ + if (!byrow) { \ + k = 0; \ + for (j = 0; j < n; ++j) { \ + for (i = j; i < n; ++i) { \ + if (recycle) k %= r; \ + *(dest++) = src[k++]; \ + } \ + k += j + 1; \ + } \ + } else { \ + R_xlen_t d = 0; \ + for (j = 0; j < n; ++j) { \ + k = j + d; \ + for (i = 0; i <= j; ++i) { \ + if (recycle) k %= r; \ + *(dest++) = src[k]; \ + k += n; \ + } \ + d += n; \ + } \ + } \ + } \ + } while (0) + + switch (tt) { + case LGLSXP: + VAD_SUBCASES(i, int, LOGICAL, NA_LOGICAL); + break; + case INTSXP: + VAD_SUBCASES(i, int, INTEGER, NA_INTEGER); + break; + case REALSXP: + VAD_SUBCASES(d, double, REAL, NA_REAL); + break; + case CPLXSXP: + VAD_SUBCASES(z, Rcomplex, COMPLEX, Matrix_zna); + break; + default: + break; + } + +#undef VAD_SUBCASES + + SET_SLOT(to, Matrix_xSym, x); + + UNPROTECT(3); + return to; +} + +SEXP R_vector_as_dense(SEXP from, SEXP zzz, SEXP uplo, SEXP diag, + SEXP m, SEXP n, SEXP byrow, SEXP dimnames) +{ + switch (TYPEOF(from)) { + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + break; + default: + ERROR_INVALID_TYPE(from, __func__); + break; + } + + const char *zzz_; + if (TYPEOF(zzz) != STRSXP || LENGTH(zzz) < 1 || + (zzz = STRING_ELT(zzz, 0)) == NA_STRING || + (zzz_ = CHAR(zzz))[0] == '\0' || + (zzz_ )[1] == '\0' || + !((zzz_[1] == 'g' && (zzz_[2] == 'e' )) || + (zzz_[1] == 's' && (zzz_[2] == 'y' || zzz_[2] == 'p')) || + (zzz_[1] == 't' && (zzz_[2] == 'r' || zzz_[2] == 'p')))) + error(_("second argument of '%s' does not specify a subclass of %s"), + __func__, "denseMatrix"); + + char ul = 'U', di = 'N'; + if (zzz_[1] != 'g') { + if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || + (uplo = STRING_ELT(uplo, 0)) == NA_STRING || + ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); + } + if (zzz_[1] == 't') { + if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || + (diag = STRING_ELT(diag, 0)) == NA_STRING || + ((di = *CHAR(diag)) != 'N' && di != 'U')) + error(_("'%s' must be \"%s\" or \"%s\""), "diag", "N", "U"); + } + + int m_ = -1; + if (m != R_NilValue) { + if (TYPEOF(m) == INTSXP) { + int tmp; + if (LENGTH(m) >= 1 && (tmp = INTEGER(m)[0]) != NA_INTEGER && + tmp >= 0) + m_ = tmp; + } else if (TYPEOF(m) == REALSXP) { + double tmp; + if (LENGTH(m) >= 1 && !ISNAN(tmp = REAL(m)[0]) && + tmp >= 0.0) { + if (trunc(tmp) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + m_ = (int) tmp; + } + } + if (m_ < 0) + error(_("invalid '%s' to '%s'"), "m", __func__); + } + + int n_ = -1; + if (n != R_NilValue) { + if (TYPEOF(n) == INTSXP) { + int tmp; + if (LENGTH(n) >= 1 && (tmp = INTEGER(n)[0]) != NA_INTEGER && + tmp >= 0) + n_ = tmp; + } else if (TYPEOF(n) == REALSXP) { + double tmp; + if (LENGTH(n) >= 1 && !ISNAN(tmp = REAL(n)[0]) && + tmp >= 0.0) { + if (trunc(tmp) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + n_ = (int) tmp; + } + } + if (n_ < 0) + error(_("invalid '%s' to '%s'"), "n", __func__); + } + + int byrow_; + if (TYPEOF(byrow) != LGLSXP || LENGTH(byrow) < 1 || + (byrow_ = LOGICAL(byrow)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "byrow", "TRUE", "FALSE"); + + if (dimnames != R_NilValue) + if (TYPEOF(dimnames) != VECSXP || LENGTH(dimnames) != 2) + error(_("invalid '%s' to '%s'"), "dimnames", __func__); + + R_xlen_t vlen_ = XLENGTH(from); + if (zzz_[1] != 'g' && (m_ < 0) != (n_ < 0)) { + if (m_ < 0) + m_ = n_; + else + n_ = m_; + } else if (m_ < 0 && n_ < 0) { + if (vlen_ > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + m_ = (int) vlen_; + n_ = 1; + } else if (m_ < 0) { + if (vlen_ > (Matrix_int_fast64_t) INT_MAX * n_) { + if (n_ == 0) + error(_("nonempty vector supplied for empty matrix")); + else + error(_("dimensions cannot exceed %s"), "2^31-1"); + } + m_ = (n_ == 0) ? 0 : vlen_ / n_ + (vlen_ % n_ != 0); + } else if (n_ < 0) { + if (vlen_ > (Matrix_int_fast64_t) m_ * INT_MAX) { + if (m_ == 0) + error(_("nonempty vector supplied for empty matrix")); + else + error(_("dimensions cannot exceed %s"), "2^31-1"); + } + n_ = (m_ == 0) ? 0 : vlen_ / m_ + (vlen_ % m_ != 0); + } + + Matrix_int_fast64_t mlen_ = (Matrix_int_fast64_t) m_ * n_; + if (vlen_ <= 1) + /* do nothing */ ; + else if (mlen_ == 0) + warning(_("nonempty vector supplied for empty matrix")); + else if (vlen_ > mlen_) + warning(_("vector length (%lld) exceeds matrix length (%d * %d)"), + (long long) vlen_, m_, n_); + else if (mlen_ % vlen_ != 0) + warning(_("matrix length (%d * %d) is not a multiple of vector length (%lld)"), + m_, n_, (long long) vlen_); + + return + vector_as_dense(from, zzz_, ul, di, m_, n_, byrow_, dimnames); +} + SEXP matrix_as_dense(SEXP from, const char *zzz, char ul, char di, - int transpose_if_vector, int new) + int trans, int new) { SEXPTYPE tf = TYPEOF(from); char cl[] = "...Matrix"; - cl[0] = (zzz[0] == '.') ? type2kind(tf) : zzz[0]; + cl[0] = (zzz[0] == '.') + ? typeToKind(tf) + : ((zzz[0] == ',') ? ((tf == CPLXSXP) ? 'z' : 'd') : zzz[0]); cl[1] = zzz[1]; cl[2] = zzz[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - dim = getAttrib(from, R_DimSymbol), - dimnames; - int *pdim, m, n, isM, doDN, nprotect = 1; - R_xlen_t len = XLENGTH(from); +#ifndef MATRIX_ENABLE_IMATRIX + if (cl[0] == 'i') + cl[0] = 'd'; +#endif + SEXPTYPE tt = kindToType(cl[0]); + PROTECT(from = coerceVector(from, tt)); + + SEXP to = PROTECT(newObject(cl)); + int nprotect = 2; + + SEXP dim = getAttrib(from, R_DimSymbol), dimnames; + int *pdim, isM, m, n, doDN; + R_xlen_t mn = XLENGTH(from); isM = TYPEOF(dim) == INTSXP && LENGTH(dim) == 2; if (isM) { @@ -33,15 +337,15 @@ } else { - if (len > INT_MAX) + if (mn > INT_MAX) error(_("dimensions cannot exceed %s"), "2^31-1"); dim = GET_SLOT(to, Matrix_DimSym); pdim = INTEGER(dim); - if (transpose_if_vector) { + if (trans) { pdim[0] = m = 1; - pdim[1] = n = (int) len; + pdim[1] = n = (int) mn; } else { - pdim[0] = m = (int) len; + pdim[0] = m = (int) mn; pdim[1] = n = 1; } @@ -51,14 +355,14 @@ if (doDN) { PROTECT(dimnames = allocVector(VECSXP, 2)); ++nprotect; - SET_VECTOR_ELT(dimnames, transpose_if_vector ? 1 : 0, nms); + SET_VECTOR_ELT(dimnames, trans ? 1 : 0, nms); } } if (cl[1] != 'g' && m != n) - error(_("attempt to construct %s or %s from non-square matrix"), - "symmetricMatrix", "triangularMatrix"); + error(_("attempt to construct non-square %s"), + (cl[1] == 's') ? "symmetricMatrix" : "triangularMatrix"); if (doDN) { if (cl[1] != 's') @@ -79,60 +383,60 @@ UNPROTECT(1); /* diag */ } - SEXPTYPE tt = kind2type(cl[0]); - if (tf != tt) { - PROTECT(from = coerceVector(from, tt)); - ++nprotect; - } - SEXP x; if (cl[2] != 'p') { - if (!new || tf != tt || !MAYBE_REFERENCED(from)) { - x = from; - if (new && ATTRIB(x) != R_NilValue) { - SET_ATTRIB(x, R_NilValue); - if (OBJECT(x)) - SET_OBJECT(x, 0); + if (new <= 0 || (new <= 1 && ATTRIB(from) == R_NilValue) || + !MAYBE_REFERENCED(from)) { + + if (ATTRIB(from) != R_NilValue && new >= 1) { + /* 'from' has attributes and no references : */ + SET_ATTRIB(from, R_NilValue); + if (OBJECT(from)) + SET_OBJECT(from, 0); } + x = from; + } else { - PROTECT(x = allocVector(tt, len)); + + PROTECT(x = allocVector(tt, mn)); ++nprotect; switch (tt) { case LGLSXP: - Matrix_memcpy(LOGICAL(x), LOGICAL(from), len, sizeof(int)); + Matrix_memcpy(LOGICAL(x), LOGICAL(from), mn, sizeof(int)); break; case INTSXP: - Matrix_memcpy(INTEGER(x), INTEGER(from), len, sizeof(int)); + Matrix_memcpy(INTEGER(x), INTEGER(from), mn, sizeof(int)); break; case REALSXP: - Matrix_memcpy(REAL(x), REAL(from), len, sizeof(double)); + Matrix_memcpy(REAL(x), REAL(from), mn, sizeof(double)); break; case CPLXSXP: - Matrix_memcpy(COMPLEX(x), COMPLEX(from), len, sizeof(Rcomplex)); + Matrix_memcpy(COMPLEX(x), COMPLEX(from), mn, sizeof(Rcomplex)); break; default: break; } + } } else { - PROTECT(x = allocVector(tt, PM_LENGTH(n))); + PROTECT(x = allocVector(tt, (mn - n) / 2 + n)); ++nprotect; switch (tt) { case LGLSXP: - idense_pack(LOGICAL(x), LOGICAL(from), n, ul, di); + ipack2(LOGICAL(x), LOGICAL(from), n, ul, di); break; case INTSXP: - idense_pack(INTEGER(x), INTEGER(from), n, ul, di); + ipack2(INTEGER(x), INTEGER(from), n, ul, di); break; case REALSXP: - ddense_pack(REAL(x), REAL(from), n, ul, di); + dpack2(REAL(x), REAL(from), n, ul, di); break; case CPLXSXP: - zdense_pack(COMPLEX(x), COMPLEX(from), n, ul, di); + zpack2(COMPLEX(x), COMPLEX(from), n, ul, di); break; default: break; @@ -146,54 +450,52 @@ return to; } -/* as(, ".(ge|sy|sp|tr|tp)Matrix") */ -SEXP R_matrix_as_dense(SEXP from, SEXP class, SEXP uplo, SEXP diag) +/* as(, ".(ge|sy|sp|tr|tp)Matrix") */ +SEXP R_matrix_as_dense(SEXP from, SEXP zzz, SEXP uplo, SEXP diag, + SEXP trans) { switch (TYPEOF(from)) { case LGLSXP: -#ifdef MATRIX_ENABLE_IMATRIX case INTSXP: -#endif case REALSXP: -#ifdef MATRIX_ENABLE_ZMATRIX case CPLXSXP: -#endif break; -#ifndef MATRIX_ENABLE_IMATRIX - case INTSXP: - if (!inherits(from, "factor")) - break; -#endif default: - ERROR_INVALID_CLASS(from, __func__); + ERROR_INVALID_TYPE(from, __func__); break; } - const char *zzz; - if (TYPEOF(class) != STRSXP || LENGTH(class) < 1 || - (class = STRING_ELT(class, 0)) == NA_STRING || - (zzz = CHAR(class))[0] == '\0' || - (zzz )[1] == '\0' || - !((zzz[1] == 'g' && (zzz[2] == 'e' )) || - (zzz[1] == 's' && (zzz[2] == 'y' || zzz[2] == 'p')) || - (zzz[1] == 't' && (zzz[2] == 'r' || zzz[2] == 'p')))) - error(_("invalid '%s' to %s()"), "class", __func__); + const char *zzz_; + if (TYPEOF(zzz) != STRSXP || LENGTH(zzz) < 1 || + (zzz = STRING_ELT(zzz, 0)) == NA_STRING || + (zzz_ = CHAR(zzz))[0] == '\0' || + (zzz_ )[1] == '\0' || + !((zzz_[1] == 'g' && (zzz_[2] == 'e' )) || + (zzz_[1] == 's' && (zzz_[2] == 'y' || zzz_[2] == 'p')) || + (zzz_[1] == 't' && (zzz_[2] == 'r' || zzz_[2] == 'p')))) + error(_("second argument of '%s' does not specify a subclass of %s"), + __func__, "denseMatrix"); char ul = 'U', di = 'N'; - if (zzz[1] != 'g') { + if (zzz_[1] != 'g') { if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); - if (zzz[1] == 't') { - if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || - (diag = STRING_ELT(diag, 0)) == NA_STRING || - ((di = *CHAR(diag)) != 'N' && di != 'U')) - error(_("invalid '%s' to %s()"), "diag", __func__); - } + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); + } + if (zzz_[1] == 't') { + if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || + (diag = STRING_ELT(diag, 0)) == NA_STRING || + ((di = *CHAR(diag)) != 'N' && di != 'U')) + error(_("'%s' must be \"%s\" or \"%s\""), "diag", "N", "U"); } - return matrix_as_dense(from, zzz, ul, di, 0, 1); + int trans_; + if (TYPEOF(trans) != LGLSXP || LENGTH(trans) < 1 || + (trans_ = LOGICAL(trans)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "trans", "TRUE", "FALSE"); + + return matrix_as_dense(from, zzz_, ul, di, trans_, 1); } SEXP sparse_as_dense(SEXP from, const char *class, int packed) @@ -205,7 +507,7 @@ cl[1] = class[1]; cl[2] = (packed) ? 'p' : ((class[1] == 'g') ? 'e' : ((class[1] == 's') ? 'y' : 'r')); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -218,7 +520,7 @@ if (class[2] != 'C' && packed && len > R_XLEN_T_MAX) error(_("coercing n-by-n %s to %s is not supported for n*n exceeding %s"), "[RT]sparseMatrix", "packedMatrix", "R_XLEN_T_MAX"); - double bytes = (double) len * kind2size(cl[0]); + double bytes = (double) len * kindToSize(cl[0]); if (bytes > 0x1.0p+30 /* 1 GiB */) warning(_("sparse->dense coercion: allocating vector of size %0.1f GiB"), 0x1.0p-30 * bytes); @@ -249,7 +551,7 @@ /* It remains to fill 'x' ... */ - SEXP x1 = PROTECT(allocVector(kind2type(class[0]), (R_xlen_t) len)), + SEXP x1 = PROTECT(allocVector(kindToType(class[0]), (R_xlen_t) len)), p0, i0, j0; int *pp, *pi, *pj, nprotect = 2; p0 = i0 = j0 = NULL; @@ -404,7 +706,7 @@ for (i = 0, k = 0; i < n; ++i) { \ kend = pp[i]; \ while (k < kend) { \ - px1[PM_AR21_UP(i, *pj)] = _REPLACE_(*px0, 1); \ + px1[PACKED_AR21_UP(i, *pj)] = _REPLACE_(*px0, 1); \ ++k; ++pj; _MASK_(++px0); \ } \ } \ @@ -416,7 +718,7 @@ for (i = 0, k = 0; i < n; ++i) { \ kend = pp[i]; \ while (k < kend) { \ - px1[PM_AR21_LO(i, *pj, n2)] = _REPLACE_(*px0, 1); \ + px1[PACKED_AR21_LO(i, *pj, n2)] = _REPLACE_(*px0, 1); \ ++k; ++pj; _MASK_(++px0); \ } \ } \ @@ -435,7 +737,7 @@ #define SAD_LOOP_T2UP(_MASK_, _REPLACE_, _INCREMENT_) \ do { \ for (k = 0; k < nnz; ++k) { \ - index = PM_AR21_UP(*pi, *pj); \ + index = PACKED_AR21_UP(*pi, *pj); \ _INCREMENT_(px1[index], (*px0)); \ ++pi; ++pj; _MASK_(++px0); \ } \ @@ -445,7 +747,7 @@ do { \ R_xlen_t n2 = (R_xlen_t) n * 2; \ for (k = 0; k < nnz; ++k) { \ - index = PM_AR21_LO(*pi, *pj, n2); \ + index = PACKED_AR21_LO(*pi, *pj, n2); \ _INCREMENT_(px1[index], (*px0)); \ ++pi; ++pj; _MASK_(++px0); \ } \ @@ -488,19 +790,19 @@ int packed_; if (TYPEOF(packed) != LGLSXP || LENGTH(packed) < 1 || (packed_ = LOGICAL(packed)[0]) == NA_LOGICAL) - error(_("invalid '%s' to %s()"), "packed", __func__); + error(_("'%s' must be %s or %s"), "packed", "TRUE", "FALSE"); return sparse_as_dense(from, valid[ivalid], packed_); } SEXP diagonal_as_dense(SEXP from, const char *class, - char shape, int packed, char ul) + char kind, char shape, int packed, char ul) { char cl[] = "...Matrix"; - cl[0] = class[0]; + cl[0] = (kind == '.') ? class[0] : ((kind == ',') ? ((class[0] == 'z') ? 'z' : 'd') : kind); cl[1] = shape; cl[2] = (cl[1] == 'g') ? 'e' : ((packed) ? 'p' : ((cl[1] == 's') ? 'y' : 'r')); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -508,7 +810,7 @@ if (len > R_XLEN_T_MAX) error(_("attempt to allocate vector of length exceeding %s"), "R_XLEN_T_MAX"); - double bytes = (double) len * kind2size(cl[0]); + double bytes = (double) len * kindToSize(cl[0]); if (bytes > 0x1.0p+30 /* 1 GiB */) warning(_("sparse->dense coercion: allocating vector of size %0.1f GiB"), 0x1.0p-30 * bytes); @@ -535,37 +837,46 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ - SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), - x1 = PROTECT(allocVector(TYPEOF(x0), (R_xlen_t) len)); + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)); + if (class[0] != cl[0]) { + if (class[0] == 'n' && cl[0] == 'l') + x0 = duplicate(x0); + else + x0 = coerceVector(x0, kindToType(cl[0])); + if (class[0] == 'n') + naToOne(x0); + UNPROTECT(1); /* x0 */ + PROTECT(x0); + } + + SEXP x1 = PROTECT(allocVector(TYPEOF(x0), (R_xlen_t) len)); SET_SLOT(to, Matrix_xSym, x1); -#define DAD_SUBCASES(_CTYPE_, _PTR_, _PREFIX_) \ +#define DAD_SUBCASES(_PREFIX_, _CTYPE_, _PTR_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ Matrix_memset(px1, 0, (R_xlen_t) len, sizeof(_CTYPE_)); \ if (di == 'N' || cl[1] != 't') { \ if (cl[2] != 'p') \ - _PREFIX_ ## dense_unpacked_copy_diagonal( \ - px1, px0, n, n, ul, di); \ + _PREFIX_ ## dcpy2(px1, px0, n, n, ul, di); \ else \ - _PREFIX_ ## dense_packed_copy_diagonal( \ - px1, px0, n, n, ul, ul, di); \ + _PREFIX_ ## dcpy1(px1, px0, n, n, ul, ul, di); \ } \ } while (0) - switch (class[0]) { + switch (cl[0]) { case 'n': case 'l': - DAD_SUBCASES(int, LOGICAL, i); + DAD_SUBCASES(i, int, LOGICAL); break; case 'i': - DAD_SUBCASES(int, INTEGER, i); + DAD_SUBCASES(i, int, INTEGER); break; case 'd': - DAD_SUBCASES(double, REAL, d); + DAD_SUBCASES(d, double, REAL); break; case 'z': - DAD_SUBCASES(Rcomplex, COMPLEX, z); + DAD_SUBCASES(z, Rcomplex, COMPLEX); break; default: break; @@ -579,24 +890,31 @@ } /* as(, ".(ge|sy|sp|tr|tp)Matrix") */ -SEXP R_diagonal_as_dense(SEXP from, SEXP shape, SEXP packed, SEXP uplo) +SEXP R_diagonal_as_dense(SEXP from, + SEXP kind, SEXP shape, SEXP packed, SEXP uplo) { static const char *valid[] = { VALID_DIAGONAL, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); + char kind_; + if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || + (kind = STRING_ELT(kind, 0)) == NA_STRING || + (kind_ = CHAR(kind)[0]) == '\0') + error(_("invalid '%s' to '%s'"), "kind", __func__); + char shape_; if (TYPEOF(shape) != STRSXP || LENGTH(shape) < 1 || (shape = STRING_ELT(shape, 0)) == NA_STRING || ((shape_ = CHAR(shape)[0]) != 'g' && shape_ != 's' && shape_ != 't')) - error(_("invalid '%s' to %s()"), "shape", __func__); + error(_("invalid '%s' to '%s'"), "shape", __func__); int packed_ = 0; if (shape_ != 'g') { if (TYPEOF(packed) != LGLSXP || LENGTH(packed) < 1 || (packed_ = LOGICAL(packed)[0]) == NA_LOGICAL) - error(_("invalid '%s' to %s()"), "packed", __func__); + error(_("'%s' must be %s or %s"), "packed", "TRUE", "FALSE"); } char ul = 'U'; @@ -604,10 +922,10 @@ if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); } - return diagonal_as_dense(from, valid[ivalid], shape_, packed_, ul); + return diagonal_as_dense(from, valid[ivalid], kind_, shape_, packed_, ul); } SEXP index_as_dense(SEXP from, const char *class, char kind) @@ -617,8 +935,8 @@ UNPROTECT(1); /* margin */ char cl[] = ".geMatrix"; - cl[0] = (kind != '.') ? kind : 'n'; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + cl[0] = (kind == '.') ? 'n' : ((kind == ',') ? 'd' : kind); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -626,7 +944,7 @@ if (len > R_XLEN_T_MAX) error(_("attempt to allocate vector of length exceeding %s"), "R_XLEN_T_MAX"); - double bytes = (double) len * kind2size(cl[0]); + double bytes = (double) len * kindToSize(cl[0]); if (bytes > 0x1.0p+30 /* 1 GiB */) warning(_("sparse->dense coercion: allocating vector of size %0.1f GiB"), 0x1.0p-30 * bytes); @@ -641,7 +959,7 @@ SEXP perm = PROTECT(GET_SLOT(from, Matrix_permSym)); int *pperm = INTEGER(perm); - SEXP x = PROTECT(allocVector(kind2type(cl[0]), (R_xlen_t) len)); + SEXP x = PROTECT(allocVector(kindToType(cl[0]), (R_xlen_t) len)); SET_SLOT(to, Matrix_xSym, x); #define IAD_SUBCASES(_CTYPE_, _PTR_, _ONE_) \ @@ -694,21 +1012,585 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); return index_as_dense(from, valid[ivalid], kind_); } +SEXP vector_as_sparse(SEXP from, const char *zzz, char ul, char di, + int m, int n, int byrow, SEXP dimnames) +{ + SEXP length0 = GET_SLOT(from, Matrix_lengthSym); + Matrix_int_fast64_t r = (Matrix_int_fast64_t) + ((TYPEOF(length0) == INTSXP) ? INTEGER(length0)[0] : REAL(length0)[0]); + + SEXP i0 = PROTECT(GET_SLOT(from, Matrix_iSym)), + x0 = getAttrib(from, Matrix_xSym); + + SEXPTYPE tf = TYPEOF(x0); + char cl[] = "...Matrix"; + cl[0] = (zzz[0] == '.') + ? ((x0 == R_NilValue) ? 'n' : typeToKind(tf)) + : ((zzz[0] == ',') ? ((tf == CPLXSXP) ? 'z' : 'd') : zzz[0]); + cl[1] = zzz[1]; + cl[2] = (byrow) ? 'R' : 'C'; +#ifndef MATRIX_ENABLE_IMATRIX + if (cl[0] == 'i') + cl[0] = 'd'; +#endif + SEXPTYPE tt = kindToType(cl[0]); + if (x0 != R_NilValue) { + PROTECT(x0); + x0 = coerceVector(x0, tt); + UNPROTECT(1); /* x0 */ + } + PROTECT(x0); + + if (cl[1] != 'g' && m != n) + error(_("attempt to construct non-square %s"), + (cl[1] == 's') ? "symmetricMatrix" : "triangularMatrix"); + + SEXP to = PROTECT(newObject(cl)); + + SEXP dim = GET_SLOT(to, Matrix_DimSym); + int *pdim = INTEGER(dim); + pdim[0] = m; + pdim[1] = n; + + if (cl[1] != 's') + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + else + set_symmetrized_DimNames(to, dimnames, -1); + + if (cl[1] != 'g' && ul != 'U') { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + + if (cl[1] == 't' && di != 'N') { + SEXP diag = PROTECT(mkString("U")); + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); /* diag */ + } + + Matrix_int_fast64_t pos, mn = (Matrix_int_fast64_t) m * n, nnz1 = 0; + R_xlen_t k = 0, nnz0 = XLENGTH(i0); + +#define VAS_SUBCASES(...) \ + do { \ + switch (TYPEOF(i0)) { \ + case INTSXP: \ + { \ + int *pi0 = INTEGER(i0); \ + VAS_SUBSUBCASES(__VA_ARGS__); \ + break; \ + } \ + case REALSXP: \ + { \ + double *pi0 = REAL(i0); \ + VAS_SUBSUBCASES(__VA_ARGS__); \ + break; \ + } \ + default: \ + break; \ + } \ + } while (0) + +#define VAS_SUBSUBCASES() \ + do { \ + if (nnz0 == 0) \ + /* do nothing */ ; \ + else if (cl[1] == 'g') { \ + if (r == 0) \ + nnz1 = mn; \ + else if (r == mn) \ + nnz1 = nnz0; \ + else if (r > mn) \ + while (k < nnz0 && (Matrix_int_fast64_t) pi0[k++] <= mn) \ + nnz1++; \ + else { \ + Matrix_int_fast64_t mn_mod_r = mn % r; \ + nnz1 = nnz0 * (mn / r); \ + while (k < nnz0 && (Matrix_int_fast64_t) pi0[k++] <= mn_mod_r) \ + nnz1++; \ + } \ + } \ + else if (cl[1] == 's' || di == 'N') { \ + if (r == 0) \ + nnz1 = (mn + n) / 2; \ + else if (r >= mn) { \ + if ((ul == 'U') == !byrow) { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k++] - 1) < mn) \ + if (pos % n <= pos / n) \ + ++nnz1; \ + } else { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k++] - 1) < mn) \ + if (pos % n >= pos / n) \ + ++nnz1; \ + } \ + } \ + else { \ + Matrix_int_fast64_t a = 0; \ + if ((ul == 'U') == !byrow) { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k++] - 1) < mn) \ + if (pos % n <= pos / n) \ + ++nnz1; \ + a += r; \ + } \ + } else { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k++] - 1) < mn) \ + if (pos % n >= pos / n) \ + ++nnz1; \ + a += r; \ + } \ + } \ + } \ + } \ + else { \ + if (r == 0) \ + nnz1 = (mn - n) / 2; \ + else if (r >= mn) { \ + if ((ul == 'U') == !byrow) { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k++] - 1) < mn) \ + if (pos % n < pos / n) \ + ++nnz1; \ + } else { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k++] - 1) < mn) \ + if (pos % n > pos / n) \ + ++nnz1; \ + } \ + } \ + else { \ + Matrix_int_fast64_t a = 0; \ + if ((ul == 'U') == !byrow) { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k++] - 1) < mn) \ + if (pos % n < pos / n) \ + ++nnz1; \ + a += r; \ + } \ + } else { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k++] - 1) < mn) \ + if (pos % n > pos / n) \ + ++nnz1; \ + a += r; \ + } \ + } \ + } \ + } \ + } while (0) + + VAS_SUBCASES(); + +#undef VAS_SUBSUBCASES + + if (nnz1 > INT_MAX) + error(_("attempt to construct %s with more than %s nonzero entries"), + "sparseMatrix", "2^31-1"); + + int i_, j_, m_ = (byrow) ? n : m, n_ = (byrow) ? m : n; + SEXP iSym = (byrow) ? Matrix_jSym : Matrix_iSym, + p1 = PROTECT(allocVector(INTSXP, (R_xlen_t) n_ + 1)), + i1 = PROTECT(allocVector(INTSXP, nnz1)); + SET_SLOT(to, Matrix_pSym, p1); + SET_SLOT(to, iSym, i1); + int *pp1 = INTEGER(p1) + 1, *pi1 = INTEGER(i1); + Matrix_memset(pp1 - 1, 0, (R_xlen_t) n + 1, sizeof(int)); + k = 0; + +#define VAS_SUBSUBCASES(_MASK0_, _MASK1_, _REPLACE_, _CTYPE_, _PTR_, _ONE_, _NA_) \ + do { \ + _MASK0_(_CTYPE_ *px0 = _PTR_(x0)); \ + _MASK1_(_CTYPE_ *px1 = _PTR_(x1)); \ + if (nnz1 == 0) \ + /* do nothing */ ; \ + else if (cl[1] == 'g') { \ + if (r == 0) { \ + for (j_ = 0; j_ < n_; ++j_) { \ + pp1[j_] = m; \ + for (i_ = 0; i_ < m_; ++i_) { \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _NA_); \ + } \ + } \ + } \ + else if (r >= mn) { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k] - 1) < mn) { \ + ++pp1[pos / m_]; \ + *(pi1++) = pos % m_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + ++k; \ + } \ + } \ + else { \ + Matrix_int_fast64_t a = 0; \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k] - 1) < mn) { \ + ++pp1[pos / m_]; \ + *(pi1++) = pos % m_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + ++k; \ + } \ + a += r; \ + } \ + } \ + } \ + else if (cl[1] == 's' || di == 'N') { \ + if (r == 0) { \ + if ((ul == 'U') == !byrow) { \ + for (j_ = 0; j_ < n_; ++j_) { \ + pp1[j_] = j_ + 1; \ + for (i_ = 0; i_ <= j_; ++i_) { \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _NA_); \ + } \ + } \ + } else { \ + for (j_ = 0; j_ < n_; ++j_) { \ + pp1[j_] = n_ - j_; \ + for (i_ = j_; i_ < n_; ++i_) { \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _NA_); \ + } \ + } \ + } \ + } \ + else if (r >= mn) { \ + if ((ul == 'U') == !byrow) { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k] - 1) < mn) { \ + if ((i_ = pos % n_) <= (j_ = pos / n_)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + } else { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k] - 1) < mn) { \ + if ((i_ = pos % n_) >= (j_ = pos / n_)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + } \ + } \ + else { \ + Matrix_int_fast64_t a = 0; \ + if ((ul == 'U') == !byrow) { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k] - 1) < mn) { \ + if ((i_ = pos % n) <= (j_ = pos / n)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + a += r; \ + } \ + } else { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k] - 1) < mn) { \ + if ((i_ = pos % n) >= (j_ = pos / n)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + a += r; \ + } \ + } \ + } \ + } \ + else { \ + if (r == 0) { \ + if ((ul == 'U') == !byrow) { \ + for (j_ = 0; j_ < n_; ++j_) { \ + pp1[j_] = j_; \ + for (i_ = 0; i_ < j_; ++i_) { \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _NA_); \ + } \ + } \ + } else { \ + for (j_ = 0; j_ < n_; ++j_) { \ + pp1[j_] = n_ - j_ - 1; \ + for (i_ = j_ + 1; i_ < n_; ++i_) { \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _NA_); \ + } \ + } \ + } \ + } \ + else if (r >= mn) { \ + if ((ul == 'U') == !byrow) { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k] - 1) < mn) { \ + if ((i_ = pos % n_) < (j_ = pos / n_)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + } else { \ + while (k < nnz0 && (pos = (Matrix_int_fast64_t) pi0[k] - 1) < mn) { \ + if ((i_ = pos % n_) > (j_ = pos / n_)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + } \ + } \ + else { \ + Matrix_int_fast64_t a = 0; \ + if ((ul == 'U') == !byrow) { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k] - 1) < mn) { \ + if ((i_ = pos % n) < (j_ = pos / n)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + a += r; \ + } \ + } else { \ + while (a < mn) { \ + k = 0; \ + while (k < nnz0 && (pos = a + pi0[k] - 1) < mn) { \ + if ((i_ = pos % n) > (j_ = pos / n)) { \ + ++pp1[j_]; \ + *(pi1++) = i_; \ + _MASK1_(*(px1++) = _REPLACE_(px0[k], _ONE_)); \ + } \ + ++k; \ + } \ + a += r; \ + } \ + } \ + } \ + } \ + } while (0) + + if (cl[0] == 'n') + VAS_SUBCASES(HIDE, HIDE, , , , , ); + else { + SEXP x1 = PROTECT(allocVector(kindToType(cl[0]), nnz1)); + switch (cl[0]) { + case 'l': + if (x0 == R_NilValue) + VAS_SUBCASES(HIDE, SHOW, SECONDOF, int, LOGICAL, 1, NA_LOGICAL); + else + VAS_SUBCASES(SHOW, SHOW, FIRSTOF, int, LOGICAL, 1, NA_LOGICAL); + break; + case 'i': + if (x0 == R_NilValue) + VAS_SUBCASES(HIDE, SHOW, SECONDOF, int, INTEGER, 1, NA_INTEGER); + else + VAS_SUBCASES(SHOW, SHOW, FIRSTOF, int, INTEGER, 1, NA_INTEGER); + break; + case 'd': + if (x0 == R_NilValue) + VAS_SUBCASES(HIDE, SHOW, SECONDOF, double, REAL, 1.0, NA_REAL); + else + VAS_SUBCASES(SHOW, SHOW, FIRSTOF, double, REAL, 1.0, NA_REAL); + break; + case 'z': + if (x0 == R_NilValue) + VAS_SUBCASES(HIDE, SHOW, SECONDOF, Rcomplex, COMPLEX, Matrix_zone, Matrix_zna); + else + VAS_SUBCASES(SHOW, SHOW, FIRSTOF, Rcomplex, COMPLEX, Matrix_zone, Matrix_zna); + break; + default: + break; + } + SET_SLOT(to, Matrix_xSym, x1); + UNPROTECT(1); /* x1 */ + } + +#undef VAS_SUBCASES +#undef VAS_SUBSUBCASES + + for (j_ = 0; j_ < n_; ++j_) + pp1[j_] += pp1[j_ - 1]; + + switch (zzz[2]) { + case 'C': + to = sparse_as_Csparse(to, cl); + break; + case 'R': + to = sparse_as_Rsparse(to, cl); + break; + case 'T': + to = sparse_as_Tsparse(to, cl); + break; + default: + break; + } + + UNPROTECT(5); /* i1, p1, to, x0, i0 */ + return to; +} + +SEXP R_vector_as_sparse(SEXP from, SEXP zzz, SEXP uplo, SEXP diag, + SEXP m, SEXP n, SEXP byrow, SEXP dimnames) +{ + static const char *valid[] = { VALID_NONVIRTUAL_VECTOR, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + const char *zzz_; + if (TYPEOF(zzz) != STRSXP || LENGTH(zzz) < 1 || + (zzz = STRING_ELT(zzz, 0)) == NA_STRING || + (zzz_ = CHAR(zzz))[0] == '\0' || + (zzz_[1] != 'g' && zzz_[1] != 's' && zzz_[1] != 't') || + (zzz_[2] != 'C' && zzz_[2] != 'R' && zzz_[2] != 'T')) + error(_("second argument of '%s' does not specify a subclass of %s"), + __func__, "[CRT]sparseMatrix"); + + char ul = 'U', di = 'N'; + if (zzz_[1] != 'g') { + if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || + (uplo = STRING_ELT(uplo, 0)) == NA_STRING || + ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); + } + if (zzz_[1] == 't') { + if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || + (diag = STRING_ELT(diag, 0)) == NA_STRING || + ((di = *CHAR(diag)) != 'N' && di != 'U')) + error(_("'%s' must be \"%s\" or \"%s\""), "diag", "N", "U"); + } + + int m_ = -1; + if (m != R_NilValue) { + if (TYPEOF(m) == INTSXP) { + int tmp; + if (LENGTH(m) >= 1 && (tmp = INTEGER(m)[0]) != NA_INTEGER && + tmp >= 0) + m_ = tmp; + } else if (TYPEOF(m) == REALSXP) { + double tmp; + if (LENGTH(m) >= 1 && !ISNAN(tmp = REAL(m)[0]) && + tmp >= 0.0) { + if (trunc(tmp) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + m_ = (int) tmp; + } + } + if (m_ < 0) + error(_("invalid '%s' to '%s'"), "m", __func__); + } + + int n_ = -1; + if (n != R_NilValue) { + if (TYPEOF(n) == INTSXP) { + int tmp; + if (LENGTH(n) >= 1 && (tmp = INTEGER(n)[0]) != NA_INTEGER && + tmp >= 0) + n_ = tmp; + } else if (TYPEOF(n) == REALSXP) { + double tmp; + if (LENGTH(n) >= 1 && !ISNAN(tmp = REAL(n)[0]) && + tmp >= 0.0) { + if (trunc(tmp) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + n_ = (int) tmp; + } + } + if (n_ < 0) + error(_("invalid '%s' to '%s'"), "n", __func__); + } + + int byrow_; + if (TYPEOF(byrow) != LGLSXP || LENGTH(byrow) < 1 || + (byrow_ = LOGICAL(byrow)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "byrow", "TRUE", "FALSE"); + + if (dimnames != R_NilValue) + if (TYPEOF(dimnames) != VECSXP || LENGTH(dimnames) != 2) + error(_("invalid '%s' to '%s'"), "dimnames", __func__); + + SEXP tmp = GET_SLOT(from, Matrix_lengthSym); + Matrix_int_fast64_t vlen_ = (Matrix_int_fast64_t) + ((TYPEOF(tmp) == INTSXP) ? INTEGER(tmp)[0] : REAL(tmp)[0]); + if (zzz_[1] != 'g' && (m_ < 0) != (n_ < 0)) { + if (m_ < 0) + m_ = n_; + else + n_ = m_; + } else if (m_ < 0 && n_ < 0) { + if (vlen_ > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + m_ = (int) vlen_; + n_ = 1; + } else if (m_ < 0) { + if (vlen_ > (Matrix_int_fast64_t) INT_MAX * n_) { + if (n_ == 0) + error(_("nonempty vector supplied for empty matrix")); + else + error(_("dimensions cannot exceed %s"), "2^31-1"); + } + m_ = (n_ == 0) ? 0 : vlen_ / n_ + (vlen_ % n_ != 0); + } else if (n_ < 0) { + if (vlen_ > (Matrix_int_fast64_t) m_ * INT_MAX) { + if (m_ == 0) + error(_("nonempty vector supplied for empty matrix")); + else + error(_("dimensions cannot exceed %s"), "2^31-1"); + } + n_ = (m_ == 0) ? 0 : vlen_ / m_ + (vlen_ % m_ != 0); + } + + Matrix_int_fast64_t mlen_ = (Matrix_int_fast64_t) m_ * n_; + if (vlen_ <= 1) + /* do nothing */ ; + else if (mlen_ == 0) + warning(_("nonempty vector supplied for empty matrix")); + else if (vlen_ > mlen_) + warning(_("vector length (%lld) exceeds matrix length (%d * %d)"), + (long long) vlen_, m_, n_); + else if (mlen_ % vlen_ != 0) + warning(_("matrix length (%d * %d) is not a multiple of vector length (%lld)"), + m_, n_, (long long) vlen_); + + return + vector_as_sparse(from, zzz_, ul, di, m_, n_, byrow_, dimnames); +} + SEXP matrix_as_sparse(SEXP from, const char *zzz, char ul, char di, - int transpose_if_vector) + int trans) { char cl[] = "...Matrix"; - cl[0] = type2kind(TYPEOF(from)); + cl[0] = typeToKind(TYPEOF(from)); cl[1] = zzz[1]; cl[2] = (zzz[1] == 'g') ? 'e' : ((zzz[1] == 's') ? 'y' : 'r'); +#ifndef MATRIX_ENABLE_IMATRIX + if (cl[0] == 'i') + cl[0] = 'd'; +#endif PROTECT_INDEX pid; PROTECT_WITH_INDEX(from, &pid); - REPROTECT(from = matrix_as_dense(from, cl, ul, di, transpose_if_vector, 1), pid); + REPROTECT(from = matrix_as_dense(from, cl, ul, di, trans, 0), pid); REPROTECT(from = dense_as_sparse(from, cl, zzz[2]), pid); cl[2] = zzz[2]; REPROTECT(from = sparse_as_kind(from, cl, zzz[0]), pid); @@ -716,52 +1598,50 @@ return from; } -/* as(, ".[gst][CRT]Matrix") */ -SEXP R_matrix_as_sparse(SEXP from, SEXP class, SEXP uplo, SEXP diag) +/* as(, ".[gst][CRT]Matrix") */ +SEXP R_matrix_as_sparse(SEXP from, SEXP zzz, SEXP uplo, SEXP diag, + SEXP trans) { switch (TYPEOF(from)) { case LGLSXP: -#ifdef MATRIX_ENABLE_IMATRIX case INTSXP: -#endif case REALSXP: -#ifdef MATRIX_ENABLE_ZMATRIX case CPLXSXP: -#endif break; -#ifndef MATRIX_ENABLE_IMATRIX - case INTSXP: - if (!inherits(from, "factor")) - break; -#endif default: - ERROR_INVALID_CLASS(from, __func__); + ERROR_INVALID_TYPE(from, __func__); break; } - const char *zzz; - if (TYPEOF(class) != STRSXP || LENGTH(class) < 1 || - (class = STRING_ELT(class, 0)) == NA_STRING || - (zzz = CHAR(class))[0] == '\0' || - (zzz[1] != 'g' && zzz[1] != 's' && zzz[1] != 't') || - (zzz[2] != 'C' && zzz[2] != 'R' && zzz[2] != 'T')) - error(_("invalid '%s' to %s()"), "class", __func__); + const char *zzz_; + if (TYPEOF(zzz) != STRSXP || LENGTH(zzz) < 1 || + (zzz = STRING_ELT(zzz, 0)) == NA_STRING || + (zzz_ = CHAR(zzz))[0] == '\0' || + (zzz_[1] != 'g' && zzz_[1] != 's' && zzz_[1] != 't') || + (zzz_[2] != 'C' && zzz_[2] != 'R' && zzz_[2] != 'T')) + error(_("second argument of '%s' does not specify a subclass of %s"), + __func__, "[CRT]sparseMatrix"); char ul = 'U', di = 'N'; - if (zzz[1] != 'g') { + if (zzz_[1] != 'g') { if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); - if (zzz[1] == 't') { - if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || - (diag = STRING_ELT(diag, 0)) == NA_STRING || - ((di = *CHAR(diag)) != 'N' && di != 'U')) - error(_("invalid '%s' to %s()"), "diag", __func__); - } + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); + } + if (zzz_[1] == 't') { + if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || + (diag = STRING_ELT(diag, 0)) == NA_STRING || + ((di = *CHAR(diag)) != 'N' && di != 'U')) + error(_("'%s' must be \"%s\" or \"%s\""), "diag", "N", "U"); } - return matrix_as_sparse(from, zzz, ul, di, 0); + int trans_; + if (TYPEOF(trans) != LGLSXP || LENGTH(trans) < 1 || + (trans_ = LOGICAL(trans)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "trans", "TRUE", "FALSE"); + + return matrix_as_sparse(from, zzz_, ul, di, trans_); } SEXP dense_as_sparse(SEXP from, const char *class, char repr) @@ -770,7 +1650,7 @@ cl[0] = class[0]; cl[1] = class[1]; cl[2] = repr; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -826,113 +1706,113 @@ } \ } while (0) -#define DAS_SUBCASES(_CTYPE_, _PTR_, _MASK_, _NZ_) \ +#define DAS_SUBCASES(_CTYPE_, _PTR_, _MASK_, _ISNZ_) \ do { \ _CTYPE_ *px0 = _PTR_(x0) ; \ _MASK_(_CTYPE_ *px1 = _PTR_(x1)); \ if (class[1] == 'g') \ /* .geMatrix */ \ DAS_SUBSUBCASES(DAS_LOOP_GEN2C, DAS_LOOP_GEN2R, DAS_LOOP_GEN2C, \ - _MASK_, _NZ_); \ + _MASK_, _ISNZ_); \ else if (class[2] != 'p' && di == 'N') \ /* .syMatrix, non-unit diagonal .trMatrix */ \ DAS_SUBSUBCASES(DAS_LOOP_TRN2C, DAS_LOOP_TRN2R, DAS_LOOP_TRN2C, \ - _MASK_, _NZ_); \ + _MASK_, _ISNZ_); \ else if (class[2] != 'p') \ /* unit diagonal .trMatrix */ \ DAS_SUBSUBCASES(DAS_LOOP_TRU2C, DAS_LOOP_TRU2R, DAS_LOOP_TRU2C, \ - _MASK_, _NZ_); \ + _MASK_, _ISNZ_); \ else if (di == 'N') \ /* .spMatrix, non-unit diagonal .tpMatrix */ \ DAS_SUBSUBCASES(DAS_LOOP_TPN2C, DAS_LOOP_TPN2R, DAS_LOOP_TPN2C, \ - _MASK_, _NZ_); \ + _MASK_, _ISNZ_); \ else \ /* unit diagonal .tpMatrix */ \ DAS_SUBSUBCASES(DAS_LOOP_TPU2C, DAS_LOOP_TPU2R, DAS_LOOP_TPU2C, \ - _MASK_, _NZ_); \ + _MASK_, _ISNZ_); \ } while (0) #undef DAS_SUBSUBCASES -#define DAS_SUBSUBCASES(_LOOP_C_, _LOOP_R_, _LOOP_T_, _MASK_, _NZ_) \ +#define DAS_SUBSUBCASES(_LOOP_C_, _LOOP_R_, _LOOP_T_, _MASK_, _ISNZ_) \ do { \ switch (cl[2]) { \ case 'C': \ - _LOOP_C_(_NZ_, ++nnz, DAS_VALID2C); \ + _LOOP_C_(_ISNZ_, ++nnz, DAS_VALID2C); \ break; \ case 'R': \ - _LOOP_R_(_NZ_, ++nnz, DAS_VALID2R); \ + _LOOP_R_(_ISNZ_, ++nnz, DAS_VALID2R); \ break; \ case 'T': \ - _LOOP_T_(_NZ_, ++nnz, DAS_VALID2T); \ + _LOOP_T_(_ISNZ_, ++nnz, DAS_VALID2T); \ break; \ default: \ break; \ } \ } while (0) -#define DAS_LOOP_GEN2C(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_GEN2C(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ for (j = 0; j < n; ++j) { \ for (i = 0; i < m; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } while (0) -#define DAS_LOOP_GEN2R(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_GEN2R(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ R_xlen_t mn1s = (R_xlen_t) m * n - 1; \ for (i = 0; i < m; ++i, px0 -= mn1s) { \ for (j = 0; j < n; ++j, px0 += m) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } while (0) -#define DAS_LOOP_TRN2C(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TRN2C(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ if (ul == 'U') { \ for (j = 0; j < n; px0 += n - (++j)) { \ for (i = 0; i <= j; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } else { \ for (j = 0; j < n; px0 += (++j)) { \ for (i = j; i < n; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TRN2R(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TRN2R(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ R_xlen_t d; \ if (ul == 'U') { \ d = (R_xlen_t) n * n - 1; \ for (i = 0; i < n; ++i, px0 -= (d -= n)) { \ for (j = i; j < n; ++j, px0 += n) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } else { \ d = -1; \ for (i = 0; i < n; ++i, px0 -= (d += n)) { \ for (j = 0; j <= i; ++j, px0 += n) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TRU2C(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TRU2C(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ if (ul == 'U') { \ px0 += n; \ for (j = 1; j < n; ++j) { \ for (i = 0; i < j; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ px0 += n - j; \ } \ @@ -940,13 +1820,13 @@ for (j = 0; j < n; ++j) { \ px0 += j + 1; \ for (i = j + 1; i < n; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TRU2R(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TRU2R(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ R_xlen_t d; \ if (ul == 'U') { \ @@ -954,7 +1834,7 @@ for (i = 0; i < n; ++i) { \ for (j = i + 1; j < n; ++j) { \ px0 += n; \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ } \ _DO_OUTER_; \ px0 -= (d -= n); \ @@ -964,7 +1844,7 @@ d = -1; \ for (i = 1; i < n; ++i) { \ for (j = 0; j < i; ++j) { \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ px0 += n; \ } \ _DO_OUTER_; \ @@ -973,71 +1853,71 @@ } \ } while (0) -#define DAS_LOOP_TPN2C(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TPN2C(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ if (ul == 'U') { \ for (j = 0; j < n; ++j) { \ for (i = 0; i <= j; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } else { \ for (j = 0; j < n; ++j) { \ for (i = j; i < n; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TPN2R(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TPN2R(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ R_xlen_t d; \ if (ul == 'U') { \ - d = PM_LENGTH(n) - 1; \ + d = PACKED_LENGTH(n) - 1; \ for (i = 0; i < n; px0 -= (d -= (++i))) { \ for (j = i; j < n; px0 += (++j)) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } else { \ d = -1; \ for (i = 0; i < n; px0 -= (d += n - (++i))) { \ for (j = 0; j <= i; px0 += n - (++j)) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TPU2C(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TPU2C(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ if (ul == 'U') { \ for (j = 1; j < n; ++j) { \ ++px0; \ for (i = 0; i < j; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } else { \ for (j = 0; j < n; ++j) { \ ++px0; \ for (i = j + 1; i < n; ++i, ++px0) \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ _DO_OUTER_; \ } \ } \ } while (0) -#define DAS_LOOP_TPU2R(_NZ_, _DO_INNER_, _DO_OUTER_) \ +#define DAS_LOOP_TPU2R(_ISNZ_, _DO_INNER_, _DO_OUTER_) \ do { \ R_xlen_t d; \ if (ul == 'U') { \ - d = PM_LENGTH(n - 1) - 1; \ + d = PACKED_LENGTH(n - 1) - 1; \ for (i = 0; i < n; ++i) { \ for (j = i + 1; j < n; ++j) { \ px0 += j; \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ } \ _DO_OUTER_; \ px0 -= (d -= i + 1); \ @@ -1047,7 +1927,7 @@ d = -1; \ for (i = 1; i < n; ++i) { \ for (j = 0; j < i; ++j) { \ - if (_NZ_(*px0)) _DO_INNER_; \ + if (_ISNZ_(*px0)) _DO_INNER_; \ px0 += n - j - 1; \ } \ _DO_OUTER_; \ @@ -1102,25 +1982,25 @@ } #undef DAS_SUBSUBCASES -#define DAS_SUBSUBCASES(_LOOP_C_, _LOOP_R_, _LOOP_T_, _MASK_, _NZ_) \ +#define DAS_SUBSUBCASES(_LOOP_C_, _LOOP_R_, _LOOP_T_, _MASK_, _ISNZ_) \ do { \ switch (repr) { \ case 'C': \ - _LOOP_C_(_NZ_, \ + _LOOP_C_(_ISNZ_, \ do { \ *(pi++) = i; \ _MASK_(*(px1++) = *px0); \ } while (0), ); \ break; \ case 'R': \ - _LOOP_R_(_NZ_, \ + _LOOP_R_(_ISNZ_, \ do { \ *(pj++) = j; \ _MASK_(*(px1++) = *px0); \ } while (0), ); \ break; \ case 'T': \ - _LOOP_T_(_NZ_, \ + _LOOP_T_(_ISNZ_, \ do { \ *(pi++) = i; \ *(pj++) = j; \ @@ -1138,10 +2018,7 @@ if (class[0] == 'n') DAS_SUBCASES(int, LOGICAL, HIDE, ISNZ_LOGICAL); - else if (cl[2] != 'R' && nnz == XLENGTH(x0)) { - SET_SLOT(to, Matrix_xSym, x0); - DAS_CASES(HIDE); - } else { + else { SEXP x1 = PROTECT(allocVector(TYPEOF(x0), nnz)); SET_SLOT(to, Matrix_xSym, x1); DAS_CASES(SHOW); @@ -1172,8 +2049,7 @@ /* as(, "[CRT]sparseMatrix") */ SEXP R_dense_as_sparse(SEXP from, SEXP repr) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + static const char *valid[] = { VALID_DENSE, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); @@ -1182,19 +2058,19 @@ if (TYPEOF(repr) != STRSXP || LENGTH(repr) < 1 || (repr = STRING_ELT(repr, 0)) == NA_STRING || ((repr_ = CHAR(repr)[0]) != 'C' && repr_ != 'R' && repr_ != 'T')) - error(_("invalid '%s' to %s()"), "repr", __func__); + error(_("invalid '%s' to '%s'"), "repr", __func__); return dense_as_sparse(from, valid[ivalid], repr_); } SEXP diagonal_as_sparse(SEXP from, const char *class, - char shape, char repr, char ul) + char kind, char shape, char repr, char ul) { char cl[] = "...Matrix"; - cl[0] = class[0]; + cl[0] = (kind == '.') ? class[0] : ((kind == ',') ? ((class[0] == 'z') ? 'z' : 'd') : kind); cl[1] = shape; cl[2] = repr; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -1234,7 +2110,7 @@ #define DAS_CASES(_MASK_) \ do { \ - switch (class[0]) { \ + switch (cl[0]) { \ case 'l': \ DAS_LOOP(int, LOGICAL, _MASK_, ISNZ_LOGICAL, 1); \ break; \ @@ -1253,6 +2129,17 @@ } while (0) SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)); + if (class[0] != cl[0]) { + if (class[0] == 'n' && cl[0] == 'l') + x0 = duplicate(x0); + else + x0 = coerceVector(x0, kindToType(cl[0])); + if (class[0] == 'n') + naToOne(x0); + UNPROTECT(1); /* x0 */ + PROTECT(x0); + } + int d, nnz; if (cl[2] != 'T') { SEXP p = PROTECT(allocVector(INTSXP, (R_xlen_t) n + 1)); @@ -1263,18 +2150,18 @@ nnz = 0; #undef DAS_LOOP -#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_, _ONE_) \ +#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_, _ONE_) \ do { \ _CTYPE_ *px0 = _PTR_(x0); \ for (d = 0; d < n; ++d) { \ - if (_NZ_(*px0)) \ + if (_ISNZ_(*px0)) \ ++nnz; \ *(pp++) = nnz; \ ++px0; \ } \ } while (0) - if (class[0] == 'n') + if (cl[0] == 'n') DAS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL, 1); else DAS_CASES(SHOW); @@ -1289,17 +2176,17 @@ nnz = 0; #undef DAS_LOOP -#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_, _ONE_) \ +#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_, _ONE_) \ do { \ _CTYPE_ *px0 = _PTR_(x0); \ for (d = 0; d < n; ++d) { \ - if (_NZ_(*px0)) \ + if (_ISNZ_(*px0)) \ ++nnz; \ ++px0; \ } \ } while (0) - if (class[0] == 'n') + if (cl[0] == 'n') DAS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL, 1); else DAS_CASES(SHOW); @@ -1317,13 +2204,13 @@ int *pi1 = INTEGER(i1); #undef DAS_LOOP -#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_, _ONE_) \ +#define DAS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_, _ONE_) \ do { \ _MASK_(_CTYPE_ *px1 = _PTR_(x1)); \ if (di == 'N') { \ _CTYPE_ *px0 = _PTR_(x0); \ for (d = 0; d < n; ++d) { \ - if (_NZ_(*px0)) { \ + if (_ISNZ_(*px0)) { \ *(pi1++) = d; \ _MASK_(*(px1++) = *px0); \ } \ @@ -1337,7 +2224,7 @@ } \ } while (0) - if (class[0] == 'n') + if (cl[0] == 'n') DAS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL, 1); else if (di == 'N' && nnz == n) { SET_SLOT(to, Matrix_xSym, x0); @@ -1354,34 +2241,41 @@ } /* as(, ".[gst][CRT]Matrix") */ -SEXP R_diagonal_as_sparse(SEXP from, SEXP shape, SEXP repr, SEXP uplo) +SEXP R_diagonal_as_sparse(SEXP from, + SEXP kind, SEXP shape, SEXP repr, SEXP uplo) { static const char *valid[] = { VALID_DIAGONAL, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); + char kind_; + if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || + (kind = STRING_ELT(kind, 0)) == NA_STRING || + (kind_ = CHAR(kind)[0]) == '\0') + error(_("invalid '%s' to '%s'"), "kind", __func__); + char shape_; if (TYPEOF(shape) != STRSXP || LENGTH(shape) < 1 || (shape = STRING_ELT(shape, 0)) == NA_STRING || ((shape_ = CHAR(shape)[0]) != 'g' && shape_ != 's' && shape_ != 't')) - error(_("invalid '%s' to %s()"), "shape", __func__); + error(_("invalid '%s' to '%s'"), "shape", __func__); char repr_; if (TYPEOF(repr) != STRSXP || LENGTH(repr) < 1 || (repr = STRING_ELT(repr, 0)) == NA_STRING || ((repr_ = CHAR(repr)[0]) != 'C' && repr_ != 'R' && repr_ != 'T')) - error(_("invalid '%s' to %s()"), "repr", __func__); + error(_("invalid '%s' to '%s'"), "repr", __func__); char ul = 'U'; if (shape_ != 'g') { if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); } - return diagonal_as_sparse(from, valid[ivalid], shape_, repr_, ul); + return diagonal_as_sparse(from, valid[ivalid], kind_, shape_, repr_, ul); } SEXP index_as_sparse(SEXP from, const char *class, char kind, char repr) @@ -1391,9 +2285,9 @@ UNPROTECT(1); /* margin */ char cl[] = ".g.Matrix"; - cl[0] = (kind != '.') ? kind : 'n'; - cl[2] = (repr != '.') ? repr : ((mg == 0) ? 'R' : 'C'); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + cl[0] = (kind == '.') ? 'n' : ((kind == ',') ? 'd' : kind); + cl[2] = (repr == '.') ? ((mg == 0) ? 'R' : 'C') : repr; + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], @@ -1453,7 +2347,7 @@ UNPROTECT(2); if (cl[0] != 'n') { - SEXP x = PROTECT(allocVector(kind2type(cl[0]), r)); + SEXP x = PROTECT(allocVector(kindToType(cl[0]), r)); SET_SLOT(to, Matrix_xSym, x); #define IAS_SUBCASES(_CTYPE_, _PTR_, _ONE_) \ @@ -1500,29 +2394,33 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); char repr_; if (TYPEOF(repr) != STRSXP || LENGTH(repr) < 1 || (repr = STRING_ELT(repr, 0)) == NA_STRING || ((repr_ = CHAR(repr)[0]) != '.' && repr_ != 'C' && repr_ != 'R' && repr_ != 'T')) - error(_("invalid '%s' to %s()"), "repr", __func__); + error(_("invalid '%s' to '%s'"), "repr", __func__); return index_as_sparse(from, valid[ivalid], kind_, repr_); } -SEXP dense_as_kind(SEXP from, const char *class, char kind) +SEXP dense_as_kind(SEXP from, const char *class, char kind, int new) { - if (kind == '.' || kind == class[0]) + if (kind == '.') + kind = class[0]; + else if (kind == ',') + kind = (class[0] == 'z') ? 'z' : 'd'; + if (kind == class[0]) return from; - SEXPTYPE tt = kind2type(kind); + SEXPTYPE tt = kindToType(kind); char cl[] = "...Matrix"; cl[0] = kind; cl[1] = class[1]; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -1552,7 +2450,17 @@ PROTECT_INDEX pid; SEXP x; PROTECT_WITH_INDEX(x = GET_SLOT(from, Matrix_xSym), &pid); - if (TYPEOF(x) == tt) { + if (TYPEOF(x) != tt) { + REPROTECT(x = coerceVector(x, tt), pid); + if (class[0] == 'n') + /* n->[idz] */ + naToOne(x); + } else if (new) { + REPROTECT(x = duplicate(x), pid); + if (class[0] == 'n') + /* n->l */ + naToOne(x); + } else { if (class[0] == 'n') { /* n->l */ R_xlen_t i, len = XLENGTH(x); @@ -1560,16 +2468,11 @@ for (i = 0; i < len; ++i, ++px) { if (*px == NA_LOGICAL) { REPROTECT(x = duplicate(x), pid); - na2one(x); + naToOne(x); break; } } } - } else { - REPROTECT(x = coerceVector(x, tt), pid); - if (class[0] == 'n') - /* n->[idz] */ - na2one(x); } SET_SLOT(to, Matrix_xSym, x); UNPROTECT(2); /* x, to */ @@ -1579,8 +2482,7 @@ /* as(, "[nlidz]Matrix") */ SEXP R_dense_as_kind(SEXP from, SEXP kind) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + static const char *valid[] = { VALID_DENSE, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); @@ -1589,16 +2491,20 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); - return dense_as_kind(from, valid[ivalid], kind_); + return dense_as_kind(from, valid[ivalid], kind_, 0); } SEXP sparse_as_kind(SEXP from, const char *class, char kind) { - if (kind == '.' || kind == class[0]) + if (kind == '.') + kind = class[0]; + else if (kind == ',') + kind = (class[0] == 'z') ? 'z' : 'd'; + if (kind == class[0]) return from; - SEXPTYPE tt = kind2type(kind); + SEXPTYPE tt = kindToType(kind); if (class[2] == 'T' && (class[0] == 'n' || class[0] == 'l') && kind != 'n' && kind != 'l') { @@ -1612,7 +2518,7 @@ cl[0] = kind; cl[1] = class[1]; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -1720,20 +2626,24 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); return sparse_as_kind(from, valid[ivalid], kind_); } SEXP diagonal_as_kind(SEXP from, const char *class, char kind) { - if (kind == '.' || kind == class[0]) + if (kind == '.') + kind = class[0]; + else if (kind == ',') + kind = (class[0] == 'z') ? 'z' : 'd'; + if (kind == class[0]) return from; - SEXPTYPE tt = kind2type(kind); + SEXPTYPE tt = kindToType(kind); char cl[] = ".diMatrix"; cl[0] = kind; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -1763,7 +2673,7 @@ for (i = 0; i < len; ++i, ++px) { if (*px == NA_LOGICAL) { REPROTECT(x = duplicate(x), pid); - na2one(x); + naToOne(x); break; } } @@ -1772,7 +2682,7 @@ REPROTECT(x = coerceVector(x, tt), pid); if (class[0] == 'n') /* n->[idz] */ - na2one(x); + naToOne(x); } SET_SLOT(to, Matrix_xSym, x); UNPROTECT(1); /* x */ @@ -1794,7 +2704,7 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); return diagonal_as_kind(from, valid[ivalid], kind_); } @@ -1816,7 +2726,7 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); return index_as_kind(from, valid[ivalid], kind_); } @@ -1828,7 +2738,7 @@ char cl[] = ".geMatrix"; cl[0] = class[0]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -1848,9 +2758,9 @@ UNPROTECT(1); /* uplo */ if (class[1] == 's') { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } else { SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); @@ -1863,38 +2773,38 @@ "R_XLEN_T_MAX"); SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = x0; int nprotect = 2; - if (class[2] == 'p' || new > 0) { + if (class[2] == 'p' || new) { PROTECT(x1 = allocVector(TYPEOF(x0), (R_xlen_t) n * n)); ++nprotect; } SET_SLOT(to, Matrix_xSym, x1); -#define DAG_SUBCASES(_CTYPE_, _PTR_, _PREFIX_) \ +#define DAG_SUBCASES(_PREFIX_, _CTYPE_, _PTR_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ if (class[2] == 'p') \ - _PREFIX_ ## dense_unpack(px1, px0, n, ul, di); \ - else if (new > 0) \ + _PREFIX_ ## unpack1(px1, px0, n, ul, di); \ + else if (new) \ Matrix_memcpy(px1, px0, (R_xlen_t) n * n, sizeof(_CTYPE_)); \ if (class[1] == 's') \ - _PREFIX_ ## dense_unpacked_make_symmetric(px1, n, ul); \ + _PREFIX_ ## syforce2(px1, n, ul); \ else \ - _PREFIX_ ## dense_unpacked_make_triangular(px1, n, n, ul, di); \ + _PREFIX_ ## trforce2(px1, n, n, ul, di); \ } while (0) switch (class[0]) { case 'n': case 'l': - DAG_SUBCASES(int, LOGICAL, i); + DAG_SUBCASES(i, int, LOGICAL); break; case 'i': - DAG_SUBCASES(int, INTEGER, i); + DAG_SUBCASES(i, int, INTEGER); break; case 'd': - DAG_SUBCASES(double, REAL, d); + DAG_SUBCASES(d, double, REAL); break; case 'z': - DAG_SUBCASES(Rcomplex, COMPLEX, z); + DAG_SUBCASES(z, Rcomplex, COMPLEX); break; default: break; @@ -1910,8 +2820,7 @@ /* as(, "generaMatrix") */ SEXP R_dense_as_general(SEXP from) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + static const char *valid[] = { VALID_DENSE, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); @@ -1927,7 +2836,7 @@ char cl[] = ".g.Matrix"; cl[0] = class[0]; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -1943,9 +2852,9 @@ UNPROTECT(1); /* dimnames */ if (class[1] == 's') { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } else { SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); @@ -1982,6 +2891,36 @@ char ul = *CHAR(STRING_ELT(uplo, 0)); UNPROTECT(1); /* uplo */ +#define ASSIGN_COMPLEX_JJ(_X_, _Y_) \ + do { _X_.r = _Y_.r; _X_.i = 0.0; } while (0) + +#define ASSIGN_COMPLEX_JI(_X_, _Y_) \ + do { _X_.r = _Y_.r; _X_.i = -_Y_.i; } while (0) + +#define SAG_CASES \ + do { \ + switch (class[0]) { \ + case 'l': \ + SAG_SUBCASES(int, LOGICAL, SHOW, 1, \ + ASSIGN_REAL, ASSIGN_REAL); \ + break; \ + case 'i': \ + SAG_SUBCASES(int, INTEGER, SHOW, 1, \ + ASSIGN_REAL, ASSIGN_REAL); \ + break; \ + case 'd': \ + SAG_SUBCASES(double, REAL, SHOW, 1.0, \ + ASSIGN_REAL, ASSIGN_REAL); \ + break; \ + case 'z': \ + SAG_SUBCASES(Rcomplex, COMPLEX, SHOW, Matrix_zone, \ + ASSIGN_COMPLEX_JJ, ASSIGN_COMPLEX_JI); \ + break; \ + default: \ + break; \ + } \ + } while (0) + if (class[2] != 'T') { SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, @@ -2004,7 +2943,7 @@ } } for (j = 1; j < n; ++j) - pp1[j] += pp1[j-1]; + pp1[j] += pp1[j - 1]; if (pp1[n - 1] > INT_MAX - pp0[n - 1]) error(_("attempt to construct %s with more than %s nonzero entries"), "sparseMatrix", "2^31-1"); @@ -2022,28 +2961,8 @@ int *pi1 = INTEGER(i1); SET_SLOT(to, iSym, i1); -#define SAG_CASES \ - do { \ - switch (class[0]) { \ - case 'l': \ - SAG_SUBCASES(int, LOGICAL, SHOW, 1); \ - break; \ - case 'i': \ - SAG_SUBCASES(int, INTEGER, SHOW, 1); \ - break; \ - case 'd': \ - SAG_SUBCASES(double, REAL, SHOW, 1.0); \ - break; \ - case 'z': \ - SAG_SUBCASES(Rcomplex, COMPLEX, SHOW, Matrix_zone); \ - break; \ - default: \ - break; \ - } \ - } while (0) - #undef SAG_SUBCASES -#define SAG_SUBCASES(_CTYPE_, _PTR_, _MASK_, _ONE_) \ +#define SAG_SUBCASES(_CTYPE_, _PTR_, _MASK_, _ONE_, _ASSIGN_JJ_, _ASSIGN_JI_) \ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1)); \ if (class[1] == 's') { \ @@ -2053,12 +2972,16 @@ for (j = 0, k = 0; j < n; ++j) { \ kend = pp0[j]; \ while (k < kend) { \ - pi1[pp1_[j]] = pi0[k]; \ - _MASK_(px1[pp1_[j]] = px0[k]); \ - ++pp1_[j]; \ - if (pi0[k] != j) { \ + if (pi0[k] == j) { \ + pi1[pp1_[j]] = pi0[k]; \ + _MASK_(_ASSIGN_JJ_(px1[pp1_[j]], px0[k])); \ + ++pp1_[j]; \ + } else { \ + pi1[pp1_[j]] = pi0[k]; \ + _MASK_(px1[pp1_[j]] = px0[k]); \ + ++pp1_[j]; \ pi1[pp1_[pi0[k]]] = j; \ - _MASK_(px1[pp1_[pi0[k]]] = px0[k]); \ + _MASK_(_ASSIGN_JI_(px1[pp1_[pi0[k]]], px0[k])); \ ++pp1_[pi0[k]]; \ } \ ++k; \ @@ -2091,7 +3014,7 @@ } while (0) if (class[0] == 'n') - SAG_SUBCASES(int, LOGICAL, HIDE, 1); + SAG_SUBCASES(int, LOGICAL, HIDE, 1, ASSIGN_REAL, ASSIGN_REAL); else { SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), pp1[n - 1])); @@ -2124,27 +3047,37 @@ int *pi1 = INTEGER(i1), *pj1 = INTEGER(j1); SET_SLOT(to, Matrix_iSym, i1); SET_SLOT(to, Matrix_jSym, j1); - Matrix_memcpy(pi1, pi0, nnz0, sizeof(int)); - Matrix_memcpy(pj1, pj0, nnz0, sizeof(int)); - pi1 += nnz0; - pj1 += nnz0; #undef SAG_SUBCASES -#define SAG_SUBCASES(_CTYPE_, _PTR_, _MASK_, _ONE_) \ +#define SAG_SUBCASES(_CTYPE_, _PTR_, _MASK_, _ONE_, _ASSIGN_JJ_, _ASSIGN_JI_) \ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1)); \ - _MASK_(Matrix_memcpy(px1, px0, nnz0, sizeof(_CTYPE_))); \ - _MASK_(px1 += nnz0); \ if (class[1] == 's') { \ for (R_xlen_t k = 0; k < nnz0; ++k) { \ - if (*pi0 != *pj0) { \ + if (*pi0 == *pj0) { \ + *(pi1++) = *pi0; \ + *(pj1++) = *pj0; \ + _MASK_(_ASSIGN_JJ_((*px1), (*px0))); \ + _MASK_(++px1); \ + } else { \ + *(pi1++) = *pi0; \ + *(pj1++) = *pj0; \ + _MASK_(*px1 = *px0); \ + _MASK_(++px1); \ *(pi1++) = *pj0; \ *(pj1++) = *pi0; \ - _MASK_(*(px1++) = *px0) ; \ + _MASK_(_ASSIGN_JI_((*px1), (*px0))); \ + _MASK_(++px1); \ } \ ++pi0; ++pj0; _MASK_(++px0); \ } \ } else { \ + Matrix_memcpy(pi1, pi0, nnz0, sizeof(int)); \ + Matrix_memcpy(pj1, pj0, nnz0, sizeof(int)); \ + _MASK_(Matrix_memcpy(px1, px0, nnz0, sizeof(_CTYPE_))); \ + pi1 += nnz0; \ + pj1 += nnz0; \ + _MASK_(px1 += nnz0); \ for (int d = 0; d < n; ++d) { \ *(pi1++) = *(pj1++) = d; \ _MASK_(*(px1++) = _ONE_); \ @@ -2153,7 +3086,7 @@ } while (0) if (class[0] == 'n') - SAG_SUBCASES(int, LOGICAL, HIDE, 1); + SAG_SUBCASES(int, LOGICAL, HIDE, 1, ASSIGN_REAL, ASSIGN_REAL); else { SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), nnz1)); @@ -2198,7 +3131,7 @@ cl[1] = class[1]; cl[2] = (class[1] == 's') ? 'y' : 'r'; } - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int n = INTEGER(dim)[0]; @@ -2220,9 +3153,9 @@ UNPROTECT(1); /* uplo */ if (cl[1] != 't') { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ if (cl[0] == 'c') { @@ -2243,27 +3176,27 @@ x1 = PROTECT(allocVector(TYPEOF(x0), (R_xlen_t) n * n)); SET_SLOT(to, Matrix_xSym, x1); -#define UNPACK(_CTYPE_, _PTR_, _PREFIX_) \ +#define UNPACK(_PREFIX_, _CTYPE_, _PTR_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ Matrix_memset(px1, 0, (R_xlen_t) n * n, sizeof(_CTYPE_)); \ - _PREFIX_ ## dense_unpack(px1, px0, n, ul, 'N'); \ + _PREFIX_ ## unpack1(px1, px0, n, ul, 'N'); \ } while (0) switch (cl[0]) { case 'n': case 'l': - UNPACK(int, LOGICAL, i); + UNPACK(i, int, LOGICAL); break; case 'i': - UNPACK(int, INTEGER, i); + UNPACK(i, int, INTEGER); break; case 'c': case 'd': - UNPACK(double, REAL, d); + UNPACK(d, double, REAL); break; case 'z': - UNPACK(Rcomplex, COMPLEX, z); + UNPACK(z, Rcomplex, COMPLEX); break; default: break; @@ -2280,7 +3213,7 @@ { static const char *valid[] = { "dpoMatrix", "dppMatrix", "corMatrix", "pcorMatrix", - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + VALID_DENSE, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); @@ -2305,7 +3238,7 @@ cl[1] = (!ge) ? class[1] : ((di == '\0') ? 's' : 't'); cl[2] = 'p'; } - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS((class[0] == 'c') ? cl - 1 : cl)); + SEXP to = PROTECT(newObject((class[0] == 'c') ? cl - 1 : cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), n = pdim[0]; @@ -2344,9 +3277,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ if (cl[0] == 'c') { @@ -2359,29 +3292,29 @@ } SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), - x1 = PROTECT(allocVector(TYPEOF(x0), PM_LENGTH(n))); + x1 = PROTECT(allocVector(TYPEOF(x0), PACKED_LENGTH(n))); SET_SLOT(to, Matrix_xSym, x1); -#define PACK(_CTYPE_, _PTR_, _PREFIX_) \ +#define PACK(_PREFIX_, _CTYPE_, _PTR_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ - _PREFIX_ ## dense_pack(px1, px0, n, ul, 'N'); \ + _PREFIX_ ## pack2(px1, px0, n, ul, 'N'); \ } while (0) switch (cl[0]) { case 'n': case 'l': - PACK(int, LOGICAL, i); + PACK(i, int, LOGICAL); break; case 'i': - PACK(int, INTEGER, i); + PACK(i, int, INTEGER); break; case 'c': case 'd': - PACK(double, REAL, d); + PACK(d, double, REAL); break; case 'z': - PACK(Rcomplex, COMPLEX, z); + PACK(z, Rcomplex, COMPLEX); break; default: break; @@ -2398,7 +3331,7 @@ { static const char *valid[] = { "dpoMatrix", "dppMatrix", "corMatrix", "pcorMatrix", - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + VALID_DENSE, "" }; int ivalid = R_check_class_etc(from, valid); if (ivalid < 0) ERROR_INVALID_CLASS(from, __func__); @@ -2408,11 +3341,13 @@ if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); + error(_("'%s' must be \"%s\" or \"%s\""), "uplo", "U", "L"); + if (diag != R_NilValue) { if (TYPEOF(diag) != STRSXP || LENGTH(diag) < 1 || - ((diag = STRING_ELT(diag, 0)) != NA_STRING && - (di = *CHAR(diag)) != '\0' && di != 'N' && di != 'U')) - error(_("invalid '%s' to %s()"), "diag", __func__); + (diag = STRING_ELT(diag, 0)) == NA_STRING || + ((di = *CHAR(diag)) != 'N' && ul != 'U')) + error(_("'%s' must be \"%s\" or \"%s\""), "diag", "N", "U"); + } } return dense_as_packed(from, valid[ivalid], ul, di); @@ -2500,7 +3435,7 @@ workC = workB + r; pj_ = workC + m; -#define TSORT_LOOP(_CTYPE_, _PTR_, _MASK_, _INCR_) \ +#define TSORT_LOOP(_CTYPE_, _PTR_, _MASK_, _INCREMENT_) \ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1, *px_); \ _MASK_(Matrix_Calloc(px_, nnz0, _CTYPE_)); \ @@ -2555,7 +3490,7 @@ ++kend_; \ } else { \ /* Have already seen this column index */ \ - _MASK_(_INCR_); \ + _MASK_(_INCREMENT_(px_[workB[pj_[k]]], px_[k])); \ } \ ++k; \ } \ @@ -2620,48 +3555,20 @@ } while (0) if (!x0) - TSORT_LOOP(int, LOGICAL, HIDE, ); + TSORT_LOOP(int, LOGICAL, HIDE, INCREMENT_PATTERN); else { switch (TYPEOF(x0)) { case LGLSXP: - TSORT_LOOP(int, LOGICAL, SHOW, - do { - if (px_[k] == NA_LOGICAL) { - if (px_[workB[pj_[k]]] == 0) - px_[workB[pj_[k]]] = NA_LOGICAL; - } else if (px_[k] != 0) - px_[workB[pj_[k]]] = 1; - } while (0)); + TSORT_LOOP(int, LOGICAL, SHOW, INCREMENT_LOGICAL); break; case INTSXP: - TSORT_LOOP(int, INTEGER, SHOW, - - do { - if (px_[workB[pj_[k]]] != NA_INTEGER) { - if (px_[k] == NA_INTEGER) - px_[workB[pj_[k]]] = NA_INTEGER; - else if ((px_[k] < 0) - ? (px_[workB[pj_[k]]] <= INT_MIN - px_[k]) - : (px_[workB[pj_[k]]] > INT_MAX - px_[k])) { - warning(_("NAs produced by integer overflow")); - px_[workB[pj_[k]]] = NA_INTEGER; - } else - px_[workB[pj_[k]]] += px_[k]; - } - } while (0)); + TSORT_LOOP(int, INTEGER, SHOW, INCREMENT_INTEGER); break; case REALSXP: - TSORT_LOOP(double, REAL, SHOW, - do { - px_[workB[pj_[k]]] += px_[k]; - } while (0)); + TSORT_LOOP(double, REAL, SHOW, INCREMENT_REAL); break; case CPLXSXP: - TSORT_LOOP(Rcomplex, COMPLEX, SHOW, - do { - px_[workB[pj_[k]]].r += px_[k].r; - px_[workB[pj_[k]]].i += px_[k].i; - } while (0)); + TSORT_LOOP(Rcomplex, COMPLEX, SHOW, INCREMENT_COMPLEX); break; default: break; @@ -2751,7 +3658,7 @@ ++kend_; \ } else { \ /* Have already seen this column index */ \ - _MASK_(_INCREMENT_(px_[k], px_[workB[pj_[k]]])); \ + _MASK_(_INCREMENT_(px_[workB[pj_[k]]], px_[k])); \ } \ ++k; \ } \ @@ -2819,7 +3726,7 @@ char cl[] = "..CMatrix"; cl[0] = class[0]; cl[1] = class[1]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -2845,9 +3752,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } @@ -2918,7 +3825,7 @@ char cl[] = "..RMatrix"; cl[0] = class[0]; cl[1] = class[1]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -2944,9 +3851,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } @@ -3017,7 +3924,7 @@ char cl[] = "..TMatrix"; cl[0] = class[0]; cl[1] = class[1]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; @@ -3043,9 +3950,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } @@ -3160,7 +4067,7 @@ to = GET_SLOT(from, Matrix_xSym); break; case 'i': - REPROTECT(from = diagonal_as_dense(from, cl, 'g', 0, '\0'), pid); + REPROTECT(from = diagonal_as_dense(from, cl, '.', 'g', 0, '\0'), pid); to = GET_SLOT(from, Matrix_xSym); break; case 'd': @@ -3179,7 +4086,7 @@ case 'i': if (cl[0] == 'n') { PROTECT(to); - na2one(to); + naToOne(to); UNPROTECT(1); } break; @@ -3224,7 +4131,7 @@ to = GET_SLOT(from, Matrix_xSym); break; case 'i': - REPROTECT(from = diagonal_as_dense(from, cl, 'g', 0, '\0'), pid); + REPROTECT(from = diagonal_as_dense(from, cl, '.', 'g', 0, '\0'), pid); to = GET_SLOT(from, Matrix_xSym); break; case 'd': @@ -3252,7 +4159,7 @@ case 'p': case 'i': if (cl[0] == 'n') - na2one(to); + naToOne(to); break; default: break; @@ -3283,7 +4190,7 @@ case 'T': return sparse_as_dense(from, cl, 0); case 'i': - return diagonal_as_dense(from, cl, 't', 0, 'U'); + return diagonal_as_dense(from, cl, '.', 't', 0, 'U'); case 'd': return index_as_dense(from, cl, 'n'); default: @@ -3314,7 +4221,7 @@ case 'T': return sparse_as_dense(from, cl, 1); case 'i': - return diagonal_as_dense(from, cl, 't', 1, 'U'); + return diagonal_as_dense(from, cl, '.', 't', 1, 'U'); default: return R_NilValue; } @@ -3340,7 +4247,7 @@ case 'T': return sparse_as_Csparse(from, cl); case 'i': - return diagonal_as_sparse(from, cl, 't', 'C', 'U'); + return diagonal_as_sparse(from, cl, '.', 't', 'C', 'U'); case 'd': return index_as_sparse(from, cl, 'n', 'C'); default: @@ -3368,7 +4275,7 @@ case 'T': return sparse_as_Rsparse(from, cl); case 'i': - return diagonal_as_sparse(from, cl, 't', 'R', 'U'); + return diagonal_as_sparse(from, cl, '.', 't', 'R', 'U'); case 'd': return index_as_sparse(from, cl, 'n', 'R'); default: @@ -3396,7 +4303,7 @@ case 'T': return sparse_as_Tsparse(from, cl); case 'i': - return diagonal_as_sparse(from, cl, 't', 'T', 'U'); + return diagonal_as_sparse(from, cl, '.', 't', 'T', 'U'); case 'd': return index_as_sparse(from, cl, 'n', 'T'); default: @@ -3417,10 +4324,10 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); if (TYPEOF(sparse) != LGLSXP || LENGTH(sparse) < 1) - error(_("invalid '%s' to %s()"), "sparse", __func__); + error(_("'%s' must be %s or %s or %s"), "sparse", "TRUE", "FALSE", "NA"); int sparse_ = LOGICAL(sparse)[0]; switch (cl[2]) { @@ -3429,7 +4336,7 @@ case 'r': case 'p': if (sparse_ == NA_LOGICAL || !sparse_) - from = dense_as_kind(from, cl, kind_); + from = dense_as_kind(from, cl, kind_, 0); else { from = dense_as_sparse(from, cl, 'C'); PROTECT(from); @@ -3447,7 +4354,7 @@ if (sparse_ != NA_LOGICAL && !sparse_) { PROTECT(from); char cl_[] = "...Matrix"; - cl_[0] = (kind_ == '.') ? cl[0] : kind_; + cl_[0] = (kind_ == '.') ? cl[0] : ((kind_ == ',') ? ((cl[0] == 'z') ? 'z' : 'd') : kind_); cl_[1] = cl[1]; cl_[2] = cl[2]; from = sparse_as_dense(from, cl_, 0); @@ -3455,35 +4362,12 @@ } return from; case 'i': - /* Ugly because there is no ndiMatrix, - and because [ld]diMatrix does not extend [ld]sparseMatrix - */ - if (kind_ != 'n') { + if (sparse_ == NA_LOGICAL) from = diagonal_as_kind(from, cl, kind_); - if (sparse_ != NA_LOGICAL) { - PROTECT(from); - char cl_[] = ".diMatrix"; - cl_[0] = (kind_ == '.') ? cl[0] : kind_; - if (sparse_) - from = diagonal_as_sparse(from, cl_, 't', 'C', 'U'); - else - from = diagonal_as_dense(from, cl_, 't', 0, 'U'); - UNPROTECT(1); - } - } else { - from = diagonal_as_sparse(from, cl, 't', 'C', 'U'); - PROTECT(from); - char cl_[] = ".tCMatrix"; - cl_[0] = cl[0]; - from = sparse_as_kind(from, cl_, 'n'); - UNPROTECT(1); - if (sparse_ != NA_LOGICAL && !sparse_) { - PROTECT(from); - cl_[0] = 'n'; - from = sparse_as_dense(from, cl_, 0); - UNPROTECT(1); - } - } + else if (sparse_) + from = diagonal_as_sparse(from, cl, kind_, 't', 'C', 'U'); + else + from = diagonal_as_dense(from, cl, kind_, 't', 0, 'U'); return from; case 'd': if (sparse_ == NA_LOGICAL || sparse_) @@ -3509,7 +4393,7 @@ if (TYPEOF(kind) != STRSXP || LENGTH(kind) < 1 || (kind = STRING_ELT(kind, 0)) == NA_STRING || (kind_ = CHAR(kind)[0]) == '\0') - error(_("invalid '%s' to %s()"), "kind", __func__); + error(_("invalid '%s' to '%s'"), "kind", __func__); switch (cl[2]) { case 'e': @@ -3518,14 +4402,12 @@ case 'p': { char cl_[] = "...Matrix"; - cl_[0] = (kind_ == '.') ? cl[0] : kind_; + cl_[0] = (kind_ == '.') ? cl[0] : ((kind_ == ',') ? ((cl[0] == 'z') ? 'z' : 'd') : kind_); cl_[1] = cl[1]; cl_[2] = cl[2]; - int new = (cl[0] == cl_[0]) || ((cl[0] == 'n' && cl_[0] == 'l') || - (cl[0] == 'l' && cl_[0] == 'n')); - from = dense_as_kind(from, cl, kind_); + from = dense_as_kind(from, cl, cl_[0], 1); PROTECT(from); - from = dense_as_general(from, cl_, new); + from = dense_as_general(from, cl_, cl[0] == cl_[0]); UNPROTECT(1); return from; } @@ -3534,26 +4416,17 @@ case 'T': { char cl_[] = "...Matrix"; - cl_[0] = (kind_ == '.') ? cl[0] : kind_; + cl_[0] = (kind_ == '.') ? cl[0] : ((kind_ == ',') ? ((cl[0] == 'z') ? 'z' : 'd') : kind_); cl_[1] = cl[1]; cl_[2] = cl[2]; - from = sparse_as_kind(from, cl, kind_); + from = sparse_as_kind(from, cl, cl_[0]); PROTECT(from); from = sparse_as_general(from, cl_); UNPROTECT(1); return from; } case 'i': - { - /* As there is no ndiMatrix, we cannot use diagonal_as_kind here: */ - char cl_[] = ".gCMatrix"; - cl_[0] = cl[0]; - from = diagonal_as_sparse(from, cl, 'g', 'C', '\0'); - PROTECT(from); - from = sparse_as_kind(from, cl_, kind_); - UNPROTECT(1); - return from; - } + return diagonal_as_sparse(from, cl, kind_, 'g', 'C', '\0'); case 'd': /* indMatrix extends generalMatrix, but we typically do want this: */ return index_as_sparse(from, cl, kind_, '.'); diff -Nru rmatrix-1.6-1.1/src/coerce.h rmatrix-1.6-5/src/coerce.h --- rmatrix-1.6-1.1/src/coerce.h 2023-07-30 19:24:16.000000000 +0000 +++ rmatrix-1.6-5/src/coerce.h 2023-10-13 05:58:05.000000000 +0000 @@ -1,104 +1,79 @@ #ifndef MATRIX_COERCE_H #define MATRIX_COERCE_H -#include "Mutils.h" +#include -SEXP matrix_as_dense(SEXP from, const char *zzz, char ul, char di, - int transpose_if_vector, int new); +SEXP vector_as_dense(SEXP, const char *, char, char, int, int, int, SEXP); +SEXP R_vector_as_dense(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP R_matrix_as_dense(SEXP from, SEXP class, SEXP uplo, SEXP diag); +SEXP matrix_as_dense(SEXP, const char *, char, char, int, int); +SEXP R_matrix_as_dense(SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP sparse_as_dense(SEXP from, const char *class, int packed); +SEXP sparse_as_dense(SEXP, const char *, int); +SEXP R_sparse_as_dense(SEXP, SEXP); -SEXP R_sparse_as_dense(SEXP from, SEXP packed); +SEXP diagonal_as_dense(SEXP, const char *, char, char, int, char); +SEXP R_diagonal_as_dense(SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP diagonal_as_dense(SEXP from, const char *class, - char shape, int packed, char ul); +SEXP index_as_dense(SEXP, const char *, char); +SEXP R_index_as_dense(SEXP, SEXP); -SEXP R_diagonal_as_dense(SEXP from, SEXP shape, SEXP packed, SEXP uplo); +SEXP vector_as_sparse(SEXP, const char *, char, char, int, int, int, SEXP); +SEXP R_vector_as_sparse(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP index_as_dense(SEXP from, const char *class, char kind); +SEXP matrix_as_sparse(SEXP, const char *, char, char, int); +SEXP R_matrix_as_sparse(SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP R_index_as_dense(SEXP from, SEXP kind); +SEXP dense_as_sparse(SEXP, const char *, char); +SEXP R_dense_as_sparse(SEXP, SEXP); -SEXP matrix_as_sparse(SEXP from, const char *zzz, char ul, char di, - int transpose_if_vector); +SEXP diagonal_as_sparse(SEXP, const char *, char, char, char, char); +SEXP R_diagonal_as_sparse(SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP R_matrix_as_sparse(SEXP from, SEXP class, SEXP uplo, SEXP diag); +SEXP index_as_sparse(SEXP, const char *, char, char); +SEXP R_index_as_sparse(SEXP, SEXP, SEXP); -SEXP dense_as_sparse(SEXP from, const char *class, char repr); +SEXP dense_as_kind(SEXP, const char *, char, int); +SEXP R_dense_as_kind(SEXP, SEXP); -SEXP R_dense_as_sparse(SEXP from, SEXP repr); +SEXP sparse_as_kind(SEXP, const char *, char); +SEXP R_sparse_as_kind(SEXP, SEXP); -SEXP diagonal_as_sparse(SEXP from, const char *class, - char shape, char repr, char ul); +SEXP diagonal_as_kind(SEXP, const char *, char); +SEXP R_diagonal_as_kind(SEXP, SEXP); -SEXP R_diagonal_as_sparse(SEXP from, SEXP shape, SEXP repr, SEXP uplo); +SEXP index_as_kind(SEXP, const char *, char); +SEXP R_index_as_kind(SEXP, SEXP); -SEXP index_as_sparse(SEXP from, const char *class, char kind, char repr); +SEXP dense_as_general(SEXP, const char *, int); +SEXP R_dense_as_general(SEXP); -SEXP R_index_as_sparse(SEXP from, SEXP kind, SEXP repr); +SEXP sparse_as_general(SEXP, const char *); +SEXP R_sparse_as_general(SEXP); -SEXP dense_as_kind(SEXP from, const char *class, char kind); +SEXP dense_as_unpacked(SEXP, const char *); +SEXP R_dense_as_unpacked(SEXP); -SEXP R_dense_as_kind(SEXP from, SEXP kind); +SEXP dense_as_packed(SEXP, const char *, char, char); +SEXP R_dense_as_packed(SEXP, SEXP, SEXP); -SEXP sparse_as_kind(SEXP from, const char *class, char kind); +SEXP sparse_as_Csparse(SEXP, const char *); +SEXP R_sparse_as_Csparse(SEXP); -SEXP R_sparse_as_kind(SEXP from, SEXP kind); +SEXP sparse_as_Rsparse(SEXP, const char *); +SEXP R_sparse_as_Rsparse(SEXP); -SEXP diagonal_as_kind(SEXP from, const char *class, char kind); +SEXP sparse_as_Tsparse(SEXP, const char *); +SEXP R_sparse_as_Tsparse(SEXP); -SEXP R_diagonal_as_kind(SEXP from, SEXP kind); +SEXP R_Matrix_as_vector(SEXP); +SEXP R_Matrix_as_matrix(SEXP); +SEXP R_Matrix_as_unpacked(SEXP); +SEXP R_Matrix_as_packed(SEXP); +SEXP R_Matrix_as_Csparse(SEXP); +SEXP R_Matrix_as_Rsparse(SEXP); +SEXP R_Matrix_as_Tsparse(SEXP); +SEXP R_Matrix_as_kind(SEXP, SEXP, SEXP); +SEXP R_Matrix_as_general(SEXP, SEXP); -SEXP index_as_kind(SEXP from, const char *class, char kind); - -SEXP R_index_as_kind(SEXP from, SEXP kind); - -SEXP dense_as_general(SEXP from, const char *class, int new); - -SEXP R_dense_as_general(SEXP from); - -SEXP sparse_as_general(SEXP from, const char *class); - -SEXP R_sparse_as_general(SEXP from); - -SEXP dense_as_unpacked(SEXP from, const char *class); - -SEXP R_dense_as_unpacked(SEXP from); - -SEXP dense_as_packed(SEXP from, const char *class, char ul, char di); - -SEXP R_dense_as_packed(SEXP from, SEXP uplo, SEXP diag); - -SEXP sparse_as_Csparse(SEXP from, const char *class); - -SEXP R_sparse_as_Csparse(SEXP from); - -SEXP sparse_as_Rsparse(SEXP from, const char *class); - -SEXP R_sparse_as_Rsparse(SEXP from); - -SEXP sparse_as_Tsparse(SEXP from, const char *class); - -SEXP R_sparse_as_Tsparse(SEXP from); - -SEXP R_Matrix_as_vector(SEXP from); - -SEXP R_Matrix_as_matrix(SEXP from); - -SEXP R_Matrix_as_unpacked(SEXP from); - -SEXP R_Matrix_as_packed(SEXP from); - -SEXP R_Matrix_as_Csparse(SEXP from); - -SEXP R_Matrix_as_Rsparse(SEXP from); - -SEXP R_Matrix_as_Tsparse(SEXP from); - -SEXP R_Matrix_as_kind(SEXP from, SEXP kind, SEXP sparse); - -SEXP R_Matrix_as_general(SEXP from, SEXP kind); - -#endif +#endif /* MATRIX_COERCE_H */ diff -Nru rmatrix-1.6-1.1/src/cs-etc.c rmatrix-1.6-5/src/cs-etc.c --- rmatrix-1.6-1.1/src/cs-etc.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/cs-etc.c 2023-10-25 15:50:21.000000000 +0000 @@ -0,0 +1,421 @@ +#include "Mdefines.h" +#include "cs-etc.h" + +int Matrix_cs_xtype; /* flag indicating use of cs_di_* or cs_ci_* */ + +Matrix_cs *M2CXS(SEXP obj, int values) +{ + Matrix_cs *A = (Matrix_cs *) R_alloc(1, sizeof(Matrix_cs)); + memset(A, 0, sizeof(Matrix_cs)); + SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, Matrix_iSym)), + x = PROTECT(getAttrib(obj, Matrix_xSym)); + A->m = INTEGER(dim)[0]; + A->n = INTEGER(dim)[1]; + A->p = INTEGER(p); + A->i = INTEGER(i); + A->nzmax = LENGTH(i); + A->nz = -1; + A->xtype = MCS_PATTERN; + if (values && x != R_NilValue) { + switch (TYPEOF(x)) { + case CPLXSXP: + A->xtype = MCS_COMPLEX; + A->x = COMPLEX(x); + break; + case REALSXP: + A->xtype = MCS_REAL; + A->x = REAL(x); + break; + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + } + UNPROTECT(4); + return A; +} + +SEXP CXS2M(Matrix_cs *A, int values, char shape) +{ + if (values && A->xtype != MCS_REAL && A->xtype != MCS_COMPLEX) + error(_("wrong '%s'"), "xtype"); + char cl[] = "..CMatrix"; + cl[0] = (!values || A->xtype == MCS_PATTERN) + ? 'n' : ((A->xtype == MCS_COMPLEX) ? 'z' : 'd'); + cl[1] = shape; + int nnz = A->p[A->n]; + R_xlen_t np1 = (R_xlen_t) A->n + 1; + SEXP obj = PROTECT(newObject(cl)), + dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), + p = PROTECT(allocVector(INTSXP, np1)), + i = PROTECT(allocVector(INTSXP, nnz)); + INTEGER(dim)[0] = A->m; + INTEGER(dim)[1] = A->n; + Matrix_memcpy(INTEGER(p), A->p, np1, sizeof(int)); + Matrix_memcpy(INTEGER(i), A->i, nnz, sizeof(int)); + SET_SLOT(obj, Matrix_pSym, p); + SET_SLOT(obj, Matrix_iSym, i); + if (cl[0] != 'n') { + SEXP x; + if (cl[0] == 'z') { + PROTECT(x = allocVector(CPLXSXP, nnz)); + Matrix_memcpy(COMPLEX(x), A->x, nnz, sizeof(Rcomplex)); + } else { + PROTECT(x = allocVector(REALSXP, nnz)); + Matrix_memcpy(REAL(x), A->x, nnz, sizeof(double)); + } + SET_SLOT(obj, Matrix_xSym, x); + UNPROTECT(1); + } + UNPROTECT(4); + return obj; +} + +/* Wrappers for the functions that we use at least once : */ + +Matrix_csd *Matrix_cs_dfree(Matrix_csd *D) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_csd *) cs_ci_dfree((cs_cid *) D); + else + return (Matrix_csd *) cs_di_dfree((cs_did *) D); +#else + return (Matrix_csd *) cs_dfree((csd *) D); +#endif +} + +Matrix_csd *Matrix_cs_dmperm(const Matrix_cs *A, int seed) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_csd *) cs_ci_dmperm((cs_ci *) A, seed); + else + return (Matrix_csd *) cs_di_dmperm((cs_di *) A, seed); +#else + return (Matrix_csd *) cs_dmperm((cs *) A, seed); +#endif +} + +int Matrix_cs_dropzeros(Matrix_cs *A) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_dropzeros((cs_ci *) A); + else + return cs_di_dropzeros((cs_di *) A); +#else + return cs_dropzeros((cs *) A); +#endif +} + +void *Matrix_cs_free(void *p) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_free(p); + else + return cs_di_free(p); +#else + return cs_free(p); +#endif +} + +int Matrix_cs_happly(const Matrix_cs *V, int i, double beta, void *x) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_happly((cs_ci *) V, i, beta, (double _Complex *) x); + else + return cs_di_happly((cs_di *) V, i, beta, (double *) x); +#else + return cs_happly((cs *) V, i, beta, (double *) x); +#endif +} + +int Matrix_cs_ipvec(const int *p, const void *b, void *x, int n) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_ipvec(p, (double _Complex *) b, (double _Complex *) x, n); + else + return cs_di_ipvec(p, (double *) b, (double *) x, n); +#else + return cs_ipvec(p, (double *) b, (double *) x, n); +#endif +} + +int Matrix_cs_lsolve(const Matrix_cs *L, void *x) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_lsolve((cs_ci *) L, (double _Complex *) x); + else + return cs_di_lsolve((cs_di *) L, (double *) x); +#else + return cs_lsolve((cs *) L, (double *) x); +#endif +} + +Matrix_csn *Matrix_cs_lu(const Matrix_cs *A, const Matrix_css *S, double tol) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_csn *) cs_ci_lu((cs_ci *) A, (cs_cis *) S, tol); + else + return (Matrix_csn *) cs_di_lu((cs_di *) A, (cs_dis *) S, tol); +#else + return (Matrix_csn *) cs_lu((cs *) A, (css *) S, tol); +#endif +} + +int Matrix_cs_lusol(int order, const Matrix_cs *A, void *b, double tol) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_lusol(order, (cs_ci *) A, (double _Complex *) b, tol); + else + return cs_di_lusol(order, (cs_di *) A, (double *) b, tol); +#else + return cs_lusol(order, (cs *) A, (double *) b, tol); +#endif +} + +Matrix_csn *Matrix_cs_nfree(Matrix_csn *N) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_csn *) cs_ci_nfree((cs_cin *) N); + else + return (Matrix_csn *) cs_di_nfree((cs_din *) N); +#else + return (Matrix_csn *) cs_nfree((csn *) N); +#endif +} + +Matrix_cs *Matrix_cs_permute(const Matrix_cs *A, const int *pinv, const int *q, int values) +{ + Matrix_cs *B = NULL; +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) { + cs_ci *tmp = cs_ci_permute((cs_ci *) A, pinv, q, values); + B = (Matrix_cs *) cs_ci_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_ci)); + tmp = cs_ci_free(tmp); + } else { + cs_di *tmp = cs_di_permute((cs_di *) A, pinv, q, values); + B = (Matrix_cs *) cs_di_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_di)); + tmp = cs_di_free(tmp); + } +#else + cs *tmp = cs_permute((cs *) A, pinv, q, values); + B = (Matrix_cs *) cs_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs )); + tmp = cs_free(tmp); +#endif + B->xtype = MCS_XTYPE_GET(); + return B; +} + +int *Matrix_cs_pinv(const int *p, int n) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_pinv(p, n); + else + return cs_di_pinv(p, n); +#else + return cs_pinv(p, n); +#endif +} + +int Matrix_cs_pvec(const int *p, const void *b, void *x, int n) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_pvec(p, (double _Complex *) b, (double _Complex *) x, n); + else + return cs_di_pvec(p, (double *) b, (double *) x, n); +#else + return cs_pvec(p, (double *) b, (double *) x, n); +#endif +} + +Matrix_csn *Matrix_cs_qr(const Matrix_cs *A, const Matrix_css *S) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_csn *) cs_ci_qr((cs_ci *) A, (cs_cis *) S); + else + return (Matrix_csn *) cs_di_qr((cs_di *) A, (cs_dis *) S); +#else + return (Matrix_csn *) cs_qr((cs *) A, (css *) S); +#endif +} + +int Matrix_cs_qrsol(int order, const Matrix_cs *A, void *b) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_qrsol(order, (cs_ci *) A, (double _Complex *) b); + else + return cs_di_qrsol(order, (cs_di *) A, (double *) b); +#else + return cs_qrsol(order, (cs *) A, (double *) b); +#endif +} + +Matrix_css *Matrix_cs_sfree(Matrix_css *S) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_css *) cs_ci_sfree((cs_cis *) S); + else + return (Matrix_css *) cs_di_sfree((cs_dis *) S); +#else + return (Matrix_css *) cs_sfree((css *) S); +#endif +} + +Matrix_cs *Matrix_cs_spalloc(int m, int n, int nzmax, int values, int triplet) +{ + Matrix_cs *B = NULL; +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) { + cs_ci *tmp = cs_ci_spalloc(m, n, nzmax, values, triplet); + B = (Matrix_cs *) cs_ci_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_ci)); + tmp = cs_ci_free(tmp); + } else { + cs_di *tmp = cs_di_spalloc(m, n, nzmax, values, triplet); + B = (Matrix_cs *) cs_di_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_di)); + tmp = cs_di_free(tmp); + } +#else + cs *tmp = cs_spalloc(m, n, nzmax, values, triplet); + B = (Matrix_cs *) cs_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs )); + tmp = cs_free(tmp); +#endif + B->xtype = MCS_XTYPE_GET(); + return B; +} + +Matrix_cs *Matrix_cs_speye(int m, int n, int values, int triplet) +{ + int k, d = (m < n) ? m : n; + Matrix_cs *B = Matrix_cs_spalloc(m, n, d, values, triplet); + if (!B) + return NULL; + int *B__p = B->p, *B__i = B->i; + for (k = 0; k < d; ++k) + B__p[k] = B__i[k] = k; + if (!triplet) + for (k = d; k <= n; ++k) + B__p[k] = d; + if (values) { +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) { + double _Complex *B__x = (double _Complex *) B->x; + for (k = 0; k < d; ++k) + B__x[k] = 1.0; + } else { +#endif + double *B__x = (double *) B->x; + for (k = 0; k < d; ++k) + B__x[k] = 1.0; +#ifdef CXSPARSE + } +#endif + } + return B; +} + +Matrix_cs *Matrix_cs_spfree(Matrix_cs *A) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_cs *) cs_ci_spfree((cs_ci *) A); + else + return (Matrix_cs *) cs_di_spfree((cs_di *) A); +#else + return (Matrix_cs *) cs_spfree((cs *) A); +#endif +} + +int Matrix_cs_sprealloc(Matrix_cs *A, int nzmax) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_sprealloc((cs_ci *) A, nzmax); + else + return cs_di_sprealloc((cs_di *) A, nzmax); +#else + return cs_sprealloc((cs *) A, nzmax); +#endif +} + +int Matrix_cs_spsolve(Matrix_cs *L, const Matrix_cs *B, int k, int *xi, void *x, const int *pinv, int lo) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_spsolve((cs_ci *) L, (cs_ci *) B, k, xi, (double _Complex *) x, pinv, lo); + else + return cs_di_spsolve((cs_di *) L, (cs_di *) B, k, xi, (double *) x, pinv, lo); +#else + return cs_spsolve((cs *) L, (cs *) B, k, xi, (double *) x, pinv, lo); +#endif +} + +Matrix_css *Matrix_cs_sqr(int order, const Matrix_cs *A, int qr) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return (Matrix_css *) cs_ci_sqr(order, (cs_ci *) A, qr); + else + return (Matrix_css *) cs_di_sqr(order, (cs_di *) A, qr); +#else + return (Matrix_css *) cs_sqr(order, (cs *) A, qr); +#endif +} + +Matrix_cs *Matrix_cs_transpose(const Matrix_cs *A, int values) +{ + Matrix_cs *B = NULL; +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) { + cs_ci *tmp = cs_ci_transpose((cs_ci *) A, values); + B = (Matrix_cs *) cs_ci_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_ci)); + tmp = cs_ci_free(tmp); + } else { + cs_di *tmp = cs_di_transpose((cs_di *) A, values); + B = (Matrix_cs *) cs_di_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs_di)); + tmp = cs_di_free(tmp); + } +#else + cs *tmp = cs_transpose((cs *) A, values); + B = (Matrix_cs *) cs_calloc(1, sizeof(Matrix_cs)); + memcpy(B, tmp, sizeof(cs )); + tmp = cs_free(tmp); +#endif + B->xtype = MCS_XTYPE_GET(); + return B; +} + +int Matrix_cs_usolve(const Matrix_cs *U, void *x) +{ +#ifdef CXSPARSE + if (MCS_XTYPE_GET() == MCS_COMPLEX) + return cs_ci_usolve((cs_ci *) U, (double _Complex *) x); + else + return cs_di_usolve((cs_di *) U, (double *) x); +#else + return cs_usolve((cs *) U, (double *) x); +#endif +} diff -Nru rmatrix-1.6-1.1/src/cs-etc.h rmatrix-1.6-5/src/cs-etc.h --- rmatrix-1.6-1.1/src/cs-etc.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/cs-etc.h 2023-10-25 15:50:21.000000000 +0000 @@ -0,0 +1,89 @@ +#ifndef MATRIX_CS_ETC_H +#define MATRIX_CS_ETC_H + +#include +#include "cs.h" + +#define MCS_PATTERN 0 +#define MCS_REAL 1 +#define MCS_COMPLEX 2 + +#define MCS_XTYPE_GET( ) Matrix_cs_xtype +#define MCS_XTYPE_SET(_VALUE_) Matrix_cs_xtype = _VALUE_ + +extern int Matrix_cs_xtype; + +typedef struct Matrix_cs_sparse +{ + int nzmax; + int m; + int n; + int *p; + int *i; + void *x; /* (double *) or (double _Complex *) */ + int nz; + int xtype; /* Matrix-only */ +} Matrix_cs; + +typedef struct Matrix_cs_symbolic +{ + int *pinv; + int *q; + int *parent; + int *cp; + int *leftmost; + int m2; + double lnz; + double unz; +} Matrix_css; + +typedef struct Matrix_cs_numeric +{ + Matrix_cs *L; /* (cs_di *) or (cs_ci *) */ + Matrix_cs *U; /* (cs_di *) or (cs_ci *) */ + int *pinv; + double *B; +} Matrix_csn; + +typedef struct Matrix_cs_dmperm_results +{ + int *p; + int *q; + int *r; + int *s; + int nb; + int rr[5]; + int cc[5]; +} Matrix_csd; + +Matrix_cs *M2CXS(SEXP, int); +SEXP CXS2M(Matrix_cs *, int, char); + +/* Wrappers for the functions that we use at least once : */ + +Matrix_csd *Matrix_cs_dfree (Matrix_csd *); +Matrix_csd *Matrix_cs_dmperm (const Matrix_cs *, int); +int Matrix_cs_dropzeros (Matrix_cs *); +void *Matrix_cs_free (void *); +int Matrix_cs_happly (const Matrix_cs *, int, double, void *); +int Matrix_cs_ipvec (const int *, const void *, void *, int); +int Matrix_cs_lsolve (const Matrix_cs *, void *); +Matrix_csn *Matrix_cs_lu (const Matrix_cs *, const Matrix_css *, double); +int Matrix_cs_lusol (int, const Matrix_cs *, void *, double); +Matrix_csn *Matrix_cs_nfree (Matrix_csn *); +Matrix_cs *Matrix_cs_permute (const Matrix_cs *, const int *, const int *, int); +int *Matrix_cs_pinv (const int *, int); +int Matrix_cs_pvec (const int *, const void *, void *, int); +Matrix_csn *Matrix_cs_qr (const Matrix_cs *, const Matrix_css *); +int Matrix_cs_qrsol (int, const Matrix_cs *, void *); +Matrix_css *Matrix_cs_sfree (Matrix_css *); +Matrix_cs *Matrix_cs_spalloc (int, int, int, int, int); +Matrix_cs *Matrix_cs_speye (int, int, int, int); +Matrix_cs *Matrix_cs_spfree (Matrix_cs *); +int Matrix_cs_sprealloc (Matrix_cs *, int); +int Matrix_cs_spsolve (Matrix_cs *, const Matrix_cs *, int, int *, void *, const int *, int); +Matrix_css *Matrix_cs_sqr (int, const Matrix_cs *, int); +Matrix_cs *Matrix_cs_transpose (const Matrix_cs *, int); +int Matrix_cs_usolve (const Matrix_cs *, void *); + +#endif /* MATRIX_CS_ETC_H */ diff -Nru rmatrix-1.6-1.1/src/cs.c rmatrix-1.6-5/src/cs.c --- rmatrix-1.6-1.1/src/cs.c 2022-08-31 10:29:35.000000000 +0000 +++ rmatrix-1.6-5/src/cs.c 2023-10-11 01:54:13.000000000 +0000 @@ -551,7 +551,7 @@ 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) { @@ -761,7 +761,7 @@ 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) { @@ -1281,7 +1281,7 @@ { warning("Too many non-zeros in sparse product: Out of memory"); 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++) @@ -1381,7 +1381,7 @@ (double) n, (double) nzmax, (double) (Ap [n]), cs_norm (A)) ; for (j = 0 ; j < n ; j++) { - printf (" col %g : locations %g to %g\n", (double) j, + printf (" 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++) { diff -Nru rmatrix-1.6-1.1/src/cs_utils.c rmatrix-1.6-5/src/cs_utils.c --- rmatrix-1.6-1.1/src/cs_utils.c 2022-11-10 18:53:46.000000000 +0000 +++ rmatrix-1.6-5/src/cs_utils.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,327 +0,0 @@ -#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" - // 0 1 - , "ngCMatrix", "ntCMatrix" - // 2 3 - , ""}; - /* had also "dsCMatrix", but that only stores one triangle */ - int ctype = R_check_class_etc(x, valid); - if (ctype < 0) error(_("invalid class of 'x' in Matrix_as_cs(a, x)")); - // now, ctype >= 0 - Rboolean has_x = ctype < 2; - /* dimensions and nzmax */ - int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)); - ans->m = dims[0]; ans->n = dims[1]; - SEXP 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 = has_x ? REAL(GET_SLOT(x, Matrix_xSym)) : NULL; - - 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((size_t) n+1, sizeof(int)), - ( int *) tmp->p, n+1); - ans->i = Memcpy(( int *) R_alloc((size_t) nz, sizeof(int)), - ( int *) tmp->i, nz); - if(has_x) - ans->x = Memcpy((double *) R_alloc((size_t) 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 R_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_etc(obj, *) -SEXP Matrix_cs_to_SEXP(cs *a, char *cl, int dofree, SEXP dn) -{ - static const char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""}; - int ctype = strmatch(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) R_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) -{ - static const char *valid[] = {"css_LU", "css_QR", ""}; - int *nz = INTEGER(GET_SLOT(x, install("nz"))), - ctype = R_check_class_etc(x, 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 = R_check_class_etc(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 R_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 = strmatch(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) R_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 R_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 = strmatch(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) { - R_Free(N->L); R_Free(N->U); R_Free(N); - } - UNPROTECT(1); - return ans; -} - -#endif /* unused */ diff -Nru rmatrix-1.6-1.1/src/cs_utils.h rmatrix-1.6-5/src/cs_utils.h --- rmatrix-1.6-1.1/src/cs_utils.h 2015-05-19 16:34:46.000000000 +0000 +++ rmatrix-1.6-5/src/cs_utils.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -#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 diff -Nru rmatrix-1.6-1.1/src/dense.c rmatrix-1.6-5/src/dense.c --- rmatrix-1.6-1.1/src/dense.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/dense.c 2023-12-11 01:57:56.000000000 +0000 @@ -1,13 +1,19 @@ +#include "Mdefines.h" +#include "idz.h" #include "dense.h" -SEXP dense_band(SEXP from, const char *class, int a, int b, int new) +SEXP dense_band(SEXP from, const char *class, int a, int b) { + /* defined in ./coerce.c : */ + SEXP dense_as_general(SEXP, const char *, int); + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; UNPROTECT(1); /* dim */ /* Need tri[ul](<0-by-0>) and tri[ul](<1-by-1>) to be triangularMatrix */ - if (a <= 1-m && b >= n-1 && (class[1] == 't' || m != n || m > 1 || n > 1)) + if (a <= 1 - m && b >= n - 1 && + (class[1] == 't' || m != n || m > 1 || n > 1)) return from; int ge = 0, sy = 0, tr = 0; @@ -19,71 +25,62 @@ switch (class[0]) { \ case 'n': \ case 'l': \ - _DO_(int, LOGICAL, i); \ + _DO_(i, int, LOGICAL); \ break; \ case 'i': \ - _DO_(int, INTEGER, i); \ + _DO_(i, int, INTEGER); \ break; \ case 'd': \ - _DO_(double, REAL, d); \ + _DO_(d, double, REAL); \ break; \ case 'z': \ - _DO_(Rcomplex, COMPLEX, z); \ + _DO_(z, Rcomplex, COMPLEX); \ break; \ default: \ break; \ } \ } while (0) -#define IF_UNPACKED_ELSE(_IF_, _ELSE_) \ - do { \ - if (class[2] != 'p') \ - BAND_CASES(_IF_); \ - else \ - BAND_CASES(_ELSE_); \ - } while (0) - -#define UNPACKED_MAKE_BANDED(_CTYPE_, _PTR_, _PREFIX_) \ - _PREFIX_ ## dense_unpacked_make_banded(_PTR_(x1), m, n, a, b, di) +#define BAND2(_PREFIX_, _CTYPE_, _PTR_) \ + _PREFIX_ ## band2(_PTR_(x1), m, n, a, b, di) -#define PACKED_MAKE_BANDED(_CTYPE_, _PTR_, _PREFIX_) \ - _PREFIX_ ## dense_packed_make_banded(_PTR_(x1), n, a, b, ult, di) +#define BAND1(_PREFIX_, _CTYPE_, _PTR_) \ + _PREFIX_ ## band1(_PTR_(x1), n, a, b, ul1, di) -#define UNPACKED_COPY_DIAGONAL(_CTYPE_, _PTR_, _PREFIX_) \ +#define DCPY2(_PREFIX_, _CTYPE_, _PTR_) \ do { \ - Matrix_memset(_PTR_(x1), 0, len, sizeof(_CTYPE_)); \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ + Matrix_memset(px1, 0, XLENGTH(x1), sizeof(_CTYPE_)); \ if (a <= 0 && b >= 0) \ - _PREFIX_ ## dense_unpacked_copy_diagonal( \ - _PTR_(x1), _PTR_(x0), n, len, 'U', di); \ + _PREFIX_ ## dcpy2(px1, px0, n, XLENGTH(x1), 'U', di); \ } while (0) -#define PACKED_COPY_DIAGONAL(_CTYPE_, _PTR_, _PREFIX_)\ +#define DCPY1(_PREFIX_, _CTYPE_, _PTR_) \ do { \ - Matrix_memset(_PTR_(x1), 0, len, sizeof(_CTYPE_)); \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ + Matrix_memset(px1, 0, XLENGTH(x1), sizeof(_CTYPE_)); \ if (a <= 0 && b >= 0) \ - _PREFIX_ ## dense_packed_copy_diagonal( \ - _PTR_(x1), _PTR_(x0), n, len, ult, ulf, di); \ + _PREFIX_ ## dcpy1(px1, px0, n, XLENGTH(x1), ul1, ul0, di); \ } while (0) - char ulf = 'U', ult = 'U', di = 'N'; + char ul0 = 'U', ul1 = 'U', di = 'N'; if (class[1] != 'g') { if (ge) { - /* defined in ./coerce.c : */ - SEXP dense_as_general(SEXP, const char *, int); - SEXP to = PROTECT(dense_as_general(from, class, 1)), - x1 = PROTECT(GET_SLOT(to, Matrix_xSym)); - BAND_CASES(UNPACKED_MAKE_BANDED); - UNPROTECT(2); - return to; + PROTECT(from = dense_as_general(from, class, 1)); + SEXP x1 = PROTECT(GET_SLOT(from, Matrix_xSym)); + BAND_CASES(BAND2); + UNPROTECT(2); /* x1, from */ + return from; } SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - ulf = *CHAR(STRING_ELT(uplo, 0)); + ul0 = *CHAR(STRING_ELT(uplo, 0)); UNPROTECT(1); /* uplo */ if (class[1] == 't') { /* Be fast if band contains entire triangle */ - if ((ulf == 'U') ? (a <= 0 && b >= n-1) : (b >= 0 && a <= 1-m)) + if ((ul0 == 'U') + ? (a <= 0 && b >= n - 1) : (b >= 0 && a <= 1 - m)) return from; else if (a <= 0 && b >= 0) { SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); @@ -97,7 +94,7 @@ cl[0] = class[0]; cl[1] = (ge) ? 'g' : ((sy) ? 's' : 't') ; cl[2] = (ge) ? 'e' : ((class[2] != 'p') ? ((sy) ? 'y' : 'r') : 'p'); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); dim = GET_SLOT(to, Matrix_DimSym); pdim = INTEGER(dim); @@ -111,23 +108,25 @@ set_symmetrized_DimNames(to, dimnames, -1); UNPROTECT(1); /* dimnames */ + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1; + if (ge) { - SEXP x1 = PROTECT(GET_SLOT(from, Matrix_xSym)); - if (new) { - x1 = duplicate(x1); - UNPROTECT(1); - PROTECT(x1); + PROTECT(x1 = duplicate(x0)); + if (ATTRIB(x1) != R_NilValue) { + SET_ATTRIB(x1, R_NilValue); + if (OBJECT(x1)) + SET_OBJECT(x1, 0); } SET_SLOT(to, Matrix_xSym, x1); - BAND_CASES(UNPACKED_MAKE_BANDED); - UNPROTECT(2); /* x, to */ + BAND_CASES(BAND2); + UNPROTECT(3); /* x1, x0, to */ return to; } /* Returning .(sy|sp|tr|tp)Matrix ... */ - ult = (tr && class[1] != 't') ? ((a >= 0) ? 'U' : 'L') : ulf; - if (ult != 'U') { + ul1 = (tr && class[1] != 't') ? ((a >= 0) ? 'U' : 'L') : ul0; + if (ul1 != 'U') { SEXP uplo = PROTECT(mkString("L")); SET_SLOT(to, Matrix_uploSym, uplo); UNPROTECT(1); /* uplo */ @@ -138,673 +137,2003 @@ UNPROTECT(1); /* diag */ } - SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1; - if (tr && class[1] == 't') { - /* Result is either a diagonal matrix or a zero matrix */ - R_xlen_t len = XLENGTH(x0); - PROTECT(x1 = allocVector(TYPEOF(x0), len)); - IF_UNPACKED_ELSE(UNPACKED_COPY_DIAGONAL, PACKED_COPY_DIAGONAL); + if ((ul0 == 'U') ? (b <= 0) : (a >= 0)) { + /* Result is either a diagonal matrix or a zero matrix : */ + PROTECT(x1 = allocVector(TYPEOF(x0), XLENGTH(x0))); + if (class[2] != 'p') + BAND_CASES(DCPY2); + else + BAND_CASES(DCPY1); + } else { + PROTECT(x1 = duplicate(x0)); + if (class[2] != 'p') + BAND_CASES(BAND2); + else + BAND_CASES(BAND1); + } } else { - if (!new) - PROTECT(x1 = x0); - else if (sy || (tr && (class[1] == 'g' || ulf == ult || n <= 1))) + if (sy || (tr && (class[1] == 'g' || ul0 == ul1 || n <= 1))) { PROTECT(x1 = duplicate(x0)); - else if (class[2] != 'p') - /* band is "opposite" the stored triangle: */ - PROTECT(x1 = unpacked_force(x0, n, ulf, '\0')); + if (ATTRIB(x1) != R_NilValue) { + SET_ATTRIB(x1, R_NilValue); + if (OBJECT(x1)) + SET_OBJECT(x1, 0); + } + } else { + /* Band is "opposite" the stored triangle : */ + PROTECT(from = dense_transpose(from, class)); + x1 = GET_SLOT(from, Matrix_xSym); + UNPROTECT(1); + PROTECT(x1); + } + if (class[2] != 'p') + BAND_CASES(BAND2); else - /* band is "opposite" the stored triangle: */ - PROTECT(x1 = packed_transpose(x0, n, ulf)); - IF_UNPACKED_ELSE(UNPACKED_MAKE_BANDED, PACKED_MAKE_BANDED); + BAND_CASES(BAND1); } SET_SLOT(to, Matrix_xSym, x1); #undef BAND_CASES -#undef IF_UNPACKED_ELSE -#undef UNPACKED_MAKE_BANDED -#undef UNPACKED_COPY_DIAGONAL -#undef PACKED_MAKE_BANDED -#undef PACKED_COPY_DIAGONAL +#undef BAND2 +#undef BAND1 +#undef DCPY2 +#undef DCPY1 UNPROTECT(3); /* x1, x0, to */ return to; } /* band(, k1, k2), tri[ul](, k) */ -/* band( , k1, k2), tri[ul]( , k) */ /* NB: argument validation more or less copied by R_sparse_band() */ SEXP R_dense_band(SEXP from, SEXP k1, SEXP k2) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; - int ivalid = R_check_class_etc(from, valid), isS4 = ivalid >= 0; - if (!isS4) { + if (!IS_S4_OBJECT(from)) { /* defined in ./coerce.c : */ SEXP matrix_as_dense(SEXP, const char *, char, char, int, int); - from = matrix_as_dense(from, ".ge", '\0', '\0', 0, 1); + from = matrix_as_dense(from, ".ge", '\0', '\0', 0, 0); } PROTECT(from); - if (!isS4) - ivalid = R_check_class_etc(from, valid); + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; UNPROTECT(1); int a, b; - if (k1 == R_NilValue) - a = (m > 0) ? 1-m : 0; + if (k1 == R_NilValue) // tril() + a = -m ; // was (m > 0) ? 1 - m : 0; else if ((a = asInteger(k1)) == NA_INTEGER || a < -m || a > n) - error(_("'%s' must be an integer from %s to %s"), - "k1", "-Dim[1]", "Dim[2]"); - if (k2 == R_NilValue) - b = (n > 0) ? n-1 : 0; + error(_("'%s' (%d) must be an integer from %s (%d) to %s (%d)"), + "k1", a, "-Dim[1]", -m, "Dim[2]", n); + if (k2 == R_NilValue) // triu() + b = n; // was (n > 0) ? n - 1 : 0; else if ((b = asInteger(k2)) == NA_INTEGER || b < -m || b > n) - error(_("'%s' must be an integer from %s to %s"), - "k2", "-Dim[1]", "Dim[2]"); + error(_("'%s' (%d) must be an integer from %s (%d) to %s (%d)"), + "k2", b, "-Dim[1]", -m, "Dim[2]", n); else if (b < a) - error(_("'%s' must be less than or equal to '%s'"), - "k1", "k2"); + error(_("'%s' (%d) must be less than or equal to '%s' (%d)"), + "k1", a, "k2", b); - from = dense_band(from, valid[ivalid], a, b, isS4); + from = dense_band(from, valid[ivalid], a, b); UNPROTECT(1); return from; } -/* colSums() */ -SEXP R_dense_colSums(SEXP obj, SEXP narm, SEXP mean) +SEXP dense_diag_get(SEXP obj, const char *class, int names) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], r = (m < n) ? m : n, j; + UNPROTECT(1); /* dim */ + + char ul = 'U', di = 'N'; + if (class[1] != 'g') { + if (class[2] == 'p') { + SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); + ul = *CHAR(STRING_ELT(uplo, 0)); + UNPROTECT(1); /* uplo */ + } + if (class[1] == 't') { + SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); + di = *CHAR(STRING_ELT(diag, 0)); + UNPROTECT(1); /* diag */ + } + } + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + res = PROTECT(allocVector(TYPEOF(x), r)); + +#define DG_LOOP(_CTYPE_, _PTR_, _ONE_) \ + do { \ + _CTYPE_ *pres = _PTR_(res), *px = _PTR_(x); \ + if (di == 'U') \ + for (j = 0; j < r; ++j) \ + *(pres++) = _ONE_; \ + else if (class[2] != 'p') { \ + R_xlen_t m1a = (R_xlen_t) m + 1; \ + for (j = 0; j < r; ++j, px += m1a) \ + *(pres++) = *px; \ + } \ + else if (ul == 'U') \ + for (j = 0; j < n; px += (++j) + 1) \ + *(pres++) = *px; \ + else \ + for (j = 0; j < n; px += n - (j++)) \ + *(pres++) = *px; \ + } while (0) + + switch (class[0]) { + case 'n': + case 'l': + DG_LOOP(int, LOGICAL, 1); + break; + case 'i': + DG_LOOP(int, INTEGER, 1); + break; + case 'd': + DG_LOOP(double, REAL, 1.0); + break; + case 'z': + DG_LOOP(Rcomplex, COMPLEX, Matrix_zone); + break; + default: + break; + } + + if (names) { + /* NB: The logic here must be adjusted once the validity method + for 'symmetricMatrix' enforces symmetric 'Dimnames' + */ + SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), + rn = VECTOR_ELT(dn, 0), + cn = VECTOR_ELT(dn, 1); + if (cn == R_NilValue) { + if (class[1] == 's' && rn != R_NilValue) + setAttrib(res, R_NamesSymbol, rn); + } else { + if (class[1] == 's') + setAttrib(res, R_NamesSymbol, cn); + else if (rn != R_NilValue && + (rn == cn || equal_character_vectors(rn, cn, r))) + setAttrib(res, R_NamesSymbol, (r == m) ? rn : cn); + } + UNPROTECT(1); /* dn */ + } + +#undef DG_LOOP + + UNPROTECT(2); /* x, res */ + return res; +} + +SEXP R_dense_diag_get(SEXP obj, SEXP names) +{ + static const char *valid[] = { VALID_DENSE, "" }; int ivalid = R_check_class_etc(obj, valid); if (ivalid < 0) ERROR_INVALID_CLASS(obj, __func__); - const char *cl = valid[ivalid]; - if (cl[1] == 's') - return R_dense_rowSums(obj, narm, mean); - - int doNaRm = asLogical(narm) != 0, - doMean = asLogical(mean) != 0, - doCount = doNaRm && doMean; - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + int names_; + if (TYPEOF(names) != LGLSXP || LENGTH(names) < 1 || + (names_ = LOGICAL(names)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "names", "TRUE", "FALSE"); + + return dense_diag_get(obj, valid[ivalid], names_); +} + +SEXP dense_diag_set(SEXP from, const char *class, SEXP value, int new) +{ + SEXP to = PROTECT(newObject(class)); + int v = LENGTH(value) != 1; + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], r = (m < n) ? m : n, j; + if (m != n || n > 0) + SET_SLOT(to, Matrix_DimSym, dim); + UNPROTECT(1); /* dim */ + + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + UNPROTECT(1); /* dimnames */ + + char ul = 'U'; + if (class[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (ul != 'U') + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + + SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); + if (new) { + x = duplicate(x); + UNPROTECT(1); /* x */ + PROTECT(x); + } + SET_SLOT(to, Matrix_xSym, x); + +#define DS_LOOP(_CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *px = _PTR_(x), *pvalue = _PTR_(value); \ + if (class[2] != 'p') { \ + R_xlen_t m1a = (R_xlen_t) m + 1; \ + if (v) \ + for (j = 0; j < r; ++j, px += m1a) \ + *px = *(pvalue++); \ + else \ + for (j = 0; j < r; ++j, px += m1a) \ + *px = *pvalue; \ + } else if (ul == 'U') { \ + if (v) \ + for (j = 0; j < n; px += (++j) + 1) \ + *px = *(pvalue++); \ + else \ + for (j = 0; j < n; px += (++j) + 1) \ + *px = *pvalue; \ + } else { \ + if (v) \ + for (j = 0; j < n; px += n - (j++)) \ + *px = *(pvalue++); \ + else \ + for (j = 0; j < n; px += n - (j++)) \ + *px = *pvalue; \ + } \ + } while (0) + + switch (class[0]) { + case 'n': + case 'l': + DS_LOOP(int, LOGICAL); + break; + case 'i': + DS_LOOP(int, INTEGER); + break; + case 'd': + DS_LOOP(double, REAL); + break; + case 'z': + DS_LOOP(Rcomplex, COMPLEX); + break; + default: + break; + } + +#undef DS_LOOP + + UNPROTECT(2); /* x, to */ + return to; +} + +SEXP R_dense_diag_set(SEXP from, SEXP value) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + const char *class = valid[ivalid]; + + SEXPTYPE tx = kindToType(class[0]), tv = TYPEOF(value); + + switch (tv) { + case LGLSXP: + case INTSXP: + case REALSXP: + case CPLXSXP: + break; + default: + error(_("replacement diagonal has incompatible type \"%s\""), + type2char(tv)); + break; + } + + SEXP dim = GET_SLOT(from, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], r = (m < n) ? m : n; + R_xlen_t len = XLENGTH(value); + if (len != 1 && len != r) + error(_("replacement diagonal has wrong length")); + + int new = 1; + if (tv <= tx) { + PROTECT(from); + PROTECT(value = coerceVector(value, tx)); + } else { + /* defined in ./coerce.c : */ + SEXP dense_as_kind(SEXP, const char *, char, int); +#ifndef MATRIX_ENABLE_IMATRIX + if (tv == INTSXP) { + PROTECT(from = dense_as_kind(from, class, 'd', 0)); + PROTECT(value = coerceVector(value, REALSXP)); + } else { +#endif + PROTECT(from = dense_as_kind(from, class, typeToKind(tv), 0)); + PROTECT(value); +#ifndef MATRIX_ENABLE_IMATRIX + } +#endif + class = valid[R_check_class_etc(from, valid)]; + new = 0; + } + + from = dense_diag_set(from, class, value, new); + UNPROTECT(2); + return from; +} + +SEXP dense_transpose(SEXP from, const char *class) +{ + SEXP to = PROTECT(newObject(class)); + + int isCor = class[0] == 'c' || (class[0] == 'p' && class[1] == 'c'); + if (isCor) + class = (class[0] != 'p') ? "dsyMatrix" : "dspMatrix"; + else if (class[1] == 'p') + class = (class[2] != 'p') ? "dsyMatrix" : "dspMatrix"; + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], i, j; + if (m != n) { + UNPROTECT(1); /* dim */ + PROTECT(dim = GET_SLOT(to, Matrix_DimSym)); + pdim = INTEGER(dim); + pdim[0] = n; + pdim[1] = m; + } else if (n > 0) + SET_SLOT(to, Matrix_DimSym, dim); + UNPROTECT(1); /* dim */ + + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + if (class[1] == 's') + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + else + set_reversed_DimNames(to, dimnames); + UNPROTECT(1); /* dimnames */ + + char ul = 'U'; + if (class[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + ul = *CHAR(STRING_ELT(uplo, 0)); + UNPROTECT(1); /* uplo */ + if (ul == 'U') { + PROTECT(uplo = mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + if (class[1] == 't') { + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + char di = *CHAR(STRING_ELT(diag, 0)); + if (di != 'N') + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); /* diag */ + } else { + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); + if (LENGTH(factors) > 0) + SET_SLOT(to, Matrix_factorsSym, factors); + UNPROTECT(1); /* factors */ + + if (isCor && n > 0) { + SEXP sd = PROTECT(GET_SLOT(from, Matrix_sdSym)); + SET_SLOT(to, Matrix_sdSym, sd); + UNPROTECT(1); /* sd */ + } + } + } + + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), + x1 = PROTECT(allocVector(TYPEOF(x0), XLENGTH(x0))); + SET_SLOT(to, Matrix_xSym, x1); + +#define TRANS_LOOP(_CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ + if (class[2] != 'p') { \ + R_xlen_t mn1s = XLENGTH(x0) - 1; \ + for (j = 0; j < m; ++j, px0 -= mn1s) \ + for (i = 0; i < n; ++i, px0 += m) \ + *(px1++) = *px0; \ + } else if (ul == 'U') { \ + for (j = 0; j < n; ++j) \ + for (i = j; i < n; ++i) \ + *(px1++) = *(px0 + PACKED_AR21_UP(j, i)); \ + } else { \ + R_xlen_t n2 = (R_xlen_t) n * 2; \ + for (j = 0; j < n; ++j) \ + for (i = 0; i <= j; ++i) \ + *(px1++) = *(px0 + PACKED_AR21_LO(j, i, n2)); \ + } \ + } while (0) + + switch (class[0]) { + case 'n': + case 'l': + TRANS_LOOP(int, LOGICAL); + break; + case 'i': + TRANS_LOOP(int, INTEGER); + break; + case 'd': + TRANS_LOOP(double, REAL); + break; + case 'z': + TRANS_LOOP(Rcomplex, COMPLEX); + break; + default: + break; + } + +#undef TRANS_LOOP + + UNPROTECT(3); /* x1, x0, to */ + return to; +} + +SEXP R_dense_transpose(SEXP from) +{ + static const char *valid[] = { + "corMatrix", "pcorMatrix", "dpoMatrix", "dppMatrix", + VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + return dense_transpose(from, valid[ivalid]); +} + +SEXP dense_force_symmetric(SEXP from, const char *class, char ul) +{ + char ul0 = 'U', ul1 = 'U', di = 'N'; + if (class[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + ul0 = ul1 = *CHAR(STRING_ELT(uplo, 0)); + UNPROTECT(1); /* uplo */ + if (class[1] == 't') { + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + di = *CHAR(STRING_ELT(diag, 0)); + UNPROTECT(1); /* diag */ + } + } + + if (ul != '\0') + ul1 = ul; + + if (class[1] == 's') { + /* .s[yp]Matrix */ + if (ul0 == ul1) + return from; + SEXP to = PROTECT(dense_transpose(from, class)); + if (class[0] == 'z') { + /* Need _conjugate_ transpose */ + SEXP x1 = PROTECT(GET_SLOT(to, Matrix_xSym)); + conjugate(x1); + UNPROTECT(1); /* x1 */ + } + UNPROTECT(1) /* to */; + return to; + } + + /* Now handling just .(ge|tr|tp)Matrix ... */ + + char cl[] = ".s.Matrix"; + cl[0] = class[0]; + cl[2] = (class[2] != 'p') ? 'y' : 'p'; + SEXP to = PROTECT(newObject(cl)); + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + error(_("attempt to symmetrize a non-square matrix")); + if (n > 0) + SET_SLOT(to, Matrix_DimSym, dim); + UNPROTECT(1); /* dim */ + + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + set_symmetrized_DimNames(to, dimnames, -1); + UNPROTECT(1); /* dimnames */ + + if (ul1 != 'U') { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)); + + if (class[1] == 'g' || ul0 == ul1) + SET_SLOT(to, Matrix_xSym, x0); + else { + SEXP x1 = PROTECT(allocVector(TYPEOF(x0), XLENGTH(x0))); + SET_SLOT(to, Matrix_xSym, x1); + + R_xlen_t len = XLENGTH(x1); + +#define DCPY(_PREFIX_, _CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ + Matrix_memset(px1, 0, len, sizeof(_CTYPE_)); \ + if (class[2] != 'p') \ + _PREFIX_ ## dcpy2(px1, px0, n, len, '\0', di); \ + else \ + _PREFIX_ ## dcpy1(px1, px0, n, len, ul1, ul0, di); \ + } while (0) + + switch (class[0]) { + case 'n': + case 'l': + DCPY(i, int, LOGICAL); + break; + case 'i': + DCPY(i, int, INTEGER); + break; + case 'd': + DCPY(d, double, REAL); + break; + case 'z': + DCPY(z, Rcomplex, COMPLEX); + break; + default: + break; + } + +#undef DCPY + + UNPROTECT(1); /* x1 */ + } + + UNPROTECT(2); /* x0, to */ + return to; +} + +SEXP R_dense_force_symmetric(SEXP from, SEXP uplo) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + char ul = '\0'; + if (uplo != R_NilValue) { + if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || + (uplo = STRING_ELT(uplo, 0)) == NA_STRING || + ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) + error(_("invalid '%s' to '%s'"), "uplo", __func__); + } + + return dense_force_symmetric(from, valid[ivalid], ul); +} + +SEXP dense_symmpart(SEXP from, const char *class) +{ + if (class[0] != 'z' && class[0] != 'd') { + /* defined in ./coerce.c : */ + SEXP dense_as_kind(SEXP, const char *, char, int); + from = dense_as_kind(from, class, 'd', 0); + } + if (class[0] != 'z' && class[1] == 's') + return from; + PROTECT(from); + + char cl[] = ".s.Matrix"; + cl[0] = (class[0] != 'z') ? 'd' : 'z'; + cl[2] = (class[2] != 'p') ? 'y' : 'p'; + SEXP to = PROTECT(newObject(cl)); + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + error(_("attempt to get symmetric part of non-square matrix")); + if (n > 0) + SET_SLOT(to, Matrix_DimSym, dim); UNPROTECT(1); /* dim */ + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + if (class[1] == 's') + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + else + set_symmetrized_DimNames(to, dimnames, -1); + UNPROTECT(1); /* dimnames */ + char ul = 'U', di = 'N'; - if (cl[1] == 't') { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); + if (class[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); ul = *CHAR(STRING_ELT(uplo, 0)); + if (ul != 'U') + SET_SLOT(to, Matrix_uploSym, uplo); UNPROTECT(1); /* uplo */ + if (class[1] == 't') { + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + di = *CHAR(STRING_ELT(diag, 0)); + UNPROTECT(1); /* diag */ + } + } - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ + SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); + if (class[0] == 'z' || class[0] == 'd') { + x = duplicate(x); + UNPROTECT(1); /* x */ + PROTECT(x); } + SET_SLOT(to, Matrix_xSym, x); - SEXP res = PROTECT(allocVector((cl[0] != 'z') ? REALSXP : CPLXSXP, n)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int i, j, count = m; + if (class[1] == 's') { + /* Symmetric part of Hermitian matrix is real part */ + zeroIm(x); + UNPROTECT(3); /* x, to, from */ + return to; + } -#define DENSE_COLSUMS_LOOP \ + int i, j; + +#define SP_LOOP(_CTYPE_, _PTR_, _INCREMENT_, _SCALE1_, _ONE_) \ do { \ - if (cl[1] == 'g') { /* general */ \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ZERO); \ - for (i = 0; i < m; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ - } \ - } else if (cl[2] != 'p') { \ - if (ul == 'U') { /* unpacked upper triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ZERO); \ - for (i = 0; i <= j; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ - px += n-j-1; \ - } \ - } else { \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ONE); \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ - px += n-j; \ - } \ - } \ - } else { /* unpacked lower triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j, ++pres) { \ - px += j; \ - DO_INIT(ZERO); \ - for (i = j; i < n; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ + _CTYPE_ *px = _PTR_(x); \ + if (class[1] == 'g') { \ + _CTYPE_ *py = px; \ + for (j = 0; j < n; ++j) { \ + for (i = j + 1; i < n; ++i) { \ + px += n; \ + py += 1; \ + _INCREMENT_((*px), (*py)); \ + _SCALE1_((*px), 0.5); \ + } \ + px = (py += j + 2); \ + } \ + } else if (class[2] != 'p') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < j; ++i) { \ + _SCALE1_((*px), 0.5); \ + px += 1; \ } \ - } else { \ - for (i = j = 0; j < n; ++j, i = j, ++pres) { \ - px += j+1; \ - DO_INIT(ONE); \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ + px += n - j; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + px += j + 1; \ + for (i = j + 1; i < n; ++i) { \ + _SCALE1_((*px), 0.5); \ + px += 1; \ } \ } \ } \ + if (di != 'N') { \ + R_xlen_t n1a = (R_xlen_t) n + 1; \ + px = _PTR_(x); \ + for (j = 0; j < n; ++j, px += n1a) \ + *px = _ONE_; \ + } \ } else { \ - if (ul == 'U') { /* packed upper triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ZERO); \ - for (i = 0; i <= j; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < j; ++i) { \ + _SCALE1_((*px), 0.5); \ + px += 1; \ + } \ + px += 1; \ + } \ + if (di != 'N') { \ + px = _PTR_(x); \ + for (j = 0; j < n; px += (++j) + 1) \ + *px = _ONE_; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + px += 1; \ + for (i = j + 1; i < n; ++i) { \ + _SCALE1_((*px), 0.5); \ + px += 1; \ + } \ + } \ + if (di != 'N') { \ + px = _PTR_(x); \ + for (j = 0; j < n; px += n - (j++)) \ + *px = _ONE_; \ + } \ + } \ + } \ + } while (0) + + if (cl[0] == 'd') + SP_LOOP(double, REAL, INCREMENT_REAL, SCALE1_REAL, 1.0); + else + SP_LOOP(Rcomplex, COMPLEX, INCREMENT_COMPLEX, SCALE1_COMPLEX, Matrix_zone); + +#undef SP_LOOP + + UNPROTECT(3); /* x, to, from */ + return to; +} + +SEXP R_dense_symmpart(SEXP from) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + return dense_symmpart(from, valid[ivalid]); +} + +SEXP dense_skewpart(SEXP from, const char *class) +{ + if (class[0] != 'z' && class[0] != 'd') { + /* defined in ./coerce.c : */ + SEXP dense_as_kind(SEXP, const char *, char, int); + from = dense_as_kind(from, class, 'd', 0); + } + PROTECT(from); + + char cl[] = "...Matrix"; + cl[0] = (class[0] != 'z') ? 'd' : 'z'; + cl[1] = (class[1] != 's') ? 'g' : 's'; + cl[2] = (class[1] != 's') ? 'e' : + ((class[0] != 'z') ? 'C' : ((class[2] != 'p') ? 'y' : 'p')); + SEXP to = PROTECT(newObject(cl)); + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + error(_("attempt to get skew-symmetric part of non-square matrix")); + if (n > 0) + SET_SLOT(to, Matrix_DimSym, dim); + UNPROTECT(1); /* dim */ + + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + if (class[1] == 's') + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + else + set_symmetrized_DimNames(to, dimnames, -1); + UNPROTECT(1); /* dimnames */ + + char ul = 'U'; + if (class[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (class[1] == 's' && ul != 'U') + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + + if (class[1] == 's' && class[0] != 'z') { + /* Skew-symmetric part of Hermitian matrix is imaginary part */ + SEXP p = PROTECT(allocVector(INTSXP, (R_xlen_t) n + 1)); + int *pp = INTEGER(p); + Matrix_memset(pp, 0, (R_xlen_t) n + 1, sizeof(int)); + SET_SLOT(to, Matrix_pSym, p); + UNPROTECT(3); /* p, to, from */ + return to; + } + + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = x0; + + if (class[1] == 's') { + /* Skew-symmetric part of Hermitian matrix is imaginary part */ + x1 = duplicate(x1); + UNPROTECT(1); /* x1 */ + PROTECT(x1); + SET_SLOT(to, Matrix_xSym, x1); + zeroRe(x1); + UNPROTECT(3); /* x1, to, from */ + return to; + } + + if (class[2] == 'p' || class[0] == 'z' || class[0] == 'd') { + if ((Matrix_int_fast64_t) n * n > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + x1 = allocVector(TYPEOF(x0), (R_xlen_t) n * n); + } + PROTECT(x1); + SET_SLOT(to, Matrix_xSym, x1); + + int i, j; + R_xlen_t upos = 0, lpos = 0; + +#define SP_LOOP(_CTYPE_, _PTR_, _INCREMENT_, _ASSIGN_, _ZERO_) \ + do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ + if (class[1] == 'g') { \ + for (j = 0; j < n; ++j) { \ + lpos = j; \ + for (i = 0; i < j; ++i) { \ + _ASSIGN_(px1[upos], 0.5 * px0[upos]); \ + _INCREMENT_(px1[upos], -0.5 * px0[lpos]); \ + _ASSIGN_(px1[lpos], -px1[upos]); \ + upos += 1; \ + lpos += n; \ + } \ + px1[upos] = _ZERO_; \ + upos += n - j; \ + } \ + } else if (class[2] != 'p') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + lpos = j; \ + for (i = 0; i < j; ++i) { \ + _ASSIGN_(px1[upos], 0.5 * px0[upos]); \ + _ASSIGN_(px1[lpos], -px1[upos]); \ + upos += 1; \ + lpos += n; \ } \ - } else { \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ONE); \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ - ++px; \ + px1[upos] = _ZERO_; \ + upos += n - j; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + upos = lpos; \ + px1[lpos] = _ZERO_; \ + for (i = j + 1; i < n; ++i) { \ + upos += n; \ + lpos += 1; \ + _ASSIGN_(px1[lpos], 0.5 * px0[lpos]); \ + _ASSIGN_(px1[upos], -px1[lpos]); \ } \ + lpos += j + 2; \ } \ - } else { /* packed lower triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j, ++pres) { \ - DO_INIT(ZERO); \ - for (i = j; i < n; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ + } \ + } else { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j, ++px0) { \ + lpos = j; \ + for (i = 0; i < j; ++i, ++px0) { \ + _ASSIGN_(px1[upos], 0.5 * (*px0)); \ + _ASSIGN_(px1[lpos], -px1[upos]); \ + upos += 1; \ + lpos += n; \ } \ - } else { \ - for (i = j = 0; j < n; ++j, i = j, ++pres) { \ - ++px; \ - DO_INIT(ONE); \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR; \ - DO_SCALE; \ + px1[upos] = _ZERO_; \ + upos += n - j; \ + } \ + } else { \ + for (j = 0; j < n; ++j, ++px0) { \ + upos = lpos; \ + px1[lpos] = _ZERO_; \ + for (i = j + 1; i < n; ++i, ++px0) { \ + upos += n; \ + lpos += 1; \ + _ASSIGN_(px1[lpos], 0.5 * (*px0)); \ + _ASSIGN_(px1[upos], -px1[lpos]); \ } \ + lpos += j + 2; \ } \ } \ } \ } while (0) -#define DENSE_COLSUMS(_CTYPE1_, _PTR1_, _CTYPE2_, _PTR2_) \ + if (cl[0] == 'd') + SP_LOOP(double, REAL, INCREMENT_REAL, ASSIGN_REAL, 0.0); + else + SP_LOOP(Rcomplex, COMPLEX, INCREMENT_COMPLEX, ASSIGN_COMPLEX, Matrix_zzero); + +#undef SP_LOOP + + UNPROTECT(4); /* x1, x0, to, from */ + return to; +} + +SEXP R_dense_skewpart(SEXP from) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + return dense_skewpart(from, valid[ivalid]); +} + +int dense_is_symmetric(SEXP obj, const char *class, int checkDN) +{ + if (class[1] == 's') + return 1; + + if (checkDN) { + SEXP dimnames = GET_SLOT(obj, Matrix_DimNamesSym); + if (!DimNames_is_symmetric(dimnames)) + return 0; + } + + if (class[1] == 't') + return dense_is_diagonal(obj, class); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return 1; + + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j; + +#define IS_LOOP(_CTYPE_, _PTR_, _NOTREAL_, _NOTCONJ_) \ do { \ - _CTYPE1_ *pres = _PTR1_(res); \ - _CTYPE2_ *px = _PTR2_(x); \ - DENSE_COLSUMS_LOOP; \ + _CTYPE_ *px = _PTR_(x), *py = px; \ + for (j = 0; j < n; px = (py += (++j) + 1)) { \ + if (_NOTREAL_((*px))) \ + return 0; \ + for (i = j + 1; i < n; ++i) { \ + px += n; \ + py += 1; \ + if (_NOTCONJ_((*px), (*py))) \ + return 0; \ + } \ + } \ + return 1; \ } while (0) - switch (cl[0]) { + switch (class[0]) { case 'n': + IS_LOOP(int, LOGICAL, NOTREAL_PATTERN, NOTCONJ_PATTERN); + break; + case 'l': + IS_LOOP(int, LOGICAL, NOTREAL_LOGICAL, NOTCONJ_LOGICAL); + break; + case 'i': + IS_LOOP(int, INTEGER, NOTREAL_INTEGER, NOTCONJ_INTEGER); + break; + case 'd': + IS_LOOP(double, REAL, NOTREAL_REAL, NOTCONJ_REAL); + break; + case 'z': + IS_LOOP(Rcomplex, COMPLEX, NOTREAL_COMPLEX, NOTCONJ_COMPLEX); + break; + default: + break; + } -#define ZERO 0.0 -#define ONE 1.0 -#define DO_INIT(_U_) *pres = _U_ -#define DO_INCR if (*px) *pres += 1.0 -#define DO_SCALE if (doMean) *pres /= count +#undef IS_LOOP - DENSE_COLSUMS(double, REAL, int, LOGICAL); - break; + return 0; +} -#undef DO_INIT -#undef DO_INCR +SEXP R_dense_is_symmetric(SEXP obj, SEXP checkDN) +{ + if (!IS_S4_OBJECT(obj)) { + /* defined in ./coerce.c : */ + SEXP matrix_as_dense(SEXP, const char *, char, char, int, int); + obj = matrix_as_dense(obj, ".ge", '\0', '\0', 0, 0); + } + PROTECT(obj); + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); - case 'l': + int checkDN_; + if (TYPEOF(checkDN) != LGLSXP || LENGTH(checkDN) < 1 || + (checkDN_ = LOGICAL(checkDN)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "checkDN", "TRUE", "FALSE"); -#define DO_INIT(_U_) \ - do { \ - *pres = _U_; \ - if (doCount) \ - count = m; \ - } while (0) -#define DO_INCR \ - do { \ - if (*px != NA_LOGICAL) { \ - if (*px) *pres += 1.0; \ - } else if (!doNaRm) \ - *pres = NA_REAL; \ - else if (doMean) \ - --count; \ - } while (0) + SEXP ans = ScalarLogical(dense_is_symmetric(obj, valid[ivalid], checkDN_)); + UNPROTECT(1); + return ans; +} - DENSE_COLSUMS(double, REAL, int, LOGICAL); - break; +int dense_is_triangular(SEXP obj, const char *class, int upper) +{ + if (class[1] == 't') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + if (upper == NA_LOGICAL || (upper != 0) == (ul == 'U')) + return (ul == 'U') ? 1 : -1; + else if (dense_is_diagonal(obj, class)) + return (ul == 'U') ? -1 : 1; + else + return 0; + } -#undef DO_INCR + if (class[1] == 's') { + if (!dense_is_diagonal(obj, class)) + return 0; + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + if (upper == NA_LOGICAL) + return (ul == 'U') ? 1 : -1; + else + return (upper != 0) ? 1 : -1; + } - case 'i': + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return (upper != 0) ? 1 : -1; -#define DO_INCR \ - do { \ - if (*px != NA_INTEGER) \ - *pres += *px; \ - else if (!doNaRm) \ - *pres = NA_REAL; \ - else if (doMean) \ - --count; \ - } while (0) + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j; + +#define IT_LOOP(_CTYPE_, _PTR_, _ISNZ_) \ + do { \ + _CTYPE_ *px; \ + if (upper == NA_LOGICAL) { \ + px = _PTR_(x); \ + for (j = 0; j < n; px += (++j)) { \ + px += 1; \ + for (i = j + 1; i < n; ++i, px += 1) { \ + if (_ISNZ_(*px)) { \ + j = n; \ + break; \ + } \ + } \ + } \ + if (j == n) \ + return 1; \ + px = _PTR_(x); \ + for (j = 0; j < n; px += n - (++j)) { \ + for (i = 0; i < j; ++i, px += 1) { \ + if (_ISNZ_(*px)) { \ + j = n; \ + break; \ + } \ + } \ + px += 1; \ + } \ + if (j == n) \ + return -1; \ + return 0; \ + } else if (upper != 0) { \ + px = _PTR_(x); \ + for (j = 0; j < n; px += (++j)) { \ + px += 1; \ + for (i = j + 1; i < n; ++i, px += 1) \ + if (_ISNZ_(*px)) \ + return 0; \ + } \ + return 1; \ + } else { \ + px = _PTR_(x); \ + for (j = 0; j < n; px += n - (++j)) { \ + for (i = 0; i < j; ++i, px += 1) \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + return -1; \ + } \ + } while (0) - DENSE_COLSUMS(double, REAL, int, INTEGER); + switch (class[0]) { + case 'n': + IT_LOOP(int, LOGICAL, ISNZ_PATTERN); + break; + case 'l': + IT_LOOP(int, LOGICAL, ISNZ_LOGICAL); + break; + case 'i': + IT_LOOP(int, INTEGER, ISNZ_INTEGER); + break; + case 'd': + IT_LOOP(double, REAL, ISNZ_REAL); + break; + case 'z': + IT_LOOP(Rcomplex, COMPLEX, ISNZ_COMPLEX); + break; + default: break; + } -#undef DO_INCR +#undef IT_LOOP - case 'd': + return 0; +} -#define DO_INCR \ - do { \ - if (!(doNaRm && ISNAN(*px))) \ - *pres += *px; \ - else if (doMean) \ - --count; \ - } while (0) +SEXP R_dense_is_triangular(SEXP obj, SEXP upper) +{ + if (!IS_S4_OBJECT(obj)) { + /* defined in ./coerce.c : */ + SEXP matrix_as_dense(SEXP, const char *, char, char, int, int); + obj = matrix_as_dense(obj, ".ge", '\0', '\0', 0, 0); + } + PROTECT(obj); + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); - DENSE_COLSUMS(double, REAL, double, REAL); - break; + if (TYPEOF(upper) != LGLSXP || LENGTH(upper) < 1) + error(_("'%s' must be %s or %s or %s"), "upper", "TRUE", "FALSE", "NA"); + int upper_ = LOGICAL(upper)[0]; + + int ans_ = dense_is_triangular(obj, valid[ivalid], upper_); + SEXP ans = allocVector(LGLSXP, 1); + LOGICAL(ans)[0] = ans_ != 0; + if (upper_ == NA_LOGICAL && ans_ != 0) { + PROTECT(ans); + static + SEXP kindSym = NULL; + SEXP kindVal = PROTECT(mkString((ans_ > 0) ? "U" : "L")); + if (!kindSym) kindSym = install("kind"); + setAttrib(ans, kindSym, kindVal); + UNPROTECT(2); + } + UNPROTECT(1); + return ans; +} -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_SCALE +int dense_is_diagonal(SEXP obj, const char *class) +{ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return 1; - case 'z': + char ul = 'U'; + if (class[1] != 'g') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + ul = *CHAR(STRING_ELT(uplo, 0)); + } -#define ZERO Matrix_zzero -#define ONE Matrix_zone -#define DO_INCR \ - do { \ - if (!(doNaRm && (ISNAN((*px).r) || ISNAN((*px).i)))) { \ - (*pres).r += (*px).r; \ - (*pres).i += (*px).i; \ - } else if (doMean) \ - --count; \ - } while (0) -#define DO_SCALE \ - do { \ - if (doMean) { \ - (*pres).r /= count; \ - (*pres).i /= count; \ + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j; + +#define ID_LOOP(_CTYPE_, _PTR_, _ISNZ_) \ + do { \ + _CTYPE_ *px = _PTR_(x); \ + if (class[1] == 'g') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < j; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + px += 1; \ + for (i = j + 1; i < n; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ } \ - } while (0) + } else if (class[2] != 'p') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < j; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + px += n - j; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + px += j + 1; \ + for (i = j + 1; i < n; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + } \ + } \ + } else { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < j; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + px += 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + px += 1; \ + for (i = j + 1; i < n; ++i) { \ + if (_ISNZ_(*px)) \ + return 0; \ + px += 1; \ + } \ + } \ + } \ + } \ + return 1; \ + } while (0) - DENSE_COLSUMS(Rcomplex, COMPLEX, Rcomplex, COMPLEX); + switch (class[0]) { + case 'n': + ID_LOOP(int, LOGICAL, ISNZ_PATTERN); + break; + case 'l': + ID_LOOP(int, LOGICAL, ISNZ_LOGICAL); + break; + case 'i': + ID_LOOP(int, INTEGER, ISNZ_INTEGER); + break; + case 'd': + ID_LOOP(double, REAL, ISNZ_REAL); + break; + case 'z': + ID_LOOP(Rcomplex, COMPLEX, ISNZ_COMPLEX); break; - -#undef ZERO -#undef ONE -#undef DO_INIT -#undef DO_INCR -#undef DO_SCALE - default: break; } -#undef DENSE_COLSUMS -#undef DENSE_COLSUMS_LOOP +#undef ID_LOOP + + return 0; +} + +SEXP R_dense_is_diagonal(SEXP obj) +{ + if (!IS_S4_OBJECT(obj)) { + /* defined in ./coerce.c : */ + SEXP matrix_as_dense(SEXP, const char *, char, char, int, int); + obj = matrix_as_dense(obj, ".ge", '\0', '\0', 0, 0); + } + PROTECT(obj); + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); + + SEXP ans = ScalarLogical(dense_is_diagonal(obj, valid[ivalid])); + UNPROTECT(1); + return ans; +} + +#define CAST_PATTERN(_X_) (_X_ != 0) +#define CAST_LOGICAL(_X_) (_X_ != 0) +#define CAST_INTEGER(_X_) _X_ +#define CAST_REAL(_X_) _X_ +#define CAST_COMPLEX(_X_) _X_ + +#define SUM_CASES \ +do { \ + switch (class[0]) { \ + case 'n': \ + if (mean) \ + SUM_LOOP(int, LOGICAL, double, REAL, \ + 0.0, 1.0, NA_REAL, ISNA_PATTERN, \ + CAST_PATTERN, INCREMENT_REAL, SCALE2_REAL); \ + else \ + SUM_LOOP(int, LOGICAL, int, INTEGER, \ + 0, 1, NA_INTEGER, ISNA_PATTERN, \ + CAST_PATTERN, INCREMENT_INTEGER, SCALE2_REAL); \ + break; \ + case 'l': \ + if (mean) \ + SUM_LOOP(int, LOGICAL, double, REAL, \ + 0.0, 1.0, NA_REAL, ISNA_LOGICAL, \ + CAST_LOGICAL, INCREMENT_REAL, SCALE2_REAL); \ + else \ + SUM_LOOP(int, LOGICAL, int, INTEGER, \ + 0, 1, NA_INTEGER, ISNA_LOGICAL, \ + CAST_LOGICAL, INCREMENT_INTEGER, SCALE2_REAL); \ + break; \ + case 'i': \ + SUM_LOOP(int, INTEGER, double, REAL, \ + 0.0, 1.0, NA_REAL, ISNA_INTEGER, \ + CAST_INTEGER, INCREMENT_REAL, SCALE2_REAL); \ + break; \ + case 'd': \ + SUM_LOOP(double, REAL, double, REAL, \ + 0.0, 1.0, NA_REAL, ISNA_REAL, \ + CAST_REAL, INCREMENT_REAL, SCALE2_REAL); \ + break; \ + case 'z': \ + SUM_LOOP(Rcomplex, COMPLEX, Rcomplex, COMPLEX, \ + Matrix_zzero, Matrix_zone, Matrix_zna, ISNA_COMPLEX, \ + CAST_COMPLEX, INCREMENT_COMPLEX, SCALE2_COMPLEX); \ + break; \ + default: \ + break; \ + } \ +} while (0) + +#define SUM_TYPEOF(c) (c == 'z') ? CPLXSXP : ((mean || c == 'd' || c == 'i') ? REALSXP : INTSXP) + +static +void dense_colsum(SEXP x, const char *class, + int m, int n, char ul, char di, int narm, int mean, + SEXP res) +{ + int i, j, count = -1, narm_ = narm && mean && class[0] != 'n', + unpacked = class[2] != 'p'; + +#define SUM_LOOP(_CTYPE0_, _PTR0_, _CTYPE1_, _PTR1_, \ + _ZERO_, _ONE_, _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + _CTYPE0_ *px0 = _PTR0_( x); \ + _CTYPE1_ *px1 = _PTR1_(res), tmp; \ + if (class[1] == 'g') { \ + for (j = 0; j < n; ++j) { \ + *px1 = _ZERO_; \ + SUM_KERNEL(for (i = 0; i < m; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_); \ + px1 += 1; \ + } \ + } else if (di == 'N') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + *px1 = _ZERO_; \ + SUM_KERNEL(for (i = 0; i <= j; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_); \ + if (unpacked) \ + px0 += n - j - 1; \ + px1 += 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px0 += j; \ + *px1 = _ZERO_; \ + SUM_KERNEL(for (i = j; i < n; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_); \ + px1 += 1; \ + } \ + } \ + } else { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + *px1 = _ONE_; \ + SUM_KERNEL(for (i = 0; i < j; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_); \ + ++px0; \ + if (unpacked) \ + px0 += n - j - 1; \ + px1 += 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px0 += j; \ + ++px0; \ + *px1 = _ONE_; \ + SUM_KERNEL(for (i = j + 1; i < n; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_); \ + px1 += 1; \ + } \ + } \ + } \ + } while (0) + +#define SUM_KERNEL(_FOR_, _NA_, _ISNA_, _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + if (mean) \ + count = m; \ + _FOR_ { \ + if (_ISNA_(*px0)) { \ + if (!narm) \ + *px1 = _NA_; \ + else if (narm_) \ + --count; \ + } else { \ + tmp = _CAST_(*px0); \ + _INCREMENT_((*px1), tmp); \ + } \ + ++px0; \ + } \ + if (mean) \ + _SCALE2_((*px1), count); \ + } while (0) + + SUM_CASES; + +#undef SUM_LOOP +#undef SUM_KERNEL + + return; +} + +static +void dense_rowsum(SEXP x, const char *class, + int m, int n, char ul, char di, int narm, int mean, + SEXP res) +{ + int i, j, *count = NULL, narm_ = narm && mean && class[0] != 'n', + unpacked = class[2] != 'p', symmetric = class[1] == 's'; + if (narm_) { + Matrix_Calloc(count, m, int); + for (i = 0; i < m; ++i) + count[i] = n; + } + +#define SUM_LOOP(_CTYPE0_, _PTR0_, _CTYPE1_, _PTR1_, \ + _ZERO_, _ONE_, _NA_, _ISNA_, \ + _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + _CTYPE0_ *px0 = _PTR0_( x); \ + _CTYPE1_ *px1 = _PTR1_(res), tmp = (di == 'N') ? _ZERO_ : _ONE_; \ + for (i = 0; i < m; ++i) \ + px1[i] = tmp; \ + if (class[1] == 'g') { \ + for (j = 0; j < n; ++j) \ + SUM_KERNEL(for (i = 0; i < m; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_); \ + } else if (class[1] == 's' || di == 'N') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + SUM_KERNEL(for (i = 0; i <= j; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_); \ + if (unpacked) \ + px0 += n - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px0 += j; \ + SUM_KERNEL(for (i = j; i < n; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_); \ + } \ + } \ + } else { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + SUM_KERNEL(for (i = 0; i < j; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_); \ + ++px0; \ + if (unpacked) \ + px0 += n - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px0 += j; \ + ++px0; \ + SUM_KERNEL(for (i = j + 1; i < n; ++i), _NA_, _ISNA_, \ + _CAST_, _INCREMENT_); \ + } \ + } \ + } \ + if (mean) { \ + if (narm_) \ + for (i = 0; i < m; ++i) \ + _SCALE2_(px1[i], count[i]); \ + else \ + for (i = 0; i < m; ++i) \ + _SCALE2_(px1[i], n); \ + } \ + } while (0) + +#define SUM_KERNEL(_FOR_, _NA_, _ISNA_, _CAST_, _INCREMENT_) \ + do { \ + _FOR_ { \ + int again = symmetric && i != j; \ + if (_ISNA_(*px0)) { \ + if (!narm) { \ + px1[i] = _NA_; \ + if (again) \ + px1[j] = _NA_; \ + } else if (narm_) { \ + --count[i]; \ + if (again) \ + --count[j]; \ + } \ + } else { \ + tmp = _CAST_(*px0); \ + _INCREMENT_(px1[i], tmp); \ + if (again) \ + _INCREMENT_(px1[j], tmp); \ + } \ + ++px0; \ + } \ + } while (0) + + SUM_CASES; + +#undef SUM_LOOP +#undef SUM_KERNEL + + if (narm_) + Matrix_Free(count, m); + return; +} + +SEXP dense_marginsum(SEXP obj, const char *class, int margin, + int narm, int mean) +{ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], + r = (margin == 0) ? m : n; + + SEXP res = PROTECT(allocVector(SUM_TYPEOF(class[0]), r)), + x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + + SEXP dimnames = (class[1] != 's') + ? GET_SLOT(obj, Matrix_DimNamesSym) + : get_symmetrized_DimNames(obj, -1), + marnames = VECTOR_ELT(dimnames, margin); + if (marnames != R_NilValue) { + PROTECT(marnames); + setAttrib(res, R_NamesSymbol, marnames); + UNPROTECT(1); /* marnames */ + } + + char ul = 'U', di = 'N'; + if (class[1] != 'g') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + di = *CHAR(STRING_ELT(diag, 0)); + } + } - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), - nms = VECTOR_ELT(dimnames, 1); - if (!isNull(nms)) - setAttrib(res, R_NamesSymbol, nms); + if (margin == 0 || class[1] == 's') + dense_rowsum(x, class, m, n, ul, di, narm, mean, res); + else + dense_colsum(x, class, m, n, ul, di, narm, mean, res); - UNPROTECT(3); /* dimnames, x, res */ + UNPROTECT(2); /* x, res */ return res; } -/* rowSums() */ -SEXP R_dense_rowSums(SEXP obj, SEXP narm, SEXP mean) +/* (row|col)(Sums|Means)() */ +SEXP R_dense_marginsum(SEXP obj, SEXP margin, + SEXP narm, SEXP mean) { - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, "" }; + static const char *valid[] = { VALID_DENSE, "" }; int ivalid = R_check_class_etc(obj, valid); if (ivalid < 0) ERROR_INVALID_CLASS(obj, __func__); - const char *cl = valid[ivalid]; - int doNaRm = asLogical(narm) != 0, - doMean = asLogical(mean) != 0; + int margin_; + if (TYPEOF(margin) != INTSXP || LENGTH(margin) < 1 || + ((margin_ = INTEGER(margin)[0]) != 0 && margin_ != 1)) + error(_("'%s' must be %d or %d"), "margin", 0, 1); + + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); + + int mean_; + if (TYPEOF(mean) != LGLSXP || LENGTH(mean) < 1 || + (mean_ = LOGICAL(mean)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "mean", "TRUE", "FALSE"); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + return dense_marginsum(obj, valid[ivalid], margin_, narm_, mean_); +} + +#undef SUM_CASES +#undef SUM_TYPEOF + +#define TRY_INCREMENT(_LABEL_) \ + do { \ + if ((s >= 0) \ + ? ( t <= MATRIX_INT_FAST64_MAX - s) \ + : (-t <= s - MATRIX_INT_FAST64_MIN)) { \ + s += t; \ + t = 0; \ + count = 0; \ + } else { \ + over = 1; \ + goto _LABEL_; \ + } \ + } while (0) + +#define LONGDOUBLE_AS_DOUBLE(v) \ + (v > DBL_MAX) ? R_PosInf : ((v < -DBL_MAX) ? R_NegInf : (double) v); + +SEXP dense_sum(SEXP obj, const char *class, int narm) +{ + SEXP res; + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ char ul = 'U', di = 'N'; - if (cl[1] != 'g') { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); + if (class[1] != 'g') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - - if (cl[1] == 't') { - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ } } - SEXP res = PROTECT(allocVector((cl[0] != 'z') ? REALSXP : CPLXSXP, m)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int i, j, *pcount = NULL; + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j, unpacked = class[2] != 'p', symmetric = class[1] == 's'; -#define DENSE_ROWSUMS_LOOP \ +#define SUM_LOOP \ do { \ - if (cl[1] == 'g') { /* general */ \ + if (class[1] == 'g') { \ for (j = 0; j < n; ++j) \ - for (i = 0; i < m; ++i, ++px) \ - DO_INCR; \ - } else if (cl[1] == 't') { \ - if (cl[2] != 'p') { \ - if (ul == 'U') { /* unpacked upper triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i <= j; ++i, ++px) \ - DO_INCR; \ - px += n-j-1; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR; \ - px += n-j; \ - } \ - } \ - } else { /* unpacked lower triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) { \ - px += j; \ - for (i = j; i < n; ++i, ++px) \ - DO_INCR; \ - } \ - } else { \ - for (i = j = 0; j < n; ++j, i = j) { \ - px += j+1; \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR; \ - } \ - } \ - } \ - } else { \ - if (ul == 'U') { /* packed upper triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) \ - for (i = 0; i <= j; ++i, ++px) \ - DO_INCR; \ - } else { \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR; \ - ++px; \ - } \ - } \ - } else { /* packed lower triangular */ \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) \ - for (i = j; i < n; ++i, ++px) \ - DO_INCR; \ - } else { \ - for (i = j = 0; j < n; ++j, i = j) { \ - ++px; \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR; \ - } \ - } \ - } \ - } \ - } else { \ - if (cl[2] != 'p') { \ - if (ul == 'U') { /* unpacked upper symmetric */ \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR_SYMM; \ - DO_INCR; \ - px += n-j; \ - } \ - } else { /* unpacked lower symmetric */ \ - for (i = j = 0; j < n; ++j, i = j) { \ - px += j; \ - DO_INCR; \ - ++px; \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR_SYMM; \ - } \ + SUM_KERNEL(for (i = 0; i < m; ++i)); \ + } else if (class[1] == 's' || di == 'N') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + SUM_KERNEL(for (i = 0; i <= j; ++i)); \ + if (unpacked) \ + px += m - j - 1; \ } \ } else { \ - if (ul == 'U') { /* packed upper symmetric */ \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - DO_INCR_SYMM; \ - DO_INCR; \ - ++px; \ - } \ - } else { /* packed lower symmetric */ \ - for (i = j = 0; j < n; ++j, i = j) { \ - DO_INCR; \ - ++px; \ - for (i = j+1; i < n; ++i, ++px) \ - DO_INCR_SYMM; \ - } \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px += j; \ + SUM_KERNEL(for (i = j; i < m; ++i)); \ } \ } \ - } \ - } while (0) - -#define DENSE_ROWSUMS(_CTYPE1_, _PTR1_, _CTYPE2_, _PTR2_) \ - do { \ - _CTYPE1_ *pres = _PTR1_(res), u = (di == 'N') ? ZERO : ONE; \ - _CTYPE2_ *px = _PTR2_(x); \ - if (doNaRm && doMean && cl[0] != 'n') { \ - Matrix_Calloc(pcount, m, int); \ - for (i = 0; i < m; ++i) { \ - pres[i] = u; \ - pcount[i] = n; \ - } \ } else { \ - for (i = 0; i < m; ++i) \ - pres[i] = u; \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + SUM_KERNEL(for (i = 0; i < j; ++i)); \ + ++px; \ + if (unpacked) \ + px += m - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px += j; \ + ++px; \ + SUM_KERNEL(for (i = j + 1; i < m; ++i)); \ + } \ + } \ } \ - DENSE_ROWSUMS_LOOP; \ } while (0) - switch (cl[0]) { - case 'n': + if (class[0] == 'n') { + int *px = LOGICAL(x); + Matrix_int_fast64_t s = (di == 'N') ? 0LL : n; -#define ZERO 0.0 -#define ONE 1.0 -#define DO_INCR if (*px) pres[i] += 1.0 -#define DO_INCR_SYMM \ +#define SUM_KERNEL(_FOR_) \ do { \ - if (*px) { \ - pres[i] += 1.0; \ - pres[j] += 1.0; \ + _FOR_ { \ + if (*px != 0) \ + s += (symmetric && i != j) ? 2 : 1; \ + ++px; \ } \ } while (0) - DENSE_ROWSUMS(double, REAL, int, LOGICAL); - break; + SUM_LOOP; -#undef DO_INCR -#undef DO_INCR_SYMM +#undef SUM_KERNEL - case 'l': + if (s <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) s; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) s; + } + return res; + } -#define DO_INCR \ - do { \ - if (*px != NA_LOGICAL) { \ - if (*px) \ - pres[i] += 1.0; \ - } else if (!doNaRm) \ - pres[i] = NA_REAL; \ - else if (doMean) \ - --pcount[i]; \ - } while (0) -#define DO_INCR_SYMM \ + if (!narm && (class[0] == 'l' || class[0] == 'i')) { + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + +#define SUM_KERNEL(_FOR_) \ do { \ - if (*px != NA_LOGICAL) { \ - if (*px) { \ - pres[i] += 1.0; \ - pres[j] += 1.0; \ - } \ - } else if (!doNaRm) { \ - pres[i] = NA_REAL; \ - pres[j] = NA_REAL; \ - } else if (doMean) { \ - --pcount[i]; \ - --pcount[j]; \ + _FOR_ { \ + if (*px == NA_INTEGER) { \ + res = allocVector(INTSXP, 1); \ + INTEGER(res)[0] = NA_INTEGER; \ + return res; \ + } \ + ++px; \ } \ } while (0) - DENSE_ROWSUMS(double, REAL, int, LOGICAL); - break; + SUM_LOOP; -#undef DO_INCR -#undef DO_INCR_SYMM +#undef SUM_KERNEL - case 'i': + } + + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr = (di == 'N') ? 0.0L : n, zi = 0.0L; -#define DO_INCR \ +#define SUM_KERNEL(_FOR_) \ do { \ - if (*px != NA_INTEGER) \ - pres[i] += *px; \ - else if (!doNaRm) \ - pres[i] = NA_REAL; \ - else if (doMean) \ - --pcount[i]; \ + _FOR_ { \ + if (!(narm && (ISNAN((*px).r) || ISNAN((*px).i)))) { \ + zr += (symmetric && i != j) \ + ? 2.0L * (*px).r : (*px).r; \ + zi += (symmetric && i != j) \ + ? 2.0L * (*px).i : (*px).i; \ + } \ + ++px; \ + } \ } while (0) -#define DO_INCR_SYMM \ + + SUM_LOOP; + +#undef SUM_KERNEL + + res = allocVector(CPLXSXP, 1); + COMPLEX(res)[0].r = LONGDOUBLE_AS_DOUBLE(zr); + COMPLEX(res)[0].i = LONGDOUBLE_AS_DOUBLE(zi); + } else if (class[0] == 'd') { + double *px = REAL(x); + long double zr = (di == 'N') ? 0.0L : n; + +#define SUM_KERNEL(_FOR_) \ do { \ - if (*px != NA_INTEGER) { \ - pres[i] += *px; \ - pres[j] += *px; \ - } else if (!doNaRm) { \ - pres[i] = NA_REAL; \ - pres[j] = NA_REAL; \ - } else if (doMean) { \ - --pcount[i]; \ - --pcount[j]; \ + _FOR_ { \ + if (!(narm && ISNAN(*px))) \ + zr += (symmetric && i != j) \ + ? 2.0L * *px : *px; \ + ++px; \ } \ } while (0) - DENSE_ROWSUMS(double, REAL, int, INTEGER); - break; + SUM_LOOP; -#undef DO_INCR -#undef DO_INCR_SYMM +#undef SUM_KERNEL - case 'd': + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else { + int *px = (class[0] == 'i') ? INTEGER(x) : LOGICAL(x); + Matrix_int_fast64_t s = (di == 'N') ? 0LL : n, t = 0LL; + unsigned int count = 0; + int over = 0; -#define DO_INCR \ +#define SUM_KERNEL(_FOR_) \ do { \ - if (!(doNaRm && ISNAN(*px))) \ - pres[i] += *px; \ - else if (doMean) \ - --pcount[i]; \ + _FOR_ { \ + if (!(narm && *px == NA_INTEGER)) { \ + int d = (symmetric && i != j) ? 2 : 1; \ + if (count > UINT_MAX - d) \ + TRY_INCREMENT(ifover); \ + t += (d == 2) ? 2LL * *px : *px; \ + count += d; \ + } \ + ++px; \ + } \ } while (0) -#define DO_INCR_SYMM \ + + SUM_LOOP; + +#undef SUM_KERNEL + + TRY_INCREMENT(ifover); + ifover: + if (over) { + long double zr = (di == 'N') ? 0.0L : n; /* FIXME: wasteful */ + px = (class[0] == 'i') ? INTEGER(x) : LOGICAL(x); + +#define SUM_KERNEL(_FOR_) \ + do { \ + _FOR_ { \ + if (!(narm && *px == NA_INTEGER)) \ + zr += (symmetric && i != j) \ + ? 2.0L * *px : *px; \ + ++px; \ + } \ + } while (0) + + SUM_LOOP; + +#undef SUM_KERNEL + + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else if (s > INT_MIN && s <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) s; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) s; + } + } + +#undef SUM_LOOP + + return res; +} + +/* sum() */ +SEXP R_dense_sum(SEXP obj, SEXP narm) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); + + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); + + return dense_sum(obj, valid[ivalid], narm_); +} + +SEXP dense_prod(SEXP obj, const char *class, int narm) +{ + SEXP res = PROTECT(allocVector((class[0] == 'z') ? CPLXSXP : REALSXP, 1)); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + + char ul = 'U', di = 'N'; + if (class[1] != 'g') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + di = *CHAR(STRING_ELT(diag, 0)); + } + } + + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j, unpacked = class[2] != 'p', symmetric = class[1] == 's'; + long double zr = 1.0L, zi = 0.0L; + +#define PROD_LOOP \ + do { \ + if (class[1] == 'g') { \ + for (j = 0; j < n; ++j) \ + PROD_KERNEL(for (i = 0; i < m; ++i)); \ + } else if (class[1] == 's') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + PROD_KERNEL(for (i = 0; i <= j; ++i)); \ + if (unpacked) \ + px += m - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (unpacked) \ + px += j; \ + PROD_KERNEL(for (i = j; i < m; ++i)); \ + } \ + } \ + } else if (di == 'N') { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + if (j == 1) { zr *= 0.0L; zi *= 0.0L; } \ + PROD_KERNEL(for (i = 0; i <= j; ++i)); \ + if (unpacked) \ + px += m - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (j == 1) { zr *= 0.0L; zi *= 0.0L; } \ + if (unpacked) \ + px += j; \ + PROD_KERNEL(for (i = j; i < m; ++i)); \ + } \ + } \ + } else { \ + if (ul == 'U') { \ + for (j = 0; j < n; ++j) { \ + if (j == 1) { zr *= 0.0L; zi *= 0.0L; } \ + PROD_KERNEL(for (i = 0; i < j; ++i)); \ + ++px; \ + if (unpacked) \ + px += m - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (j == 1) { zr *= 0.0L; zi *= 0.0L; } \ + if (unpacked) \ + px += j; \ + ++px; \ + PROD_KERNEL(for (i = j + 1; i < m; ++i)); \ + } \ + } \ + } \ + } while (0) + + if (class[0] == 'n') { + int *px = LOGICAL(x); + if (class[1] == 't') + REAL(res)[0] = (n > 1 || (n == 1 && *px == 0)) ? 0.0 : 1.0; + else { + +#define PROD_KERNEL(_FOR_) \ + do { \ + _FOR_ { \ + if (*px == 0) { \ + REAL(res)[0] = 0.0; \ + UNPROTECT(1); /* res */ \ + return res; \ + } \ + ++px; \ + } \ + } while (0) + + PROD_LOOP; + +#undef PROD_KERNEL + + REAL(res)[0] = 1.0; + } + UNPROTECT(1); /* res */ + return res; + } + + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr0, zi0; + +#define PROD_KERNEL(_FOR_) \ do { \ - if (!(doNaRm && ISNAN(*px))) { \ - pres[i] += *px; \ - pres[j] += *px; \ - } else if (doMean) { \ - --pcount[i]; \ - --pcount[j]; \ + _FOR_ { \ + if (!(narm && (ISNAN((*px).r) || ISNAN((*px).i)))) { \ + zr0 = zr; zi0 = zi; \ + zr = zr0 * (*px).r - zi0 * (*px).i; \ + zi = zr0 * (*px).i + zi0 * (*px).r; \ + if (symmetric && i != j) { \ + zr0 = zr; zi0 = zi; \ + zr = zr0 * (*px).r - zi0 * (*px).i; \ + zi = zr0 * (*px).i + zi0 * (*px).r; \ + } \ + } \ + ++px; \ } \ } while (0) - DENSE_ROWSUMS(double, REAL, double, REAL); - break; + PROD_LOOP; -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_INCR_SYMM +#undef PROD_KERNEL - case 'z': + } else if (class[0] == 'd') { + double *px = REAL(x); -#define ZERO Matrix_zzero -#define ONE Matrix_zone -#define DO_INCR \ +#define PROD_KERNEL(_FOR_) \ do { \ - if (!(doNaRm && (ISNAN((*px).r) || ISNAN((*px).i)))) { \ - pres[i].r += (*px).r; \ - pres[i].i += (*px).i; \ - } else if (doMean) \ - --pcount[i]; \ + _FOR_ { \ + if (!(narm && ISNAN(*px))) \ + zr *= (symmetric && i != j) \ + ? (long double) *px * *px : *px; \ + ++px; \ + } \ } while (0) -#define DO_INCR_SYMM \ + + PROD_LOOP; + +#undef PROD_KERNEL + + } else { + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + +#define PROD_KERNEL(_FOR_) \ do { \ - if (!(doNaRm && (ISNAN((*px).r) || ISNAN((*px).i)))) { \ - pres[i].r += (*px).r; \ - pres[i].i += (*px).i; \ - pres[j].r += (*px).r; \ - pres[j].i += (*px).i; \ - } else if (doMean) { \ - --pcount[i]; \ - --pcount[j]; \ + _FOR_ { \ + if (*px != NA_INTEGER) \ + zr *= (symmetric && i != j) \ + ? (long double) *px * *px : *px; \ + else if (!narm) \ + zr *= NA_REAL; \ + ++px; \ } \ } while (0) - DENSE_ROWSUMS(Rcomplex, COMPLEX, Rcomplex, COMPLEX); - break; + PROD_LOOP; -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_INCR_SYMM +#undef PROD_KERNEL - default: - break; } -#undef DENSE_ROWSUMS -#undef DENSE_ROWSUMS_LOOP +#undef PROD_LOOP - if (doMean) { - if (cl[0] != 'z') { - double *pres = REAL(res); - if (doNaRm && cl[0] != 'n') { - for (i = 0; i < m; ++i) - pres[i] /= pcount[i]; - Matrix_Free(pcount, m); - } else { - for (i = 0; i < m; ++i) - pres[i] /= n; - } - } else { - Rcomplex *pres = COMPLEX(res); - if (doNaRm) { - for (i = 0; i < m; ++i) { - pres[i].r /= pcount[i]; - pres[i].i /= pcount[i]; - } - Matrix_Free(pcount, m); - } else { - for (i = 0; i < m; ++i) { - pres[i].r /= n; - pres[i].i /= n; - } - } - } - } + if (class[0] == 'z') { + COMPLEX(res)[0].r = LONGDOUBLE_AS_DOUBLE(zr); + COMPLEX(res)[0].i = LONGDOUBLE_AS_DOUBLE(zi); + } else + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + UNPROTECT(1); /* res */ + return res; +} - SEXP dimnames; - if (cl[1] != 's') - PROTECT(dimnames = GET_SLOT(obj, Matrix_DimNamesSym)); - else - PROTECT(dimnames = get_symmetrized_DimNames(obj, -1)); - SEXP nms = VECTOR_ELT(dimnames, 0); - if (!isNull(nms)) - setAttrib(res, R_NamesSymbol, nms); +/* prod() */ +SEXP R_dense_prod(SEXP obj, SEXP narm) +{ + static const char *valid[] = { VALID_DENSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); - UNPROTECT(3); /* dimnames, x, res */ - return res; + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); + + return dense_prod(obj, valid[ivalid], narm_); } +#undef TRY_INCREMENT +#undef LONGDOUBLE_AS_DOUBLE + /* MJ: unused */ #if 0 diff -Nru rmatrix-1.6-1.1/src/dense.h rmatrix-1.6-5/src/dense.h --- rmatrix-1.6-1.1/src/dense.h 2023-07-30 16:26:24.000000000 +0000 +++ rmatrix-1.6-5/src/dense.h 2023-09-22 05:26:21.000000000 +0000 @@ -1,12 +1,45 @@ #ifndef MATRIX_DENSE_H #define MATRIX_DENSE_H -#include "Mutils.h" +#include -SEXP dense_band(SEXP from, const char *class, int a, int b, int new); -SEXP R_dense_band(SEXP from, SEXP k1, SEXP k2); +SEXP dense_band(SEXP, const char *, int, int); +SEXP R_dense_band(SEXP, SEXP, SEXP); -SEXP R_dense_colSums(SEXP obj, SEXP narm, SEXP mean); -SEXP R_dense_rowSums(SEXP obj, SEXP narm, SEXP mean); +SEXP dense_diag_get(SEXP, const char *, int); +SEXP R_dense_diag_get(SEXP, SEXP); + +SEXP dense_diag_set(SEXP, const char *, SEXP, int); +SEXP R_dense_diag_set(SEXP, SEXP); + +SEXP dense_transpose(SEXP, const char *); +SEXP R_dense_transpose(SEXP); + +SEXP dense_force_symmetric(SEXP, const char *, char); +SEXP R_dense_force_symmetric(SEXP, SEXP); + +SEXP dense_symmpart(SEXP, const char *); +SEXP R_dense_symmpart(SEXP); + +SEXP dense_skewpart(SEXP, const char *); +SEXP R_dense_skewpart(SEXP); + +int dense_is_symmetric(SEXP, const char *, int); +SEXP R_dense_is_symmetric(SEXP, SEXP); + +int dense_is_triangular(SEXP, const char *, int); +SEXP R_dense_is_triangular(SEXP, SEXP); + +int dense_is_diagonal(SEXP, const char *); +SEXP R_dense_is_diagonal(SEXP); + +SEXP dense_marginsum(SEXP, const char *, int, int, int); +SEXP R_dense_marginsum(SEXP, SEXP, SEXP, SEXP); + +SEXP dense_sum(SEXP, const char *, int); +SEXP R_dense_sum(SEXP, SEXP); + +SEXP dense_prod(SEXP, const char *, int); +SEXP R_dense_prod(SEXP, SEXP); #endif /* MATRIX_DENSE_H */ diff -Nru rmatrix-1.6-1.1/src/determinant.c rmatrix-1.6-5/src/determinant.c --- rmatrix-1.6-1.1/src/determinant.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/determinant.c 2023-10-10 17:29:10.000000000 +0000 @@ -0,0 +1,405 @@ +#include /* math.h, logspace_add, logspace_sub */ +#include "Mdefines.h" +#include "cholmod-etc.h" +#include "determinant.h" + +static +SEXP mkDet(double modulus, int logarithm, int sign) +{ + SEXP nms = PROTECT(allocVector(STRSXP, 2)), + cl = PROTECT(mkString("det")), + det = PROTECT(allocVector(VECSXP, 2)), + det0 = PROTECT(ScalarReal((logarithm) ? modulus : exp(modulus))), + det1 = PROTECT(ScalarInteger(sign)), + det0a = PROTECT(ScalarLogical(logarithm)); + SET_STRING_ELT(nms, 0, mkChar("modulus")); + SET_STRING_ELT(nms, 1, mkChar("sign")); + setAttrib(det, R_NamesSymbol, nms); + setAttrib(det, R_ClassSymbol, cl); + setAttrib(det0, install("logarithm"), det0a); + SET_VECTOR_ELT(det, 0, det0); + SET_VECTOR_ELT(det, 1, det1); + UNPROTECT(6); + return det; +} + +SEXP denseLU_determinant(SEXP obj, SEXP logarithm) +{ + +#define DETERMINANT_START \ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); \ + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; \ + if (m != n) \ + error(_("determinant of non-square matrix is undefined")); \ + int givelog = asLogical(logarithm) != 0; \ + double modulus = 0.0; /* result for n == 0 */ + + DETERMINANT_START; + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + int sign = (TYPEOF(x) == CPLXSXP) ? NA_INTEGER : 1; + + if (n > 0) { + int j; + R_xlen_t n1a = (R_xlen_t) n + 1; + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x); + for (j = 0; j < n; ++j) { + modulus += log(hypot((*px).r, (*px).i)); + px += n1a; + } + } else { + SEXP pivot = GET_SLOT(obj, Matrix_permSym); + int *ppivot = INTEGER(pivot); + double *px = REAL(x); + for (j = 0; j < n; ++j) { + if (ISNAN(*px) || *px >= 0.0) { + modulus += log(*px); + if (*ppivot != j + 1) + sign = -sign; + } else { + modulus += log(-(*px)); + if (*ppivot == j + 1) + sign = -sign; + } + px += n1a; + ppivot += 1; + } + } + } + + UNPROTECT(1); /* x */ + return mkDet(modulus, givelog, sign); +} + +SEXP BunchKaufman_determinant(SEXP obj, SEXP logarithm) +{ + DETERMINANT_START; + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + int sign = (TYPEOF(x) == CPLXSXP) ? NA_INTEGER : 1; + + if (n > 0) { + SEXP pivot = GET_SLOT(obj, Matrix_permSym); + int *ppivot = INTEGER(pivot); + + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + + int j = 0, unpacked = (Matrix_int_fast64_t) n * n <= R_XLEN_T_MAX && + XLENGTH(x) == (R_xlen_t) m * m; + R_xlen_t n1a = (R_xlen_t) n + 1; + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), a, b, c; + while (j < n) { + if (ppivot[j] > 0) { + modulus += log(hypot((*px).r, (*px).i)); + px += (unpacked) ? n1a : ((ul == 'U') ? j + 2 : n - j); + j += 1; + } else { + a = *px; + if (ul == 'U') { + px += (unpacked) ? n1a : j + 2; + b = *px; + c = *(px - 1); + px += (unpacked) ? n1a : j + 3; + } else { + c = *(px + 1); + px += (unpacked) ? n1a : n - j; + b = *px; + px += (unpacked) ? n1a : n - j - 1; + } + modulus += log(hypot(a.r * b.r - a.i * b.i - + c.r * c.r + c.i * c.i, + a.r * b.i + a.i * b.r - + 2.0 * c.r * c.i)); + j += 2; + } + } + } else { + double *px = REAL(x), a, b, c, logab, logcc; + while (j < n) { + if (ppivot[j] > 0) { + if (*px >= 0.0) + modulus += log(*px); + else { + modulus += log(-(*px)); + sign = -sign; + } + px += (unpacked) ? n1a : ((ul == 'U') ? j + 2 : n - j); + j += 1; + } else { + a = *px; + if (ul == 'U') { + px += (unpacked) ? n1a : j + 2; + b = *px; + c = *(px - 1); + px += (unpacked) ? n1a : j + 3; + } else { + c = *(px + 1); + px += (unpacked) ? n1a : n - j; + b = *px; + px += (unpacked) ? n1a : n - j - 1; + } + logab = log(fabs(a)) + log(fabs(b)); + logcc = 2.0 * log(fabs(c)); + if ((a < 0.0) != (b < 0.0)) { + /* det = ab - cc = -(abs(ab) + cc) < 0 */ + modulus += logspace_add(logab, logcc); + sign = -sign; + } else if (logab < logcc) { + /* det = ab - cc = -(cc - ab) < 0 */ + modulus += logspace_sub(logcc, logab); + sign = -sign; + } else { + /* det = ab - cc > 0 */ + modulus += logspace_sub(logab, logcc); + } + j += 2; + } + } + } + } + + UNPROTECT(1); /* x */ + return mkDet(modulus, givelog, sign); +} + +SEXP Cholesky_determinant(SEXP obj, SEXP logarithm) +{ + DETERMINANT_START; + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + int sign = (TYPEOF(x) == CPLXSXP) ? NA_INTEGER : 1; + + if (n > 0) { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + + int j, unpacked = (Matrix_int_fast64_t) n * n <= R_XLEN_T_MAX && + XLENGTH(x) == (R_xlen_t) m * m; + R_xlen_t n1a = (R_xlen_t) n + 1; + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x); + for (j = 0; j < n; ++j) { + modulus += log(hypot((*px).r, (*px).i)); + px += (unpacked) ? n1a : ((ul == 'U') ? j + 2 : n - j); + } + } else { + double *px = REAL(x); + for (j = 0; j < n; ++j) { + if (ISNAN(*px) || *px >= 0.0) + modulus += log(*px); + else { + modulus += log(-(*px)); + sign = -sign; + } + px += (unpacked) ? n1a : ((ul == 'U') ? j + 2 : n - j); + } + } + modulus *= 2.0; + } + + UNPROTECT(1); /* x */ + return mkDet(modulus, givelog, sign); +} + +SEXP sparseLU_determinant(SEXP obj, SEXP logarithm) +{ + DETERMINANT_START; + + SEXP U = PROTECT(GET_SLOT(obj, Matrix_USym)), + x = PROTECT(GET_SLOT(U, Matrix_xSym)); + int sign = (TYPEOF(x) == CPLXSXP) ? NA_INTEGER : 1; + + if (n > 0) { + SEXP p = PROTECT(GET_SLOT(U, Matrix_pSym)), + i = PROTECT(GET_SLOT(U, Matrix_iSym)); + int *pp = INTEGER(p) + 1, *pi = INTEGER(i), j, k = 0, kend; + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x); + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend && pi[kend - 1] == j) + modulus += log(hypot(px[kend - 1].r, px[kend - 1].i)); + else { + UNPROTECT(4); /* i, p, x, U */ + return mkDet(R_NegInf, givelog, 1); + } + k = kend; + } + } else { + double *px = REAL(x); + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend && pi[kend - 1] == j) { + if (ISNAN(px[kend - 1]) || px[kend - 1] >= 0.0) + modulus += log(px[kend - 1]); + else { + modulus += log(-px[kend - 1]); + sign = -sign; + } + } else { + UNPROTECT(4); /* i, p, x, U */ + return mkDet(R_NegInf, givelog, 1); + } + k = kend; + } + + /* defined in ./perm.c : */ + int signPerm(const int *, int, int); + + p = GET_SLOT(obj, Matrix_pSym); + if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) + sign = -sign; + p = GET_SLOT(obj, Matrix_qSym); + if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) + sign = -sign; + } + UNPROTECT(2); /* i, p */ + } + + UNPROTECT(2); /* x, U */ + return mkDet(modulus, givelog, sign); +} + +SEXP sparseQR_determinant(SEXP obj, SEXP logarithm) +{ + DETERMINANT_START; + + SEXP R = PROTECT(GET_SLOT(obj, Matrix_RSym)), + x = PROTECT(GET_SLOT(R, Matrix_xSym)); + int sign = (TYPEOF(x) == CPLXSXP) ? NA_INTEGER : 1; + + dim = GET_SLOT(R, Matrix_DimSym); + if (INTEGER(dim)[0] > n) + error(_("%s(<%s>) does not support structurally rank deficient case"), + "determinant", "sparseQR"); + + if (n > 0) { + SEXP p = PROTECT(GET_SLOT(R, Matrix_pSym)), + i = PROTECT(GET_SLOT(R, Matrix_iSym)); + int *pp = INTEGER(p) + 1, *pi = INTEGER(i), j, k = 0, kend; + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x); + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend && pi[kend - 1] == j) + modulus += log(hypot(px[kend - 1].r, px[kend - 1].i)); + else { + UNPROTECT(4); /* i, p, x, U */ + return mkDet(R_NegInf, givelog, 1); + } + k = kend; + } + } else { + double *px = REAL(x); + for (j = 0; j < n; ++j) { + kend = pp[j]; + if (k < kend && pi[kend - 1] == j) { + if (ISNAN(px[kend - 1]) || px[kend - 1] >= 0.0) + modulus += log(px[kend - 1]); + else { + modulus += log(-px[kend - 1]); + sign = -sign; + } + } else { + UNPROTECT(4); /* i, p, x, R */ + return mkDet(R_NegInf, givelog, 1); + } + k = kend; + } + + /* defined in ./perm.c : */ + int signPerm(const int *, int, int); + + p = GET_SLOT(obj, Matrix_pSym); + if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) + sign = -sign; + p = GET_SLOT(obj, Matrix_qSym); + if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) + sign = -sign; + if (n % 2) + sign = -sign; + } + UNPROTECT(2); /* i, p */ + } + + UNPROTECT(2); /* x, R */ + return mkDet(modulus, givelog, sign); +} + +SEXP CHMfactor_determinant(SEXP obj, SEXP logarithm, SEXP sqrt) +{ + DETERMINANT_START; + + cholmod_factor *L = M2CHF(obj, 1); + int sign = (L->xtype == CHOLMOD_COMPLEX) ? NA_INTEGER : 1; + + if (n > 0) { + int j, sqrt_ = asLogical(sqrt); + if (L->is_super) { + int k, nc, + nsuper = (int) L->nsuper, + *psuper = (int *) L->super, + *ppi = (int *) L->pi, + *ppx = (int *) L->px; + R_xlen_t nr1a; + if (L->xtype == CHOLMOD_COMPLEX) { + Rcomplex *px = (Rcomplex *) L->x, *px_; + for (k = 0; k < nsuper; ++k) { + nc = psuper[k + 1] - psuper[k]; + nr1a = (R_xlen_t) (ppi[k + 1] - ppi[k]) + 1; + px_ = px + ppx[k]; + for (j = 0; j < nc; ++j) { + modulus += log(hypot((*px_).r, (*px_).i)); + px_ += nr1a; + } + } + } else { + double *px = (double *) L->x, *px_; + for (k = 0; k < nsuper; ++k) { + nc = psuper[k + 1] - psuper[k]; + nr1a = (R_xlen_t) (ppi[k + 1] - ppi[k]) + 1; + px_ = px + ppx[k]; + for (j = 0; j < nc; ++j) { + modulus += log(*px_); + px_ += nr1a; + } + } + } + modulus *= 2.0; + } else { + int *pp = (int *) L->p; + if (L->xtype == CHOLMOD_COMPLEX) { + Rcomplex *px = (Rcomplex *) L->x; + for (j = 0; j < n; ++j) + modulus += log(hypot(px[pp[j]].r, px[pp[j]].i)); + if (L->is_ll) + modulus *= 2.0; + } else { + double *px = (double *) L->x; + if (L->is_ll) { + for (j = 0; j < n; ++j) + modulus += log(px[pp[j]]); + modulus *= 2.0; + } else { + for (j = 0; j < n; ++j) { + if (ISNAN(px[pp[j]]) || px[pp[j]] >= 0.0) + modulus += log(px[pp[j]]); + else { + if (sqrt_) + return mkDet(R_NaN, givelog, 1); + modulus += log(-px[pp[j]]); + sign = -sign; + } + } + } + } + } + if (sqrt_) + modulus *= 0.5; + } + + return mkDet(modulus, givelog, sign); +} diff -Nru rmatrix-1.6-1.1/src/determinant.h rmatrix-1.6-5/src/determinant.h --- rmatrix-1.6-1.1/src/determinant.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/determinant.h 2023-09-27 15:14:47.000000000 +0000 @@ -0,0 +1,13 @@ +#ifndef MATRIX_DETERMINANT_H +#define MATRIX_DETERMINANT_H + +#include + +SEXP denseLU_determinant(SEXP, SEXP); +SEXP BunchKaufman_determinant(SEXP, SEXP); +SEXP Cholesky_determinant(SEXP, SEXP); +SEXP sparseLU_determinant(SEXP, SEXP); +SEXP sparseQR_determinant(SEXP, SEXP); +SEXP CHMfactor_determinant(SEXP, SEXP, SEXP); + +#endif /* MATRIX_DETERMINANT_H */ diff -Nru rmatrix-1.6-1.1/src/dgCMatrix.c rmatrix-1.6-5/src/dgCMatrix.c --- rmatrix-1.6-1.1/src/dgCMatrix.c 2023-07-29 14:07:56.000000000 +0000 +++ rmatrix-1.6-5/src/dgCMatrix.c 2023-10-10 17:29:10.000000000 +0000 @@ -1,224 +1,121 @@ +#include "Mdefines.h" +#include "cs-etc.h" +#include "cholmod-etc.h" #include "dgCMatrix.h" -#include "cs_utils.h" -#include "chm_common.h" -/** 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) +/* TODO: support NCOL(b) > 1 */ +SEXP dgCMatrix_lusol(SEXP a, SEXP b) { - 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; + Matrix_cs *A = M2CXS(a, 1); + MCS_XTYPE_SET(MCS_REAL); + PROTECT(b = (TYPEOF(b) == REALSXP) ? + duplicate(b) : coerceVector(b, REALSXP)); + if (A->m != A->n || A->m <= 0) + error(_("'%s' is empty or not square"), "a"); + if (LENGTH(b) != A->m) + error(_("dimensions of '%s' and '%s' are inconsistent"), "a", "b"); + if (!Matrix_cs_lusol(1, A, REAL(b), 1e-07)) + error(_("'%s' failed"), "cs_lusol"); + UNPROTECT(1); + return b; } -SEXP dgCMatrix_lusol(SEXP x, SEXP y) +/* called from package MatrixModels's R code : */ +/* TODO: support NCOL(b) > 1 */ +/* TODO: give result list(L, coef, Xty, resid) */ +SEXP dgCMatrix_qrsol(SEXP a, SEXP b, SEXP order) { - 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; + /* FIXME? 'cs_qrsol' supports underdetermined systems. */ + /* We should only require LENGTH(b) = max(m, n). */ + int order_ = asInteger(order); + if (order_ < 0 || order_ > 3) + order_ = 0; + Matrix_cs *A = M2CXS(a, 1); + MCS_XTYPE_SET(MCS_REAL); + PROTECT(b = (TYPEOF(b) == REALSXP) + ? duplicate(b) : coerceVector(b, REALSXP)); + if (LENGTH(b) != A->m) + error(_("dimensions of '%s' and '%s' are inconsistent"), "a", "b"); + if (A->n <= 0 || A->n > A->m) + error(_("%s(%s, %s) requires m-by-n '%s' with m >= n > 0"), + "dgCMatrix_qrsol", "a", "b", "a"); + if (!Matrix_cs_qrsol(order_, A, REAL(b))) + error(_("'%s' failed"), "cs_qrsol"); + if (A->n < A->m) { + SEXP tmp = allocVector(REALSXP, A->n); + Matrix_memcpy(REAL(tmp), REAL(b), A->n, sizeof(double)); + b = tmp; + } + UNPROTECT(1); + return b; } -// called from package MatrixModels's R code -SEXP dgCMatrix_qrsol(SEXP x, SEXP y, SEXP ord) +/* called from package MatrixModels's R code : */ +/* TODO: support NCOL(b) > 1 */ +SEXP dgCMatrix_cholsol(SEXP at, SEXP b) { - /* 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()")); + /* Find least squares solution of A * X = B, given A' and B : */ + cholmod_sparse *At = M2CHS(at, 1); + PROTECT(b = coerceVector(b, REALSXP)); + if (LENGTH(b) != At->ncol) + error(_("dimensions of '%s' and '%s' are inconsistent"), "at", "b"); + if (At->ncol <= 0 || At->ncol < At->nrow) + error(_("%s(%s, %s) requires m-by-n '%s' with n >= m > 0"), + "dgCMatrix_cholsol", "at", "b", "at"); + double zero[] = { 0.0, 0.0 }, one[] = {1.0, 0.0}, mone[] = { -1.0, 0.0 }; + + /* L * L' = A' * A */ + cholmod_factor *L = cholmod_analyze(At, &c); + if (!cholmod_factorize(At, L, &c)) + error(_("'%s' failed"), "cholmod_factorize"); + + cholmod_dense *B = (cholmod_dense *) R_alloc(1, sizeof(cholmod_dense)); + memset(B, 0, sizeof(cholmod_dense)); + B->nrow = B->d = B->nzmax = LENGTH(b); + B->ncol = 1; + B->x = REAL(b); + B->dtype = CHOLMOD_DOUBLE; + B->xtype = CHOLMOD_REAL; + + /* A' * B = 1 * A' * B + 0 * */ + cholmod_dense *AtB = cholmod_allocate_dense( + At->nrow, 1, At->nrow, CHOLMOD_REAL, &c); + if (!cholmod_sdmult(At, 0, one, zero, B, AtB, &c)) + error(_("'%s' failed"), "cholmod_sdmult"); + + /* C := solve(A' * A, A' * B) = solve(L', solve(L, A' * B)) */ + cholmod_dense *C = cholmod_solve(CHOLMOD_A, L, AtB, &c); + if (!C) + error(_("'%s' failed"), "cholmod_solve"); + + /* R := A * A' * C - B = 1 * (A')' * A' * X + (-1) * B */ + cholmod_dense *R = cholmod_copy_dense(B, &c); + if (!cholmod_sdmult(At, 1, mone, one, C, R, &c)) + error(_("'%s' failed"), "cholmod_sdmult"); + + const char *nms[] = {"L", "coef", "Xty", "resid", ""}; + SEXP ans = PROTECT(Rf_mkNamed(VECSXP, nms)), tmp; + /* L : */ + PROTECT(tmp = CHF2M(L, 1)); + SET_VECTOR_ELT(ans, 0, tmp); + /* coef : */ + PROTECT(tmp = allocVector(REALSXP, At->nrow)); + Matrix_memcpy(REAL(tmp), C->x, At->nrow, sizeof(double)); + SET_VECTOR_ELT(ans, 1, tmp); + /* Xty : */ + PROTECT(tmp = allocVector(REALSXP, At->nrow)); + Matrix_memcpy(REAL(tmp), AtB->x, At->nrow, sizeof(double)); + SET_VECTOR_ELT(ans, 2, tmp); + /* resid : */ + PROTECT(tmp = allocVector(REALSXP, At->ncol)); + Matrix_memcpy(REAL(tmp), R->x, At->ncol, sizeof(double)); + SET_VECTOR_ELT(ans, 3, tmp); + + cholmod_free_factor(& L, &c); + cholmod_free_dense (&AtB, &c); + cholmod_free_dense (& C, &c); + cholmod_free_dense (& R, &c); - /* 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; + UNPROTECT(6); + 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; - /* const -- but do not fit when used in calls: */ - 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(); - - size_t n = cx->ncol;/* #{obs.} {x = t(X) !} */ - 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)")); - CHM_FR 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(&resid, &c); - cholmod_free_dense(&rhs, &c); - cholmod_free_dense(&cAns, &c); - UNPROTECT(2); - return ans; -} - -/* MJ: unused */ -#if 0 - -/** - * 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, Matrix_QSym, - 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]; - R_Free(E); - } else SET_VECTOR_ELT(ans, 2, allocVector(INTSXP, 0)); - SET_VECTOR_ELT(ans, 3, ScalarInteger((int)rank)); - UNPROTECT(1); - return ans; -} - -#endif /* MJ */ diff -Nru rmatrix-1.6-1.1/src/dgCMatrix.h rmatrix-1.6-5/src/dgCMatrix.h --- rmatrix-1.6-1.1/src/dgCMatrix.h 2023-06-24 19:54:25.000000000 +0000 +++ rmatrix-1.6-5/src/dgCMatrix.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,11 +1,10 @@ #ifndef MATRIX_DGCMATRIX_H #define MATRIX_DGCMATRIX_H -#include "Mutils.h" +#include -SEXP compressed_non_0_ij(SEXP x, SEXP colP); -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_lusol(SEXP, SEXP); +SEXP dgCMatrix_qrsol(SEXP, SEXP, SEXP); +SEXP dgCMatrix_cholsol(SEXP, SEXP); -#endif +#endif /* MATRIX_DGCMATRIX_H */ diff -Nru rmatrix-1.6-1.1/src/dgeMatrix.c rmatrix-1.6-5/src/dgeMatrix.c --- rmatrix-1.6-1.1/src/dgeMatrix.c 2023-06-24 19:54:25.000000000 +0000 +++ rmatrix-1.6-5/src/dgeMatrix.c 2023-09-22 05:53:14.000000000 +0000 @@ -1,3 +1,5 @@ +#include "Lapack-etc.h" +#include "Mdefines.h" #include "dgeMatrix.h" /* MJ: unused */ diff -Nru rmatrix-1.6-1.1/src/dgeMatrix.h rmatrix-1.6-5/src/dgeMatrix.h --- rmatrix-1.6-1.1/src/dgeMatrix.h 2023-06-24 19:54:25.000000000 +0000 +++ rmatrix-1.6-5/src/dgeMatrix.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,15 +1,9 @@ #ifndef MATRIX_DGEMATRIX_H #define MATRIX_DGEMATRIX_H -#include "Lapack-etc.h" -#include "Mutils.h" +#include -SEXP dgeMatrix_Schur(SEXP x, SEXP vectors, SEXP isDGE); -SEXP dgeMatrix_exp(SEXP x); +SEXP dgeMatrix_Schur(SEXP, SEXP, SEXP); +SEXP dgeMatrix_exp(SEXP); -/* MJ: unused */ -#if 0 -SEXP dgeMatrix_svd(SEXP x, SEXP nu, SEXP nv); -#endif /* MJ */ - -#endif +#endif /* MATRIX_DGEMATRIX_H */ diff -Nru rmatrix-1.6-1.1/src/factorizations.c rmatrix-1.6-5/src/factorizations.c --- rmatrix-1.6-1.1/src/factorizations.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/factorizations.c 2023-10-10 17:29:10.000000000 +0000 @@ -1,422 +1,92 @@ -#include /* math.h, logspace_add, logspace_sub */ +#include "Lapack-etc.h" +#include "cs-etc.h" +#include "cholmod-etc.h" +#include "Mdefines.h" #include "factorizations.h" -static cs *dgC2cs(SEXP obj) -{ - cs *A = (cs *) R_alloc(1, sizeof(cs)); - memset(A, 0, sizeof(cs)); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - p = PROTECT(GET_SLOT(obj, Matrix_pSym)), - i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - A->nzmax = LENGTH(i); - A->m = INTEGER(dim)[0]; - A->n = INTEGER(dim)[1]; - A->p = INTEGER(p); - A->i = INTEGER(i); - A->x = REAL(x); - A->nz = -1; - UNPROTECT(4); - return A; -} - -static SEXP cs2dgC(const cs *A, const char *cl) -{ - int nnz = ((int *) A->p)[A->n]; - R_xlen_t np1 = (R_xlen_t) A->n + 1; - SEXP obj = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - p = PROTECT(allocVector(INTSXP, np1)), - i = PROTECT(allocVector(INTSXP, nnz)), - x = PROTECT(allocVector(REALSXP, nnz)); - INTEGER(dim)[0] = A->m; - INTEGER(dim)[1] = A->n; - Matrix_memcpy(INTEGER(p), A->p, np1, sizeof(int)); - Matrix_memcpy(INTEGER(i), A->i, nnz, sizeof(int)); - Matrix_memcpy(REAL(x), A->x, nnz, sizeof(double)); - SET_SLOT(obj, Matrix_pSym, p); - SET_SLOT(obj, Matrix_iSym, i); - SET_SLOT(obj, Matrix_xSym, x); - UNPROTECT(5); - return obj; -} - -static cholmod_sparse *dgC2cholmod(SEXP obj) -{ - cholmod_sparse *A = (cholmod_sparse *) R_alloc(1, sizeof(cholmod_sparse)); - memset(A, 0, sizeof(cholmod_sparse)); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - p = PROTECT(GET_SLOT(obj, Matrix_pSym)), - i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - A->nrow = (size_t) INTEGER(dim)[0]; - A->ncol = (size_t) INTEGER(dim)[1]; - A->p = INTEGER(p); - A->i = INTEGER(i); - A->x = REAL(x); - A->nzmax = (size_t) ((int *) A->p)[A->ncol]; - A->stype = 0; - A->itype = CHOLMOD_INT; - A->xtype = CHOLMOD_REAL; - A->dtype = CHOLMOD_DOUBLE; - A->sorted = 1; - A->packed = 1; - UNPROTECT(4); - return A; -} - -static SEXP cholmod2dgC(cholmod_sparse *A, const char *cl) -{ - if (A->itype != CHOLMOD_INT || - A->xtype != CHOLMOD_REAL || - A->dtype != CHOLMOD_DOUBLE) - error(_("wrong '%s' or '%s' or '%s'"), "itype", "xtype", "dtype"); - if (A->nrow > INT_MAX || A->ncol > INT_MAX) - error(_("dimensions cannot exceed %s"), "2^31-1"); - if (!A->sorted || !A->packed || A->stype != 0) - cholmod_sort(A, &c); - int m = (int) A->nrow, n = (int) A->ncol, - nnz = ((int *) A->p)[A->ncol]; - R_xlen_t n1a = (R_xlen_t) n + 1; - SEXP obj = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - p = PROTECT(allocVector(INTSXP, n1a)), - i = PROTECT(allocVector(INTSXP, nnz)), - x = PROTECT(allocVector(REALSXP, nnz)); - INTEGER(dim)[0] = m; - INTEGER(dim)[1] = n; - Matrix_memcpy(INTEGER(p), A->p, n1a, sizeof(int)); - Matrix_memcpy(INTEGER(i), A->i, nnz, sizeof(int)); - Matrix_memcpy(REAL(x), A->x, nnz, sizeof(double)); - SET_SLOT(obj, Matrix_pSym, p); - SET_SLOT(obj, Matrix_iSym, i); - SET_SLOT(obj, Matrix_xSym, x); - UNPROTECT(5); - return obj; -} - -static cholmod_dense *dge2cholmod(SEXP obj) -{ - cholmod_dense *A = (cholmod_dense *) R_alloc(1, sizeof(cholmod_dense)); - memset(A, 0, sizeof(cholmod_dense)); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - A->nzmax = (size_t) XLENGTH(x); - A->nrow = (size_t) INTEGER(dim)[0]; - A->ncol = (size_t) INTEGER(dim)[1]; - A->d = A->nrow; - A->x = REAL(x); - A->xtype = CHOLMOD_REAL; - A->dtype = CHOLMOD_DOUBLE; - UNPROTECT(2); - return A; -} - -static SEXP cholmod2dge(const cholmod_dense *A, const char *cl) -{ - if (A->xtype != CHOLMOD_REAL || A->dtype != CHOLMOD_DOUBLE) - error(_("wrong '%s' or '%s'"), "xtype", "dtype"); - if (A->nrow > INT_MAX || A->ncol > INT_MAX) - error(_("dimensions cannot exceed %s"), "2^31-1"); - int m = (int) A->nrow, n = (int) A->ncol; - if ((double) m * n > R_XLEN_T_MAX) - error(_("attempt to allocate vector of length exceeding %s"), - "R_XLEN_T_MAX"); - size_t d = A->d; - R_xlen_t mn = (R_xlen_t) m * n; - SEXP obj = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - x = PROTECT(allocVector(REALSXP, mn)); - double *px = REAL(x), *py = (double *) A->x; - INTEGER(dim)[0] = m; - INTEGER(dim)[1] = n; - if (d == m) - Matrix_memcpy(px, py, mn, sizeof(double)); - else { - int j; - for (j = 0; j < n; ++j) { - Matrix_memcpy(px, py, m, sizeof(double)); - px += m; - py += d; - } - } - SET_SLOT(obj, Matrix_xSym, x); - UNPROTECT(3); - return obj; -} - -static cholmod_factor *mf2cholmod(SEXP obj) -{ - static const char *valid[] = { "dCHMsimpl", "dCHMsuper", "" }; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - error(_("expected %s or %s"), "dCHMsimpl", "dCHMsuper"); - SEXP type = PROTECT(GET_SLOT(obj, install("type"))), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - colcount = PROTECT(GET_SLOT(obj, install("colcount"))), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int *ptype = INTEGER(type); - cholmod_factor *L = (cholmod_factor *) R_alloc(1, sizeof(cholmod_factor)); - memset(L, 0, sizeof(cholmod_factor)); - - L->ordering = ptype[0]; - L->is_super = ptype[2]; - - L->n = (size_t) INTEGER(dim)[0]; - L->minor = L->n; /* FIXME: could be wrong for obj <- new(...) */ - L->ColCount = INTEGER(colcount); - - if (L->ordering != CHOLMOD_NATURAL) { - SEXP perm = PROTECT(GET_SLOT(obj, Matrix_permSym)); - L->Perm = INTEGER(perm); - UNPROTECT(1); - } else { - /* cholmod_check_factor allows L->Perm == NULL, - but cholmod_copy_factor does not test, so it segfaults ... - */ - int j, n = (int) L->n, *Perm = (int *) R_alloc(L->n, sizeof(int)); - for (j = 0; j < n; ++j) - Perm[j] = j; - L->Perm = Perm; - } - - L->itype = CHOLMOD_INT; - L->xtype = CHOLMOD_REAL; - L->dtype = CHOLMOD_DOUBLE; - L->x = REAL(x); - - if (L->is_super) { - SEXP super = PROTECT(GET_SLOT(obj, install("super"))), - pi = PROTECT(GET_SLOT(obj, install("pi"))), - px = PROTECT(GET_SLOT(obj, install("px"))), - s = PROTECT(GET_SLOT(obj, install("s"))); - L->super = INTEGER(super); - L->pi = INTEGER(pi); - L->px = INTEGER(px); - L->s = INTEGER(s); - L->nsuper = (size_t) LENGTH(super) - 1; - L->ssize = (size_t) ((int *) L->pi)[L->nsuper]; - L->xsize = (size_t) ((int *) L->px)[L->nsuper]; - L->maxcsize = (size_t) ptype[4]; - L->maxesize = (size_t) ptype[5]; - L->is_ll = 1; - L->is_monotonic = 1; - UNPROTECT(4); - } else { - SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)), - i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - nz = PROTECT(GET_SLOT(obj, install("nz"))), - nxt = PROTECT(GET_SLOT(obj, install("nxt"))), - prv = PROTECT(GET_SLOT(obj, install("prv"))); - L->p = INTEGER(p); - L->i = INTEGER(i); - L->nz = INTEGER(nz); - L->next = INTEGER(nxt); - L->prev = INTEGER(prv); - L->nzmax = (size_t) ((int *) L->p)[L->n]; - L->is_ll = ptype[1]; - L->is_monotonic = ptype[3]; - UNPROTECT(5); - } - - UNPROTECT(4); - return L; -} - -static SEXP cholmod2mf(const cholmod_factor *L) -{ - if (L->itype != CHOLMOD_INT || - L->xtype != CHOLMOD_REAL || - L->dtype != CHOLMOD_DOUBLE) - error(_("wrong '%s' or '%s' or '%s"), "itype", "xtype", "dtype"); - if (L->n > INT_MAX) - error(_("dimensions cannot exceed %s"), "2^31-1"); - if (L->super) { - if (L->maxcsize > INT_MAX) - error(_("'%s' would overflow \"%s\""), "maxcsize", "integer"); - } else { - if (L->n == INT_MAX) - error(_("n+1 would overflow \"%s\""), "integer"); - } - if (L->minor < L->n) { - if (L->is_ll) - error(_("leading principal minor of order %d is not positive"), - (int) L->minor + 1); - else - error(_("leading principal minor of order %d is zero"), - (int) L->minor + 1); - } - - SEXP obj = PROTECT(NEW_OBJECT_OF_CLASS((L->is_super) ? "dCHMsuper" : "dCHMsimpl")), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - type = PROTECT(allocVector(INTSXP, 6)), - colcount = PROTECT(allocVector(INTSXP, L->n)), - x = PROTECT(allocVector(REALSXP, (L->is_super) ? L->xsize : L->nzmax)); - int *pdim = INTEGER(dim), *ptype = INTEGER(type); - pdim[0] = pdim[1] = (int) L->n; - ptype[0] = L->ordering; - ptype[1] = L->is_ll; - ptype[2] = L->is_super; - ptype[3] = L->is_monotonic; - ptype[4] = (int) L->maxcsize; - ptype[5] = (int) L->maxesize; - Matrix_memcpy(INTEGER(colcount), L->ColCount, L->n, sizeof(int)); - Matrix_memcpy(REAL(x), L->x, XLENGTH(x), sizeof(double)); - SET_SLOT(obj, Matrix_DimSym, dim); - SET_SLOT(obj, install("type"), type); - SET_SLOT(obj, install("colcount"), colcount); - SET_SLOT(obj, Matrix_xSym, x); - - if (L->ordering != CHOLMOD_NATURAL) { - SEXP perm = PROTECT(allocVector(INTSXP, L->n)); - Matrix_memcpy(INTEGER(perm), L->Perm, L->n, sizeof(int)); - SET_SLOT(obj, Matrix_permSym, perm); - UNPROTECT(1); - } - - if (L->is_super) { - SEXP super = PROTECT(allocVector(INTSXP, L->nsuper + 1)), - pi = PROTECT(allocVector(INTSXP, L->nsuper + 1)), - px = PROTECT(allocVector(INTSXP, L->nsuper + 1)), - s = PROTECT(allocVector(INTSXP, L->ssize)); - Matrix_memcpy(INTEGER(super), L->super, L->nsuper + 1, sizeof(int)); - Matrix_memcpy(INTEGER(pi), L->pi, L->nsuper + 1, sizeof(int)); - Matrix_memcpy(INTEGER(px), L->px, L->nsuper + 1, sizeof(int)); - Matrix_memcpy(INTEGER(s), L->s, L->ssize, sizeof(int)); - SET_SLOT(obj, install("super"), super); - SET_SLOT(obj, install("pi"), pi); - SET_SLOT(obj, install("px"), px); - SET_SLOT(obj, install("s"), s); - UNPROTECT(4); - } else { - SEXP p = PROTECT(allocVector(INTSXP, L->n + 1)), - i = PROTECT(allocVector(INTSXP, L->nzmax)), - nz = PROTECT(allocVector(INTSXP, L->n)), - nxt = PROTECT(allocVector(INTSXP, L->n + 2)), - prv = PROTECT(allocVector(INTSXP, L->n + 2)); - Matrix_memcpy(INTEGER(p), L->p, L->n + 1, sizeof(int)); - Matrix_memcpy(INTEGER(i), L->i, L->nzmax, sizeof(int)); - Matrix_memcpy(INTEGER(nz), L->nz, L->n, sizeof(int)); - Matrix_memcpy(INTEGER(nxt), L->next, L->n + 2, sizeof(int)); - Matrix_memcpy(INTEGER(prv), L->prev, L->n + 2, sizeof(int)); - SET_SLOT(obj, Matrix_pSym, p); - SET_SLOT(obj, Matrix_iSym, i); - SET_SLOT(obj, install("nz"), nz); - SET_SLOT(obj, install("nxt"), nxt); - SET_SLOT(obj, install("prv"), prv); - UNPROTECT(5); - } - - UNPROTECT(5); - return obj; -} - -#define ERROR_LAPACK_1(_ROUTINE_, _INFO_) \ -do { \ - if ((_INFO_) < 0) \ - error(_("LAPACK routine '%s': argument %d had illegal value"), \ - #_ROUTINE_, -(_INFO_)); \ -} while (0) - -#define ERROR_LAPACK_2(_ROUTINE_, _INFO_, _WARN_, _LETTER_) \ -do { \ - ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ - if ((_INFO_) > 0 && (_WARN_) > 0) { \ - if (_WARN_ > 1) \ - error (_("LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d"), \ - #_ROUTINE_, #_LETTER_, (_INFO_)); \ - else \ - warning(_("LAPACK routine '%s': matrix is exactly singular, %s[i,i]=0, i=%d"), \ - #_ROUTINE_, #_LETTER_, (_INFO_)); \ - } \ -} while (0) - -#define ERROR_LAPACK_3(_ROUTINE_, _INFO_, _WARN_, _NPROTECT_) \ -do { \ - ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ - if ((_INFO_) > 0 && (_WARN_) > 0) { \ - if (_WARN_ > 1) \ - error (_("LAPACK routine '%s': leading principal minor of order %d is not positive"), \ - #_ROUTINE_, (_INFO_)); \ - else { \ - warning(_("LAPACK routine '%s': leading principal minor of order %d is not positive"), \ - #_ROUTINE_, (_INFO_)); \ - UNPROTECT(_NPROTECT_); \ - return ScalarInteger(_INFO_); \ - } \ - } \ -} while (0) - -#define ERROR_LAPACK_4(_ROUTINE_, _INFO_, _RANK_, _WARN_) \ - do { \ - ERROR_LAPACK_1(_ROUTINE_, _INFO_); \ - if ((_INFO_) > 0 && (_WARN_) > 0) { \ - if (_WARN_ > 1) \ - error (_("LAPACK routine '%s': matrix is rank deficient or not positive definite, the _computed_ rank is %d"), \ - #_ROUTINE_, (_RANK_)); \ - else \ - warning(_("LAPACK routine '%s': matrix is rank deficient or not positive definite, the _computed_ rank is %d"), \ - #_ROUTINE_, (_RANK_)); \ - } \ - } while (0) +/* defined in ./attrib.c : */ +SEXP get_factor(SEXP, const char *); +void set_factor(SEXP, const char *, SEXP); +static SEXP dgeMatrix_trf_(SEXP obj, int warn) { - SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("denseLU")), + SEXP val = PROTECT(newObject("denseLU")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - int *pdim = INTEGER(dim), r = (pdim[0] < pdim[1]) ? pdim[0] : pdim[1]; + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], r = (m < n) ? m : n; SET_SLOT(val, Matrix_DimSym, dim); SET_SLOT(val, Matrix_DimNamesSym, dimnames); if (r > 0) { SEXP perm = PROTECT(allocVector(INTSXP, r)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - x = duplicate(x); - UNPROTECT(1); /* x */ - PROTECT(x); + x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + y = PROTECT(allocVector(TYPEOF(x), XLENGTH(x))); int *pperm = INTEGER(perm), info; - double *px = REAL(x); - - F77_CALL(dgetrf)(pdim, pdim + 1, px, pdim, pperm, &info); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), *py = COMPLEX(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(Rcomplex)); + F77_CALL(zgetrf)(&m, &n, py, &m, pperm, &info); + ERROR_LAPACK_2(zgetrf, info, warn, U); + } else { +#endif + double *px = REAL(x), *py = REAL(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(double)); + F77_CALL(dgetrf)(&m, &n, py, &m, pperm, &info); ERROR_LAPACK_2(dgetrf, info, warn, U); - +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif SET_SLOT(val, Matrix_permSym, perm); - SET_SLOT(val, Matrix_xSym, x); - UNPROTECT(2); /* x, perm */ + SET_SLOT(val, Matrix_xSym, y); + UNPROTECT(3); /* y, x, perm */ } UNPROTECT(3); /* dimnames, dim, val */ return val; } +static SEXP dsyMatrix_trf_(SEXP obj, int warn) { - SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("BunchKaufman")), + SEXP val = PROTECT(newObject("BunchKaufman")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int *pdim = INTEGER(dim), n = pdim[0]; + int n = INTEGER(dim)[1]; + char ul = *CHAR(STRING_ELT(uplo, 0)); SET_SLOT(val, Matrix_DimSym, dim); set_symmetrized_DimNames(val, dimnames, -1); SET_SLOT(val, Matrix_uploSym, uplo); if (n > 0) { SEXP perm = PROTECT(allocVector(INTSXP, n)), x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - y = PROTECT(allocVector(REALSXP, XLENGTH(x))); - char ul = *CHAR(STRING_ELT(uplo, 0)); - int *pperm = INTEGER(perm), lwork = -1, info; + y = PROTECT(allocVector(TYPEOF(x), XLENGTH(x))); + int *pperm = INTEGER(perm), info, lwork = -1; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), *py = COMPLEX(y), tmp, *work; + Matrix_memset(py, 0, XLENGTH(y), sizeof(Rcomplex)); + F77_CALL(zlacpy)(&ul, &n, &n, px, &n, py, &n FCONE); + F77_CALL(zsytrf)(&ul, &n, py, &n, pperm, &tmp, &lwork, &info FCONE); + lwork = (int) tmp.r; + Matrix_Calloc(work, lwork, Rcomplex); + F77_CALL(zsytrf)(&ul, &n, py, &n, pperm, work, &lwork, &info FCONE); + Matrix_Free(work, lwork); + ERROR_LAPACK_2(zsytrf, info, warn, D); + } else { +#endif double *px = REAL(x), *py = REAL(y), tmp, *work; - Matrix_memset(py, 0, XLENGTH(y), sizeof(double)); - F77_CALL(dlacpy)(&ul, pdim, pdim, px, pdim, py, pdim FCONE); - F77_CALL(dsytrf)(&ul, pdim, py, pdim, pperm, &tmp, &lwork, - &info FCONE); + F77_CALL(dlacpy)(&ul, &n, &n, px, &n, py, &n FCONE); + F77_CALL(dsytrf)(&ul, &n, py, &n, pperm, &tmp, &lwork, &info FCONE); lwork = (int) tmp; Matrix_Calloc(work, lwork, double); - F77_CALL(dsytrf)(&ul, pdim, py, pdim, pperm, work, &lwork, - &info FCONE); + F77_CALL(dsytrf)(&ul, &n, py, &n, pperm, work, &lwork, &info FCONE); Matrix_Free(work, lwork); ERROR_LAPACK_2(dsytrf, info, warn, D); - +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif SET_SLOT(val, Matrix_permSym, perm); SET_SLOT(val, Matrix_xSym, y); UNPROTECT(3); /* y, x, perm */ @@ -425,87 +95,115 @@ return val; } +static SEXP dspMatrix_trf_(SEXP obj, int warn) { - SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("pBunchKaufman")), + SEXP val = PROTECT(newObject("pBunchKaufman")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int *pdim = INTEGER(dim), n = pdim[0]; + int n = INTEGER(dim)[1]; + char ul = *CHAR(STRING_ELT(uplo, 0)); SET_SLOT(val, Matrix_DimSym, dim); set_symmetrized_DimNames(val, dimnames, -1); SET_SLOT(val, Matrix_uploSym, uplo); if (n > 0) { SEXP perm = PROTECT(allocVector(INTSXP, n)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - x = duplicate(x); - UNPROTECT(1); /* x */ - PROTECT(x); - char ul = *CHAR(STRING_ELT(uplo, 0)); + x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + y = PROTECT(allocVector(TYPEOF(x), XLENGTH(x))); int *pperm = INTEGER(perm), info; - double *px = REAL(x); - - F77_CALL(dsptrf)(&ul, pdim, px, pperm, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), *py = COMPLEX(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(Rcomplex)); + F77_CALL(zsptrf)(&ul, &n, py, pperm, &info FCONE); + ERROR_LAPACK_2(zsptrf, info, warn, D); + } else { +#endif + double *px = REAL(x), *py = REAL(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(double)); + F77_CALL(dsptrf)(&ul, &n, py, pperm, &info FCONE); ERROR_LAPACK_2(dsptrf, info, warn, D); - +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif SET_SLOT(val, Matrix_permSym, perm); - SET_SLOT(val, Matrix_xSym, x); - UNPROTECT(2); /* x, perm */ + SET_SLOT(val, Matrix_xSym, y); + UNPROTECT(3); /* y, x, perm */ } UNPROTECT(4); /* uplo, dimnames, dim, val */ return val; } +static SEXP dpoMatrix_trf_(SEXP obj, int warn, int pivot, double tol) { - SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("Cholesky")), + SEXP val = PROTECT(newObject("Cholesky")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int *pdim = INTEGER(dim), n = pdim[0]; + int n = INTEGER(dim)[1]; + char ul = *CHAR(STRING_ELT(uplo, 0)); SET_SLOT(val, Matrix_DimSym, dim); set_symmetrized_DimNames(val, dimnames, -1); SET_SLOT(val, Matrix_uploSym, uplo); if (n > 0) { SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - y = PROTECT(allocVector(REALSXP, XLENGTH(x))); - char ul = *CHAR(STRING_ELT(uplo, 0)); + y = PROTECT(allocVector(TYPEOF(x), XLENGTH(x))); int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), *py = COMPLEX(y); + Matrix_memset(py, 0, XLENGTH(y), sizeof(Rcomplex)); + F77_CALL(zlacpy)(&ul, &n, &n, px, &n, py, &n FCONE); + if (!pivot) { + F77_CALL(zpotrf)(&ul, &n, py, &n, &info FCONE); + ERROR_LAPACK_3(zpotrf, info, warn, 6); + } else { + SEXP perm = PROTECT(allocVector(INTSXP, n)); + int *pperm = INTEGER(perm), rank; + Rcomplex *work = (Rcomplex *) R_alloc((size_t) 2 * n, sizeof(Rcomplex)); + F77_CALL(zpstrf)(&ul, &n, py, &n, pperm, &rank, &tol, work, &info FCONE); + ERROR_LAPACK_4(zpstrf, info, rank, warn); + if (info > 0) { + int j, d = n - rank; + py += (R_xlen_t) rank * n + rank; + for (j = rank; j < n; ++j) { + Matrix_memset(py, 0, d, sizeof(Rcomplex)); + py += n; + } + } + SET_SLOT(val, Matrix_permSym, perm); + UNPROTECT(1); /* perm */ + } + } else { +#endif double *px = REAL(x), *py = REAL(y); - Matrix_memset(py, 0, XLENGTH(y), sizeof(double)); - F77_CALL(dlacpy)(&ul, pdim, pdim, px, pdim, py, pdim FCONE); - - if (pivot) { - SEXP perm = PROTECT(allocVector(INTSXP, n)); - int *pperm = INTEGER(perm), rank; - double *work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); - - F77_CALL(dpstrf)(&ul, pdim, py, pdim, - pperm, &rank, &tol, work, &info FCONE); - ERROR_LAPACK_4(dpstrf, info, rank, warn); - - if (info > 0) { - /* Zero the trailing (n-rank)-by-(n-rank) principal - submatrix to guarantee that the result is valid - under the assumption that the factorized matrix - is positive semidefinite */ - int j; - R_xlen_t len = (R_xlen_t) (n - rank); - py += (R_xlen_t) rank * n + rank; - for (j = rank; j < n; ++j) { - Matrix_memset(py, 0, len, sizeof(double)); - py += n; - } + F77_CALL(dlacpy)(&ul, &n, &n, px, &n, py, &n FCONE); + if (!pivot) { + F77_CALL(dpotrf)(&ul, &n, py, &n, &info FCONE); + ERROR_LAPACK_3(dpotrf, info, warn, 6); + } else { + SEXP perm = PROTECT(allocVector(INTSXP, n)); + int *pperm = INTEGER(perm), rank; + double *work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); + F77_CALL(dpstrf)(&ul, &n, py, &n, pperm, &rank, &tol, work, &info FCONE); + ERROR_LAPACK_4(dpstrf, info, rank, warn); + if (info > 0) { + int j, d = n - rank; + py += (R_xlen_t) rank * n + rank; + for (j = rank; j < n; ++j) { + Matrix_memset(py, 0, d, sizeof(double)); + py += n; } - - SET_SLOT(val, Matrix_permSym, perm); - UNPROTECT(1); /* perm */ - } else { - F77_CALL(dpotrf)(&ul, pdim, py, pdim, &info FCONE); - ERROR_LAPACK_3(dpotrf, info, warn, 6); } - + SET_SLOT(val, Matrix_permSym, perm); + UNPROTECT(1); /* perm */ + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif SET_SLOT(val, Matrix_xSym, y); UNPROTECT(2); /* y, x */ } @@ -513,30 +211,39 @@ return val; } +static SEXP dppMatrix_trf_(SEXP obj, int warn) { - SEXP val = PROTECT(NEW_OBJECT_OF_CLASS("pCholesky")), + SEXP val = PROTECT(newObject("pCholesky")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int *pdim = INTEGER(dim), n = pdim[0]; + int n = INTEGER(dim)[1]; + char ul = *CHAR(STRING_ELT(uplo, 0)); SET_SLOT(val, Matrix_DimSym, dim); set_symmetrized_DimNames(val, dimnames, -1); SET_SLOT(val, Matrix_uploSym, uplo); if (n > 0) { - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - x = duplicate(x); - UNPROTECT(1); /* x */ - PROTECT(x); - char ul = *CHAR(STRING_ELT(uplo, 0)); + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + y = PROTECT(allocVector(TYPEOF(x), XLENGTH(x))); int info; - double *px = REAL(x); - - F77_CALL(dpptrf)(&ul, pdim, px, &info FCONE); - ERROR_LAPACK_3(dpptrf, info, warn, 5); - - SET_SLOT(val, Matrix_xSym, x); - UNPROTECT(1); /* x */ +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + Rcomplex *px = COMPLEX(x), *py = COMPLEX(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(Rcomplex)); + F77_CALL(zpptrf)(&ul, &n, py, &info FCONE); + ERROR_LAPACK_3(zpptrf, info, warn, 6); + } else { +#endif + double *px = REAL(x), *py = REAL(y); + Matrix_memcpy(py, px, XLENGTH(y), sizeof(double)); + F77_CALL(dpptrf)(&ul, &n, py, &info FCONE); + ERROR_LAPACK_3(dpptrf, info, warn, 6); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(val, Matrix_xSym, y); + UNPROTECT(2); /* y, x */ } UNPROTECT(4); /* uplo, dimnames, dim, val */ return val; @@ -599,44 +306,45 @@ return val; } -int dgCMatrix_trf_(const cs *A, css **S, csn **N, int order, double tol) -{ - cs *T = NULL; +#define DO_FREE(_A_, _S_, _N_) \ +do { \ + if (!(_A_)) \ + _A_ = Matrix_cs_spfree(_A_); \ + if (!(_S_)) \ + _S_ = Matrix_cs_sfree (_S_); \ + if (!(_N_)) \ + _N_ = Matrix_cs_nfree (_N_); \ +} while (0) -#define FREE_AND_RETURN_ZERO \ - do { \ - if (*S) \ - *S = cs_sfree(*S); \ - if (*N) \ - *N = cs_nfree(*N); \ - if (T) \ - T = cs_spfree(T); \ +#define DO_SORT(_A_) \ +do { \ + Matrix_cs_dropzeros(_A_); \ + T = Matrix_cs_transpose(_A_, 1); \ + if (!T) { \ + DO_FREE(T, *S, *N); \ + return 0; \ + } \ + _A_ = Matrix_cs_spfree(_A_); \ + _A_ = Matrix_cs_transpose(T, 1); \ + if (!(_A_)) { \ + DO_FREE(T, *S, *N); \ return 0; \ - } while (0) + } \ + T = Matrix_cs_spfree(T); \ +} while (0) - /* Symbolic analysis and numeric factorization : */ - if (!(*S = cs_sqr(order, A, 0)) || - !(*N = cs_lu(A, *S, tol))) - FREE_AND_RETURN_ZERO; - /* Drop zeros from L and sort it : */ - cs_dropzeros((*N)->L); - T = cs_transpose((*N)->L, 1); - if (!T) - FREE_AND_RETURN_ZERO; - (*N)->L = cs_spfree((*N)->L); - (*N)->L = cs_transpose(T, 1); - if (!(*N)->L) - FREE_AND_RETURN_ZERO; - T = cs_spfree(T); - /* Drop zeros from U and sort it : */ - T = cs_transpose((*N)->U, 1); - if (!T) - FREE_AND_RETURN_ZERO; - (*N)->U = cs_spfree((*N)->U); - (*N)->U = cs_transpose(T, 1); - if (!(*N)->U) - FREE_AND_RETURN_ZERO; - T = cs_spfree(T); +static +int dgCMatrix_trf_(const Matrix_cs *A, Matrix_css **S, Matrix_csn **N, + int order, double tol) +{ + Matrix_cs *T = NULL; + if (!(*S = Matrix_cs_sqr(order, A, 0)) || + !(*N = Matrix_cs_lu(A, *S, tol))) { + DO_FREE(T, *S, *N); + return 0; + } + DO_SORT((*N)->L); + DO_SORT((*N)->U); return 1; } @@ -655,24 +363,27 @@ SEXP val = get_factor(obj, (order_) ? "sparseLU~" : "sparseLU"); if (!isNull(val)) return val; - PROTECT(val = NEW_OBJECT_OF_CLASS("sparseLU")); + PROTECT(val = newObject("sparseLU")); + + Matrix_cs *A = M2CXS(obj, 1); + MCS_XTYPE_SET(A->xtype); + + Matrix_css *S = NULL; + Matrix_csn *N = NULL; + int *P = NULL; - const cs *A = dgC2cs(obj); - css *S = NULL; - csn *N = NULL; - int *pp = NULL; if (A->m != A->n) error(_("LU factorization of m-by-n %s requires m == n"), - "dgCMatrix"); + ".gCMatrix"); if (!dgCMatrix_trf_(A, &S, &N, order_, tol_) || - !(pp = cs_pinv(N->pinv, A->m))) { - if (!pp) { - S = cs_sfree(S); - N = cs_nfree(N); + !(P = Matrix_cs_pinv(N->pinv, A->m))) { + if (!P) { + S = Matrix_cs_sfree(S); + N = Matrix_cs_nfree(N); } if (asLogical(doError)) error(_("LU factorization of %s failed: out of memory or near-singular"), - "dgCMatrix"); + ".gCMatrix"); /* Defensive code will check with is(., "sparseLU") : */ UNPROTECT(1); /* val */ return ScalarLogical(NA_LOGICAL); @@ -686,62 +397,46 @@ SET_SLOT(val, Matrix_DimNamesSym, dimnames); UNPROTECT(1); /* dimnames */ - SEXP L = PROTECT(cs2dgC(N->L, "dtCMatrix")), - U = PROTECT(cs2dgC(N->U, "dtCMatrix")), - uplo = PROTECT(mkString("L")); + SEXP L = PROTECT(CXS2M(N->L, 1, 't')), + U = PROTECT(CXS2M(N->U, 1, 't')), + uplo = PROTECT(mkString("L")); SET_SLOT(L, Matrix_uploSym, uplo); SET_SLOT(val, Matrix_LSym, L); SET_SLOT(val, Matrix_USym, U); UNPROTECT(3); /* uplo, U, L */ SEXP p = PROTECT(allocVector(INTSXP, A->m)); - Matrix_memcpy(INTEGER(p), pp, A->m, sizeof(int)); + Matrix_memcpy(INTEGER(p), P, A->m, sizeof(int)); SET_SLOT(val, Matrix_pSym, p); UNPROTECT(1); /* p */ if (order_ > 0) { SEXP q = PROTECT(allocVector(INTSXP, A->n)); - int *pq = S->q; - Matrix_memcpy(INTEGER(q), pq, A->n, sizeof(int)); + Matrix_memcpy(INTEGER(q), S->q, A->n, sizeof(int)); SET_SLOT(val, Matrix_qSym, q); UNPROTECT(1); /* q */ } - S = cs_sfree(S); - N = cs_nfree(N); - pp = cs_free(pp); + S = Matrix_cs_sfree(S); + N = Matrix_cs_nfree(N); + P = Matrix_cs_free(P); set_factor(obj, (order_) ? "sparseLU~" : "sparseLU", val); UNPROTECT(1); /* val */ return val; } -int dgCMatrix_orf_(const cs *A, css **S, csn **N, int order) -{ - cs *T = NULL; - - /* Symbolic analysis and numeric factorization : */ - if (!(*S = cs_sqr(order, A, 1)) || - !(*N = cs_qr(A, *S))) - FREE_AND_RETURN_ZERO; - /* Drop zeros from V and sort it : */ - cs_dropzeros((*N)->L); - T = cs_transpose((*N)->L, 1); - if (!T) - FREE_AND_RETURN_ZERO; - (*N)->L = cs_spfree((*N)->L); - (*N)->L = cs_transpose(T, 1); - if (!(*N)->L) - FREE_AND_RETURN_ZERO; - T = cs_spfree(T); - /* Drop zeros from R and sort it : */ - T = cs_transpose((*N)->U, 1); - if (!T) - FREE_AND_RETURN_ZERO; - (*N)->U = cs_spfree((*N)->U); - (*N)->U = cs_transpose(T, 1); - if (!(*N)->U) - FREE_AND_RETURN_ZERO; - T = cs_spfree(T); +static +int dgCMatrix_orf_(const Matrix_cs *A, Matrix_css **S, Matrix_csn **N, + int order) +{ + Matrix_cs *T = NULL; + if (!(*S = Matrix_cs_sqr(order, A, 1)) || + !(*N = Matrix_cs_qr(A, *S))) { + DO_FREE(T, *S, *N); + return 0; + } + DO_SORT((*N)->L); + DO_SORT((*N)->U); return 1; } @@ -754,24 +449,27 @@ SEXP val = get_factor(obj, (order_) ? "sparseQR~" : "sparseQR"); if (!isNull(val)) return val; - PROTECT(val = NEW_OBJECT_OF_CLASS("sparseQR")); + PROTECT(val = newObject("sparseQR")); + + Matrix_cs *A = M2CXS(obj, 1); + MCS_XTYPE_SET(A->xtype); + + Matrix_css *S = NULL; + Matrix_csn *N = NULL; + int *P = NULL; - const cs *A = dgC2cs(obj); - css *S = NULL; - csn *N = NULL; - int *pp = NULL; if (A->m < A->n) error(_("QR factorization of m-by-n %s requires m >= n"), - "dgCMatrix"); + ".gCMatrix"); if (!dgCMatrix_orf_(A, &S, &N, order_) || - !(pp = cs_pinv(S->pinv, S->m2))) { - if (!pp) { - S = cs_sfree(S); - N = cs_nfree(N); + !(P = Matrix_cs_pinv(S->pinv, S->m2))) { + if (!P) { + S = Matrix_cs_sfree(S); + N = Matrix_cs_nfree(N); } if (asLogical(doError)) error(_("QR factorization of %s failed: out of memory"), - "dgCMatrix"); + ".gCMatrix"); /* Defensive code will check with is(., "sparseQR") : */ UNPROTECT(1); /* val */ return ScalarLogical(NA_LOGICAL); @@ -785,43 +483,49 @@ SET_SLOT(val, Matrix_DimNamesSym, dimnames); UNPROTECT(1); /* dimnames */ - SEXP V = PROTECT(cs2dgC(N->L, "dgCMatrix")), - R = PROTECT(cs2dgC(N->U, "dgCMatrix")); + SEXP V = PROTECT(CXS2M(N->L, 1, 'g')), + R = PROTECT(CXS2M(N->U, 1, 'g')); SET_SLOT(val, Matrix_VSym, V); SET_SLOT(val, Matrix_RSym, R); UNPROTECT(2); /* R, V */ SEXP beta = PROTECT(allocVector(REALSXP, A->n)); - double *pbeta = N->B; - Matrix_memcpy(REAL(beta), pbeta, A->n, sizeof(double)); + Matrix_memcpy(REAL(beta), N->B, A->n, sizeof(double)); SET_SLOT(val, Matrix_betaSym, beta); UNPROTECT(1); /* beta */ SEXP p = PROTECT(allocVector(INTSXP, S->m2)); - Matrix_memcpy(INTEGER(p), pp, S->m2, sizeof(int)); + Matrix_memcpy(INTEGER(p), P, S->m2, sizeof(int)); SET_SLOT(val, Matrix_pSym, p); UNPROTECT(1); /* p */ if (order_ > 0) { SEXP q = PROTECT(allocVector(INTSXP, A->n)); - int *pq = S->q; - Matrix_memcpy(INTEGER(q), pq, A->n, sizeof(int)); + Matrix_memcpy(INTEGER(q), S->q, A->n, sizeof(int)); SET_SLOT(val, Matrix_qSym, q); UNPROTECT(1); /* q */ } - S = cs_sfree(S); - N = cs_nfree(N); - pp = cs_free(pp); + S = Matrix_cs_sfree(S); + N = Matrix_cs_nfree(N); + P = Matrix_cs_free(P); set_factor(obj, (order_) ? "sparseQR~" : "sparseQR", val); UNPROTECT(1); /* val */ return val; } +#undef DO_FREE +#undef DO_SORT + +static int dpCMatrix_trf_(cholmod_sparse *A, cholmod_factor **L, int perm, int ldl, int super, double mult) { - CHM_store_common(); + /* defined in ./chm_common.c : */ + void R_cholmod_common_envget(void); + void R_cholmod_common_envset(void); + + R_cholmod_common_envset(); if (*L == NULL) { if (perm == 0) { @@ -850,9 +554,9 @@ double beta[2]; beta[0] = mult; beta[1] = 0.0; - int res = cholmod_factorize_p(A, beta, (int *) NULL, 0, *L, &c); + int res = cholmod_factorize_p(A, beta, NULL, 0, *L, &c); - CHM_restore_common(); + R_cholmod_common_envget(); return res; } @@ -889,16 +593,15 @@ PROTECT_INDEX pid; PROTECT_WITH_INDEX(trf, &pid); - cholmod_sparse *A = dgC2cholmod(obj); + cholmod_sparse *A = M2CHS(obj, 1); cholmod_factor *L = NULL; - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); char ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ A->stype = (ul == 'U') ? 1 : -1; if (cached) { - L = mf2cholmod(trf); + L = M2CHF(trf, 1); L = cholmod_copy_factor(L, &c); dpCMatrix_trf_(A, &L, perm_, ldl_, super_, mult_); } else { @@ -908,7 +611,7 @@ nm[2] = (L->is_ll ) ? 'd' : 'D'; } } - REPROTECT(trf = cholmod2mf(L), pid); + REPROTECT(trf = CHF2M(L, 1), pid); cholmod_free_factor(&L, &c); SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); @@ -923,9 +626,9 @@ SEXP BunchKaufman_expand(SEXP obj, SEXP packed) { - SEXP P_ = PROTECT(NEW_OBJECT_OF_CLASS("pMatrix")), - T_ = PROTECT(NEW_OBJECT_OF_CLASS("dtCMatrix")), - D_ = PROTECT(NEW_OBJECT_OF_CLASS("dsCMatrix")), + SEXP P_ = PROTECT(newObject("pMatrix")), + T_ = PROTECT(newObject("dtCMatrix")), + D_ = PROTECT(newObject("dsCMatrix")), dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); int i, j, s, n = INTEGER(dim)[0]; R_xlen_t n1a = (R_xlen_t) n + 1; @@ -1095,1089 +798,9 @@ return res; } -static SEXP mkDet(double modulus, int logarithm, int sign) -{ - SEXP nms = PROTECT(allocVector(STRSXP, 2)), - cl = PROTECT(mkString("det")), - det = PROTECT(allocVector(VECSXP, 2)), - det0 = PROTECT(ScalarReal((logarithm) ? modulus : exp(modulus))), - det1 = PROTECT(ScalarInteger(sign)), - det0a = PROTECT(ScalarLogical(logarithm)); - SET_STRING_ELT(nms, 0, mkChar("modulus")); - SET_STRING_ELT(nms, 1, mkChar("sign")); - setAttrib(det, R_NamesSymbol, nms); - setAttrib(det, R_ClassSymbol, cl); - setAttrib(det0, install("logarithm"), det0a); - SET_VECTOR_ELT(det, 0, det0); - SET_VECTOR_ELT(det, 1, det1); - UNPROTECT(6); - return det; -} - -SEXP denseLU_determinant(SEXP obj, SEXP logarithm) -{ - -#define DETERMINANT_START(_MAYBE_NOT_SQUARE_) \ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int *pdim = INTEGER(dim), n = pdim[0]; \ - if ((_MAYBE_NOT_SQUARE_) && pdim[1] != n) \ - error(_("determinant of non-square matrix is undefined")); \ - UNPROTECT(1); /* dim */ \ - int givelog = asLogical(logarithm) != 0, sign = 1; \ - double modulus = 0.0; /* result for n == 0 */ - - DETERMINANT_START(1); - if (n > 0) { - SEXP pivot = PROTECT(GET_SLOT(obj, Matrix_permSym)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int j, *ppivot = INTEGER(pivot); - R_xlen_t n1a = (R_xlen_t) n + 1; - double *px = REAL(x); - - for (j = 0; j < n; ++j, px += n1a, ++ppivot) { - if (*px < 0.0) { - modulus += log(-(*px)); - if (*ppivot == j + 1) - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(*px); - if (*ppivot != j + 1) - sign = -sign; - } - } - UNPROTECT(2); /* x, pivot */ - } - return mkDet(modulus, givelog, sign); -} - -SEXP BunchKaufman_determinant(SEXP obj, SEXP logarithm, SEXP packed) -{ - DETERMINANT_START(0); - if (n > 0) { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int upper = *CHAR(STRING_ELT(uplo, 0)) == 'U'; - UNPROTECT(1); /* uplo */ - - SEXP pivot = PROTECT(GET_SLOT(obj, Matrix_permSym)), - x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int j = 0, unpacked = !asLogical(packed), - *ppivot = INTEGER(pivot); - R_xlen_t n1a = (R_xlen_t) n + 1; - double *px = REAL(x), a, b, c, logab, logcc; - while (j < n) { - if (ppivot[j] > 0) { - if (*px < 0.0) { - modulus += log(-(*px)); - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(*px); - } - px += (unpacked) ? n1a : ((upper) ? j + 2 : n - j); - j += 1; - } else { - a = *px; - if (upper) { - px += (unpacked) ? n1a : j + 2; - b = *px; - c = *(px - 1); - px += (unpacked) ? n1a : j + 3; - } else { - c = *(px + 1); - px += (unpacked) ? n1a : n - j; - b = *px; - px += (unpacked) ? n1a : n - j - 1; - } - logab = log(fabs(a)) + log(fabs(b)); - logcc = 2.0 * log(fabs(c)); - if ((a < 0.0) != (b < 0.0)) { - /* det = ab - cc = -(abs(ab) + cc) < 0 */ - modulus += logspace_add(logab, logcc); - sign = -sign; - } else if (logab < logcc) { - /* det = ab - cc = -(cc - ab) < 0 */ - modulus += logspace_sub(logcc, logab); - sign = -sign; - } else { - /* det = ab - cc > 0 */ - modulus += logspace_sub(logab, logcc); - } - j += 2; - } - } - UNPROTECT(2); /* x, pivot */ - } - return mkDet(modulus, givelog, sign); -} - -SEXP Cholesky_determinant(SEXP obj, SEXP logarithm, SEXP packed) -{ - DETERMINANT_START(0); - if (n > 0) { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int upper = *CHAR(STRING_ELT(uplo, 0)) == 'U'; - UNPROTECT(1); /* uplo */ - - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - int j, unpacked = !asLogical(packed); - R_xlen_t n1a = (R_xlen_t) n + 1; - double *px = REAL(x); - for (j = 0; j < n; ++j) { - if (*px < 0.0) { - modulus += log(-(*px)); - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(*px); - } - px += (unpacked) ? n1a : ((upper) ? j + 2 : n - j); - } - modulus *= 2.0; - UNPROTECT(1); /* x */ - } - return mkDet(modulus, givelog, sign); -} - -SEXP sparseLU_determinant(SEXP obj, SEXP logarithm) -{ - DETERMINANT_START(0); - if (n > 0) { - SEXP U = PROTECT(GET_SLOT(obj, Matrix_USym)), - p = PROTECT(GET_SLOT(U, Matrix_pSym)), - i = PROTECT(GET_SLOT(U, Matrix_iSym)), - x = PROTECT(GET_SLOT(U, Matrix_xSym)); - int *pp = INTEGER(p), *pi = INTEGER(i), j, k = 0, kend; - double *px = REAL(x); - - for (j = 0; j < n; ++j) { - kend = *(++pp); - if (kend > k && pi[kend - 1] == j) { - if (px[kend - 1] < 0.0) { - modulus += log(-px[kend - 1]); - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(px[kend - 1]); - } - } else { - UNPROTECT(4); /* x, i, p, U */ - return mkDet(R_NegInf, givelog, 1); - } - k = kend; - } - UNPROTECT(4); /* x, i, p, U */ - - PROTECT(p = GET_SLOT(obj, Matrix_pSym)); - if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) - sign = -sign; - UNPROTECT(1); /* p */ - PROTECT(p = GET_SLOT(obj, Matrix_qSym)); - if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) - sign = -sign; - UNPROTECT(1); /* p */ - } - return mkDet(modulus, givelog, sign); -} - -SEXP sparseQR_determinant(SEXP obj, SEXP logarithm) -{ - DETERMINANT_START(1); - if (n > 0) { - SEXP R = PROTECT(GET_SLOT(obj, Matrix_RSym)); - PROTECT(dim = GET_SLOT(R, Matrix_DimSym)); - if (INTEGER(dim)[0] > n) - error(_("%s(<%s>) does not support structurally rank deficient case"), - "determinant", "sparseQR"); - UNPROTECT(1); /* dim */ - - SEXP p = PROTECT(GET_SLOT(R, Matrix_pSym)), - i = PROTECT(GET_SLOT(R, Matrix_iSym)), - x = PROTECT(GET_SLOT(R, Matrix_xSym)); - int *pp = INTEGER(p), *pi = INTEGER(i), j, k = 0, kend; - double *px = REAL(x); - - for (j = 0; j < n; ++j) { - kend = *(++pp); - if (kend > k && pi[kend - 1] == j) { - if (px[kend - 1] < 0.0) { - modulus += log(-px[kend - 1]); - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(px[kend - 1]); - } - } else { - UNPROTECT(4); /* x, i, p, R */ - return mkDet(R_NegInf, givelog, 1); - } - k = kend; - } - UNPROTECT(4); /* x, i, p, U */ - - PROTECT(p = GET_SLOT(obj, Matrix_pSym)); - if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) - sign = -sign; - UNPROTECT(1); /* p */ - PROTECT(p = GET_SLOT(obj, Matrix_qSym)); - if (signPerm(INTEGER(p), LENGTH(p), 0) < 0) - sign = -sign; - UNPROTECT(1); /* p */ - if (n % 2) - sign = -sign; - } - return mkDet(modulus, givelog, sign); -} - -SEXP CHMfactor_determinant(SEXP obj, SEXP logarithm, SEXP sqrt) -{ - DETERMINANT_START(0); - if (n > 0) { - int sqrt_ = asLogical(sqrt); - cholmod_factor *L = mf2cholmod(obj); - if (L->is_super) { - int k, j, nc, - nsuper = (int) L->nsuper, - *psuper = (int *) L->super, - *ppi = (int *) L->pi, - *ppx = (int *) L->px; - double *px = (double *) L->x, *px_; - R_xlen_t nr1a; - for (k = 0; k < nsuper; ++k) { - nc = psuper[k+1] - psuper[k]; - nr1a = (R_xlen_t) (ppi[k+1] - ppi[k]) + 1; - px_ = px + ppx[k]; - for (j = 0; j < nc; ++j) { - modulus += log(*px_); - px_ += nr1a; - } - } - modulus *= 2.0; - } else { - int j, *pp = (int *) L->p; - double *px = (double *) L->x; - if (L->is_ll) { - for (j = 0; j < n; ++j) - modulus += log(px[pp[j]]); - modulus *= 2.0; - } else { - for (j = 0; j < n; ++j) { - if (px[pp[j]] < 0.0) { - if (sqrt_) - return mkDet(R_NaN, givelog, 1); - modulus += log(-px[pp[j]]); - sign = -sign; - } else { - /* incl. 0, NaN cases */ - modulus += log(px[pp[j]]); - } - } - } - } - if (sqrt_) - modulus *= 0.5; - } - return mkDet(modulus, givelog, sign); -} - -static void solveDN(SEXP rdn, SEXP adn, SEXP bdn) -{ - SEXP s; - if (!isNull(s = VECTOR_ELT(adn, 1))) - SET_VECTOR_ELT(rdn, 0, s); - if (!isNull(s = VECTOR_ELT(bdn, 1))) - SET_VECTOR_ELT(rdn, 1, s); - PROTECT(adn = getAttrib(adn, R_NamesSymbol)); - PROTECT(bdn = getAttrib(bdn, R_NamesSymbol)); - if(!isNull(adn) || !isNull(bdn)) { - PROTECT(s = allocVector(STRSXP, 2)); - if (!isNull(adn)) - SET_STRING_ELT(s, 0, STRING_ELT(adn, 1)); - if (!isNull(bdn)) - SET_STRING_ELT(s, 1, STRING_ELT(bdn, 1)); - setAttrib(rdn, R_NamesSymbol, s); - UNPROTECT(1); - } - UNPROTECT(2); - return; -} - -SEXP denseLU_solve(SEXP a, SEXP b) -{ - -#define SOLVE_START(_MAYBE_NOT_SQUARE_) \ - SEXP adim = PROTECT(GET_SLOT(a, Matrix_DimSym)); \ - int *padim = INTEGER(adim), m = padim[0], n = m; \ - if ((_MAYBE_NOT_SQUARE_) && padim[1] != m) \ - error(_("'%s' is not square"), "a"); \ - UNPROTECT(1); /* adim */ \ - if (!isNull(b)) { \ - SEXP bdim = PROTECT(GET_SLOT(b, Matrix_DimSym)); \ - int *pbdim = INTEGER(bdim); \ - if (pbdim[0] != m) \ - error(_("dimensions of '%s' and '%s' are inconsistent"), \ - "a", "b"); \ - n = pbdim[1]; \ - UNPROTECT(1); /* bdim */ \ - } - -#define SOLVE_FINISH \ - SEXP rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)), \ - adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)); \ - if (isNull(b)) \ - revDN(rdimnames, adimnames); \ - else { \ - SEXP bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)); \ - solveDN(rdimnames, adimnames, bdimnames); \ - UNPROTECT(1); /* bdimnames */ \ - } \ - UNPROTECT(2); /* adimnames, rdimnames */ - - SOLVE_START(1); - SEXP r = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), - rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - if (m > 0) { - SEXP rx, ax = PROTECT(GET_SLOT(a, Matrix_xSym)), - apivot = PROTECT(GET_SLOT(a, Matrix_permSym)); - int info; - if (isNull(b)) { - PROTECT(rx = duplicate(ax)); - int lwork = -1; - double work0, *work = &work0; - F77_CALL(dgetri)(&m, REAL(rx), &m, INTEGER(apivot), - work, &lwork, &info); - ERROR_LAPACK_1(dgetri, info); - lwork = (int) work0; - work = (double *) R_alloc((size_t) lwork, sizeof(double)); - F77_CALL(dgetri)(&m, REAL(rx), &m, INTEGER(apivot), - work, &lwork, &info); - ERROR_LAPACK_2(dgetri, info, 2, U); - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - rx = duplicate(bx); - UNPROTECT(1); /* bx */ - PROTECT(rx); - F77_CALL(dgetrs)("N", &m, &n, REAL(ax), &m, INTEGER(apivot), - REAL(rx), &m, &info FCONE); - ERROR_LAPACK_1(dgetrs, info); - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(3); /* rx, apivot, ax */ - } - SOLVE_FINISH; - UNPROTECT(2); /* rdim, r */ - return r; -} - -SEXP BunchKaufman_solve(SEXP a, SEXP b, SEXP packed) -{ - SOLVE_START(0); - int unpacked = !asLogical(packed); - const char *cl = (!isNull(b)) ? "dgeMatrix" : - ((unpacked) ? "dsyMatrix" : "dspMatrix"); - SEXP r = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)), - auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - if (isNull(b)) - SET_SLOT(r, Matrix_uploSym, auplo); - if (m > 0) { - SEXP rx, ax = PROTECT(GET_SLOT(a, Matrix_xSym)), - apivot = PROTECT(GET_SLOT(a, Matrix_permSym)); - char ul = *CHAR(STRING_ELT(auplo, 0)); - int info; - if (isNull(b)) { - PROTECT(rx = duplicate(ax)); - double *work = (double *) R_alloc((size_t) m, sizeof(double)); - if (unpacked) { - F77_CALL(dsytri)(&ul, &m, REAL(rx), &m, INTEGER(apivot), - work, &info FCONE); - ERROR_LAPACK_2(dsytri, info, 2, D); - } else { - F77_CALL(dsptri)(&ul, &m, REAL(rx), INTEGER(apivot), - work, &info FCONE); - ERROR_LAPACK_2(dsptri, info, 2, D); - } - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - rx = duplicate(bx); - UNPROTECT(1); /* bx */ - PROTECT(rx); - if (unpacked) { - F77_CALL(dsytrs)(&ul, &m, &n, REAL(ax), &m, - INTEGER(apivot), - REAL(rx), &m, &info FCONE); - ERROR_LAPACK_1(dsytrs, info); - } else { - F77_CALL(dsptrs)(&ul, &m, &n, REAL(ax), - INTEGER(apivot), - REAL(rx), &m, &info FCONE); - ERROR_LAPACK_1(dsptrs, info); - } - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(3); /* rx, apivot, ax */ - } - SOLVE_FINISH; - UNPROTECT(3); /* auplo, rdim, r */ - return r; -} - -SEXP Cholesky_solve(SEXP a, SEXP b, SEXP packed) -{ - SOLVE_START(0); - int unpacked = !asLogical(packed); - const char *cl = (!isNull(b)) ? "dgeMatrix" : - ((unpacked) ? "dpoMatrix" : "dppMatrix"); - SEXP r = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)), - auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - if (isNull(b)) - SET_SLOT(r, Matrix_uploSym, auplo); - if (m > 0) { - SEXP rx, ax = PROTECT(GET_SLOT(a, Matrix_xSym)); - char ul = *CHAR(STRING_ELT(auplo, 0)); - int info, nprotect = 2; - - SEXP aperm = NULL; - if (HAS_SLOT(a, Matrix_permSym)) { - SEXP tmp = GET_SLOT(a, Matrix_permSym); - if (LENGTH(tmp) > 0) { - PROTECT(aperm = tmp); - ++nprotect; - } - } /* else 'a' is a dtrMatrix or dtpMatrix, as in chol2inv */ - - if (isNull(b)) { - PROTECT(rx = duplicate(ax)); - SET_SLOT(r, Matrix_uploSym, auplo); - if (unpacked) { - F77_CALL(dpotri)(&ul, &m, REAL(rx), &m, &info FCONE); - ERROR_LAPACK_2(dpotri, info, 2, L); - if (aperm) - symPerm(REAL(rx), n, ul, INTEGER(aperm), 1, 1); - } else { - F77_CALL(dpptri)(&ul, &m, REAL(rx), &info FCONE); - ERROR_LAPACK_2(dpptri, info, 2, L); - if (aperm) { - /* FIXME: symPerm() supporting packed matrices */ - double *work; - size_t lwork = (size_t) n * n; - Matrix_Calloc(work, lwork, double); - ddense_unpack(work, REAL(rx), n, ul, 'N'); - symPerm(work, n, ul, INTEGER(aperm), 1, 1); - ddense_pack (REAL(rx), work, n, ul, 'N'); - Matrix_Free(work, lwork); - } - } - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - rx = duplicate(bx); - UNPROTECT(1); /* bx */ - PROTECT(rx); - if (aperm) - rowPerm(REAL(rx), m, n, INTEGER(aperm), 1, 0); - if (unpacked) { - F77_CALL(dpotrs)(&ul, &m, &n, REAL(ax), &m, - REAL(rx), &m, &info FCONE); - ERROR_LAPACK_1(dpotrs, info); - } else { - F77_CALL(dpptrs)(&ul, &m, &n, REAL(ax), - REAL(rx), &m, &info FCONE); - ERROR_LAPACK_1(dpptrs, info); - } - if (aperm) - rowPerm(REAL(rx), m, n, INTEGER(aperm), 1, 1); - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(nprotect); /* rx, aperm, ax */ - } - SOLVE_FINISH; - UNPROTECT(3); /* auplo, rdim, r */ - return r; -} - -SEXP sparseLU_solve(SEXP a, SEXP b, SEXP sparse) -{ - -#define ERROR_SOLVE_OOM(_A_, _B_) \ - error(_("%s(<%s>, <%s>) failed: out of memory"), "solve", #_A_, #_B_) - - SOLVE_START(0); - SEXP r, - aL = PROTECT(GET_SLOT(a, Matrix_LSym)), - aU = PROTECT(GET_SLOT(a, Matrix_USym)), - ap = PROTECT(GET_SLOT(a, Matrix_pSym)), - aq = PROTECT(GET_SLOT(a, Matrix_qSym)); - int j, - *pap = INTEGER(ap), - *paq = (LENGTH(aq)) ? INTEGER(aq) : (int *) NULL; - double *work = (double *) R_alloc((size_t) m, sizeof(double)); - cs *L = dgC2cs(aL), *U = dgC2cs(aU); - if (!asLogical(sparse)) { - PROTECT(r = NEW_OBJECT_OF_CLASS("dgeMatrix")); - SEXP rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - UNPROTECT(1); /* rdim */ - R_xlen_t mn = (R_xlen_t) m * n; - SEXP rx = PROTECT(allocVector(REALSXP, mn)); - double *prx = REAL(rx); - if (isNull(b)) { - Matrix_memset(prx, 0, mn, sizeof(double)); - for (j = 0; j < n; ++j) { - prx[j] = 1.0; - cs_pvec(pap, prx, work, m); - cs_lsolve(L, work); - cs_usolve(U, work); - cs_ipvec(paq, work, prx, m); - prx += m; - } - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - double *pbx = REAL(bx); - for (j = 0; j < n; ++j) { - cs_pvec(pap, pbx, work, m); - cs_lsolve(L, work); - cs_usolve(U, work); - cs_ipvec(paq, work, prx, m); - prx += m; - pbx += m; - } - UNPROTECT(1); /* bx */ - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(1); /* rx */ - } else { - cs *B, *X; - int *papinv = cs_pinv(pap, m); - if (!papinv) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - if (isNull(b)) { - B = cs_spalloc(m, n, n, 1, 0); - if (!B) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - for (j = 0; j < n; ++j) { - B->p[j] = j; - B->i[j] = j; - B->x[j] = 1.0; - } - B->p[n] = n; - X = cs_permute( B, papinv, (int *) NULL, 1); - B = cs_spfree(B); - } else - X = cs_permute(dgC2cs(b), papinv, (int *) NULL, 1); - papinv = cs_free(papinv); - if (!X) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - B = X; - - int i, k, top, nz, nzmax, - *iwork = (int *) R_alloc((size_t) 2 * m, sizeof(int)); - -#define DO_TRIANGULAR_SOLVE(_A_, _LOA_, _FRB_, _CLA_, _CLB_) \ - do { \ - X = cs_spalloc(m, n, B->nzmax, 1, 0); \ - if (!X) { \ - if (_FRB_) \ - B = cs_spfree(B); \ - ERROR_SOLVE_OOM(_CLA_, _CLB_); \ - } \ - X->p[0] = nz = 0; \ - nzmax = X->nzmax; \ - for (j = 0, k = 0; j < n; ++j) { \ - top = cs_spsolve(_A_, B, j, iwork, work, (int *) NULL, _LOA_); \ - if (m - top > INT_MAX - nz) { \ - if (_FRB_) \ - B = cs_spfree(B); \ - X = cs_spfree(X); \ - error(_("attempt to construct sparse matrix with more than %s nonzero elements"), \ - "2^31-1"); \ - } \ - nz += m - top; \ - if (nz > nzmax) { \ - nzmax = (nz <= INT_MAX / 2) ? 2 * nz : INT_MAX; \ - if (!cs_sprealloc(X, nzmax)) { \ - if (_FRB_) \ - B = cs_spfree(B); \ - X = cs_spfree(X); \ - ERROR_SOLVE_OOM(_CLA_, _CLB_); \ - } \ - } \ - X->p[j + 1] = nz; \ - if (_LOA_) { \ - for (i = top; i < m; ++i) { \ - X->i[k] = iwork[i]; \ - X->x[k] = work[iwork[i]]; \ - ++k; \ - } \ - } else { \ - for (i = m - 1; i >= top; --i) { \ - X->i[k] = iwork[i]; \ - X->x[k] = work[iwork[i]]; \ - ++k; \ - } \ - } \ - } \ - if (_FRB_) \ - B = cs_spfree(B); \ - B = X; \ - } while (0) - - DO_TRIANGULAR_SOLVE(L, 1, 1, sparseLU, dgCMatrix); - DO_TRIANGULAR_SOLVE(U, 0, 1, sparseLU, dgCMatrix); - - if (paq) { - X = cs_permute(B, paq, (int *) NULL, 1); - B = cs_spfree(B); - if (!X) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - B = X; - } - - /* Drop zeros from B and sort it : */ - cs_dropzeros(B); - X = cs_transpose(B, 1); - B = cs_spfree(B); - if (!X) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - B = cs_transpose(X, 1); - X = cs_spfree(X); - if (!B) - ERROR_SOLVE_OOM(sparseLU, dgCMatrix); - - PROTECT(r = cs2dgC(B, "dgCMatrix")); - B = cs_spfree(B); - } - SOLVE_FINISH; - UNPROTECT(5); /* r, aq, ap, aU, aL */ - return r; -} - -/* MJ: not needed since we have 'sparseQR_matmult' : */ -#if 0 - -SEXP sparseQR_solve(SEXP a, SEXP b, SEXP sparse) -{ - return R_NilValue; -} - -#endif /* MJ */ - -SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP sparse, SEXP system) -{ - /* see top of : - ./CHOLMOD/Cholesky/cholmod_solve.c - ./CHOLMOD/Cholesky/cholmod_spsolve.c - */ - static const char *valid[] = { - "A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt", "" }; - int ivalid = -1; - if (TYPEOF(system) != STRSXP || LENGTH(system) < 1 || - (system = STRING_ELT(system, 0)) == NA_STRING || - (ivalid = strmatch(CHAR(system), valid)) < 0) - error(_("invalid '%s' to %s()"), "system", __func__); - SOLVE_START(0); - SEXP r; - int j; - cholmod_factor *L = mf2cholmod(a); - if (!asLogical(sparse)) { - cholmod_dense *B, *X; - if (isNull(b)) { - B = cholmod_allocate_dense(m, n, m, CHOLMOD_REAL, &c); - if (!B) - ERROR_SOLVE_OOM(CHMfactor, dgeMatrix); - R_xlen_t m1a = (R_xlen_t) m + 1; - double *px = (double *) B->x; - Matrix_memset(px, 0, (R_xlen_t) m * n, sizeof(double)); - for (j = 0; j < n; ++j) { - *px = 1.0; - px += m1a; - } - X = cholmod_solve(ivalid, L, B, &c); - if (!X) - ERROR_SOLVE_OOM(CHMfactor, dgeMatrix); - cholmod_free_dense(&B, &c); - const char *cl = (ivalid < 2) ? "dpoMatrix" : - ((ivalid < 7) ? "dtrMatrix" : "dgeMatrix"); - PROTECT(r = cholmod2dge(X, cl)); - } else { - B = dge2cholmod(b); - X = cholmod_solve(ivalid, L, B, &c); - if (!X) - ERROR_SOLVE_OOM(CHMfactor, dgeMatrix); - PROTECT(r = cholmod2dge(X, "dgeMatrix")); - } - cholmod_free_dense(&X, &c); - } else { - cholmod_sparse *B, *X; - if (isNull(b)) { - B = cholmod_allocate_sparse(m, n, n, 1, 1, 0, CHOLMOD_REAL, &c); - if (!B) - ERROR_SOLVE_OOM(CHMfactor, dgCMatrix); - int *pp = (int *) B->p, *pi = (int *) B->i; - double *px = (double *) B->x; - for (j = 0; j < n; ++j) { - pp[j] = j; - pi[j] = j; - px[j] = 1.0; - } - pp[n] = n; - X = cholmod_spsolve(ivalid, L, B, &c); - if (!X) - ERROR_SOLVE_OOM(CHMfactor, dgCMatrix); - cholmod_free_sparse(&B, &c); - if (ivalid < 7) { - X->stype = (ivalid == 2 || ivalid == 4) ? -1 : 1; - cholmod_sort(X, &c); - if (!X) - ERROR_SOLVE_OOM(CHMfactor, dgCMatrix); - } - const char *cl = (ivalid < 2) ? "dsCMatrix" : - ((ivalid < 7) ? "dtCMatrix" : "dgCMatrix"); - PROTECT(r = cholmod2dgC(X, cl)); - } else { - B = dgC2cholmod(b); - X = cholmod_spsolve(ivalid, L, B, &c); - if (!X) - ERROR_SOLVE_OOM(CHMfactor, dgCMatrix); - PROTECT(r = cholmod2dgC(X, "dgCMatrix")); - } - cholmod_free_sparse(&X, &c); - } - if (isNull(b) && (ivalid == 2 || ivalid == 4)) { - SEXP uplo = PROTECT(mkString("L")); - SET_SLOT(r, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - } - SOLVE_FINISH; - UNPROTECT(1); /* r */ - return r; -} - -SEXP dtrMatrix_solve(SEXP a, SEXP b, SEXP packed) -{ - SOLVE_START(0); - int unpacked = !asLogical(packed); - const char *cl = (!isNull(b)) ? "dgeMatrix" : - ((unpacked) ? "dtrMatrix" : "dtpMatrix"); - SEXP r = PROTECT(NEW_OBJECT_OF_CLASS(cl)), - rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)), - auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)), - adiag = PROTECT(GET_SLOT(a, Matrix_diagSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - if (isNull(b)) { - SET_SLOT(r, Matrix_uploSym, auplo); - SET_SLOT(r, Matrix_diagSym, adiag); - } - if (m > 0) { - SEXP rx, ax = PROTECT(GET_SLOT(a, Matrix_xSym)); - char ul = *CHAR(STRING_ELT(auplo, 0)), - di = *CHAR(STRING_ELT(adiag, 0)); - int info; - if (isNull(b)) { - PROTECT(rx = duplicate(ax)); - SET_SLOT(r, Matrix_uploSym, auplo); - SET_SLOT(r, Matrix_diagSym, adiag); - if (unpacked) { - F77_CALL(dtrtri)(&ul, &di, &m, REAL(rx), &m, - &info FCONE FCONE); - ERROR_LAPACK_2(dtrtri, info, 2, A); - } else { - F77_CALL(dtptri)(&ul, &di, &m, REAL(rx), - &info FCONE FCONE); - ERROR_LAPACK_2(dtptri, info, 2, A); - } - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - rx = duplicate(bx); - UNPROTECT(1); /* bx */ - PROTECT(rx); - if (unpacked) { - F77_CALL(dtrtrs)(&ul, "N", &di, &m, &n, REAL(ax), &m, - REAL(rx), &m, &info FCONE FCONE FCONE); - ERROR_LAPACK_1(dtrtrs, info); - } else { - // https://bugs.r-project.org/show_bug.cgi?id=18534 - F77_CALL(dtptrs)(&ul, "N", &di, &m, &n, REAL(ax), - REAL(rx), &m, &info -#ifdef usePR18534fix - FCONE FCONE FCONE); -#else - FCONE FCONE); -#endif - ERROR_LAPACK_1(dtptrs, info); - } - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(2); /* rx, ax */ - } - SOLVE_FINISH; - UNPROTECT(4); /* adiag, auplo, rdim, r */ - return r; -} - -SEXP dtCMatrix_solve(SEXP a, SEXP b, SEXP sparse) -{ - SOLVE_START(0); - SEXP r, auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(auplo, 0)); - int j; - cs *A = dgC2cs(a); - if (!asLogical(sparse)) { - const char *cl = (isNull(b)) ? "dtrMatrix" : "dgeMatrix"; - PROTECT(r = NEW_OBJECT_OF_CLASS(cl)); - - SEXP rdim = PROTECT(GET_SLOT(r, Matrix_DimSym)); - int *prdim = INTEGER(rdim); - prdim[0] = m; - prdim[1] = n; - UNPROTECT(1); /* rdim */ - - R_xlen_t mn = (R_xlen_t) m * n; - SEXP rx = PROTECT(allocVector(REALSXP, mn)); - double *prx = REAL(rx); - if (isNull(b)) { - Matrix_memset(prx, 0, mn, sizeof(double)); - for (j = 0; j < n; ++j) { - prx[j] = 1.0; - if (ul == 'U') - cs_usolve(A, prx); - else - cs_lsolve(A, prx); - prx += m; - } - } else { - SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); - double *pbx = REAL(bx); - Matrix_memcpy(prx, pbx, mn, sizeof(double)); - UNPROTECT(1); /* bx */ - for (j = 0; j < n; ++j) { - if (ul == 'U') - cs_usolve(A, prx); - else - cs_lsolve(A, prx); - prx += m; - } - } - SET_SLOT(r, Matrix_xSym, rx); - UNPROTECT(1); /* rx */ - } else { - const char *cl = (isNull(b)) ? "dtCMatrix" : "dgCMatrix"; - cs *B, *X; - - if (isNull(b)) { - B = cs_spalloc(m, n, n, 1, 0); - if (!B) - ERROR_SOLVE_OOM(dtCMatrix, dgCMatrix); - for (j = 0; j < n; ++j) { - B->p[j] = j; - B->i[j] = j; - B->x[j] = 1.0; - } - B->p[n] = n; - } else - B = dgC2cs(b); - - int i, k, top, nz, nzmax, - *iwork = (int *) R_alloc((size_t) 2 * m, sizeof(int)); - double *work = (double *) R_alloc((size_t) m, sizeof(double)); - - DO_TRIANGULAR_SOLVE(A, ul != 'U', isNull(b), dtCMatrix, dgCMatrix); - - /* Drop zeros from B and sort it : */ - cs_dropzeros(B); - X = cs_transpose(B, 1); - B = cs_spfree(B); - if (!X) - ERROR_SOLVE_OOM(dtCMatrix, dgCMatrix); - B = cs_transpose(X, 1); - X = cs_spfree(X); - if (!B) - ERROR_SOLVE_OOM(dtCMatrix, dgCMatrix); - - PROTECT(r = cs2dgC(B, cl)); - B = cs_spfree(B); - } - if (isNull(b)) - SET_SLOT(r, Matrix_uploSym, auplo); - SOLVE_FINISH; - UNPROTECT(2); /* r, auplo */ - return r; -} - -SEXP sparseQR_matmult(SEXP qr, SEXP y, SEXP op, SEXP complete, SEXP yxjj) -{ - SEXP V = PROTECT(GET_SLOT(qr, Matrix_VSym)), - beta = PROTECT(GET_SLOT(qr, Matrix_betaSym)), - p = PROTECT(GET_SLOT(qr, Matrix_pSym)); - const cs *V_ = dgC2cs(V); - double *pbeta = REAL(beta); - int m = V_->m, r = V_->n, n, i, j, op_ = asInteger(op), - *pp = INTEGER(p), nprotect = 6; - - SEXP yx; - double *pyx; - if (isNull(y)) { - n = (asLogical(complete)) ? m : r; - - R_xlen_t mn = (R_xlen_t) m * n, m1a = (R_xlen_t) m + 1; - PROTECT(yx = allocVector(REALSXP, mn)); - pyx = REAL(yx); - Matrix_memset(pyx, 0, mn, sizeof(double)); - - if (isNull(yxjj)) { - for (j = 0; j < n; ++j) { - *pyx = 1.0; - pyx += m1a; - } - } else if (TYPEOF(yxjj) == REALSXP && XLENGTH(yxjj) >= n) { - double *pyxjj = REAL(yxjj); - for (j = 0; j < n; ++j) { - *pyx = *pyxjj; - pyx += m1a; - pyxjj += 1; - } - } else - error(_("invalid '%s' to %s()"), "yxjj", __func__); - } else { - SEXP ydim = PROTECT(GET_SLOT(y, Matrix_DimSym)); - int *pydim = INTEGER(ydim); - if (pydim[0] != m) - error(_("dimensions of '%s' and '%s' are inconsistent"), - "qr", "y"); - n = pydim[1]; - UNPROTECT(1); /* ydim */ - - PROTECT(yx = GET_SLOT(y, Matrix_xSym)); - } - pyx = REAL(yx); - - SEXP a = PROTECT(NEW_OBJECT_OF_CLASS("dgeMatrix")), - adim = PROTECT(GET_SLOT(a, Matrix_DimSym)), - ax = yx; - int *padim = INTEGER(adim); - padim[0] = (op_ != 0) ? m : r; - padim[1] = n; - if (!isNull(y) || padim[0] != m) { - PROTECT(ax = allocVector(REALSXP, (R_xlen_t) padim[0] * padim[1])); - ++nprotect; - } - double *pax = REAL(ax), *work = NULL; - if (op_ < 5) - work = (double *) R_alloc((size_t) m, sizeof(double)); - - switch (op_) { - case 0: /* qr.coef : A = P2 R1^{-1} Q1' P1 y */ - { - SEXP R = PROTECT(GET_SLOT(qr, Matrix_RSym)), - q = PROTECT(GET_SLOT(qr, Matrix_qSym)); - const cs *R_ = dgC2cs(R); - int *pq = (LENGTH(q)) ? INTEGER(q) : (int *) NULL; - - for (j = 0; j < n; ++j) { - cs_pvec(pp, pyx, work, m); - for (i = 0; i < r; ++i) - cs_happly(V_, i, pbeta[i], work); - cs_usolve(R_, work); - cs_ipvec(pq, work, pax, r); - pyx += m; - pax += r; - } - - UNPROTECT(2); /* q, R */ - break; - } - case 1: /* qr.fitted : A = P1' Q1 Q1' P1 y */ - for (j = 0; j < n; ++j) { - cs_pvec(pp, pyx, work, m); - for (i = 0; i < r; ++i) - cs_happly(V_, i, pbeta[i], work); - if (r < m) - Matrix_memset(work + r, 0, m - r, sizeof(double)); - for (i = r - 1; i >= 0; --i) - cs_happly(V_, i, pbeta[i], work); - cs_ipvec(pp, work, pax, m); - pyx += m; - pax += m; - } - break; - case 2: /* qr.resid : A = P1' Q2 Q2' P1 y */ - for (j = 0; j < n; ++j) { - cs_pvec(pp, pyx, work, m); - for (i = 0; i < r; ++i) - cs_happly(V_, i, pbeta[i], work); - if (r > 0) - Matrix_memset(work, 0, r, sizeof(double)); - for (i = r - 1; i >= 0; --i) - cs_happly(V_, i, pbeta[i], work); - cs_ipvec(pp, work, pax, m); - pyx += m; - pax += m; - } - break; - case 3: /* qr.qty {w/ perm.} : A = Q' P1 y */ - for (j = 0; j < n; ++j) { - cs_pvec(pp, pyx, work, m); - Matrix_memcpy(pax, work, m, sizeof(double)); - for (i = 0; i < r; ++i) - cs_happly(V_, i, pbeta[i], pax); - pyx += m; - pax += m; - } - break; - case 4: /* qr.qy {w/ perm.} : A = P1' Q y */ - for (j = 0; j < n; ++j) { - Matrix_memcpy(work, pyx, m, sizeof(double)); - for (i = r - 1; i >= 0; --i) - cs_happly(V_, i, pbeta[i], work); - cs_ipvec(pp, work, pax, m); - pyx += m; - pax += m; - } - break; - case 5: /* qr.qty {w/o perm.} : A = Q' y */ - if (ax != yx) - Matrix_memcpy(pax, pyx, (R_xlen_t) m * n, sizeof(double)); - for (j = 0; j < n; ++j) { - for (i = 0; i < r; ++i) - cs_happly(V_, i, pbeta[i], pax); - pax += m; - } - break; - case 6: /* qr.qy {w/o perm.} : A = Q y */ - if (ax != yx) - Matrix_memcpy(pax, pyx, (R_xlen_t) m * n, sizeof(double)); - for (j = 0; j < n; ++j) { - for (i = r - 1; i >= 0; --i) - cs_happly(V_, i, pbeta[i], pax); - pax += m; - } - break; - default: - error(_("invalid '%s' to %s()"), "op", __func__); - break; - } - - SET_SLOT(a, Matrix_xSym, ax); - UNPROTECT(nprotect); /* ax, adim, a, yx, p, beta, V */ - return a; -} - SEXP CHMfactor_diag_get(SEXP obj, SEXP square) { - cholmod_factor *L = mf2cholmod(obj); + cholmod_factor *L = M2CHF(obj, 1); int n = (int) L->n, square_ = asLogical(square); SEXP y = PROTECT(allocVector(REALSXP, n)); double *py = REAL(y); @@ -2218,50 +841,56 @@ SEXP CHMfactor_update(SEXP obj, SEXP parent, SEXP mult) { + /* defined in ./objects.c : */ + char Matrix_shape(SEXP); + double mult_ = asReal(mult); if (!R_FINITE(mult_)) error(_("'%s' is not a number or not finite"), "mult"); - cholmod_factor *L = cholmod_copy_factor(mf2cholmod(obj), &c); - cholmod_sparse *A = dgC2cholmod(parent); + cholmod_factor *L = cholmod_copy_factor(M2CHF(obj, 1), &c); + cholmod_sparse *A = M2CHS(parent, 1); if (Matrix_shape(parent) == 's') { - SEXP uplo = PROTECT(GET_SLOT(parent, Matrix_uploSym)); + SEXP uplo = GET_SLOT(parent, Matrix_uploSym); char ul = *CHAR(STRING_ELT(uplo, 0)); A->stype = (ul == 'U') ? 1 : -1; - UNPROTECT(1); } dpCMatrix_trf_(A, &L, 0, !L->is_ll, L->is_super, mult_); - SEXP res = PROTECT(cholmod2mf(L)); + SEXP res = PROTECT(CHF2M(L, 1)); cholmod_free_factor(&L, &c); SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); SET_SLOT(res, Matrix_DimNamesSym, dimnames); + UNPROTECT(1); - UNPROTECT(2); + UNPROTECT(1); return res; } SEXP CHMfactor_updown(SEXP obj, SEXP parent, SEXP update) { - cholmod_factor *L = cholmod_copy_factor(mf2cholmod(obj), &c); - cholmod_sparse *A = dgC2cholmod(parent); + /* defined in ./objects.c : */ + char Matrix_shape(SEXP); + + cholmod_factor *L = cholmod_copy_factor(M2CHF(obj, 1), &c); + cholmod_sparse *A = M2CHS(parent, 1); if (Matrix_shape(parent) == 's') { - SEXP uplo = PROTECT(GET_SLOT(parent, Matrix_uploSym)); + SEXP uplo = GET_SLOT(parent, Matrix_uploSym); char ul = *CHAR(STRING_ELT(uplo, 0)); A->stype = (ul == 'U') ? 1 : -1; - UNPROTECT(1); } cholmod_updown(asLogical(update) != 0, A, L, &c); - SEXP res = PROTECT(cholmod2mf(L)); + SEXP res = PROTECT(CHF2M(L, 1)); cholmod_free_factor(&L, &c); SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); SET_SLOT(res, Matrix_DimNamesSym, dimnames); + UNPROTECT(1); - UNPROTECT(2); + UNPROTECT(1); return res; } diff -Nru rmatrix-1.6-1.1/src/factorizations.h rmatrix-1.6-5/src/factorizations.h --- rmatrix-1.6-1.1/src/factorizations.h 2023-06-24 01:53:34.000000000 +0000 +++ rmatrix-1.6-5/src/factorizations.h 2023-09-26 06:40:29.000000000 +0000 @@ -1,59 +1,22 @@ #ifndef MATRIX_FACTORIZATIONS_H #define MATRIX_FACTORIZATIONS_H -#include "cs.h" -#include "chm_common.h" -#include "Lapack-etc.h" -#include "Mutils.h" - -SEXP dgeMatrix_trf_(SEXP obj, int warn); -SEXP dsyMatrix_trf_(SEXP obj, int warn); -SEXP dspMatrix_trf_(SEXP obj, int warn); -SEXP dpoMatrix_trf_(SEXP obj, int warn, int pivot, double tol); -SEXP dppMatrix_trf_(SEXP obj, int warn); - -SEXP dgeMatrix_trf (SEXP obj, SEXP warn); -SEXP dsyMatrix_trf (SEXP obj, SEXP warn); -SEXP dspMatrix_trf (SEXP obj, SEXP warn); -SEXP dpoMatrix_trf (SEXP obj, SEXP warn, SEXP pivot, SEXP tol); -SEXP dppMatrix_trf (SEXP obj, SEXP warn); - -int dgCMatrix_trf_(const cs *A, css **S, csn **N, int order, double tol); -SEXP dgCMatrix_trf(SEXP obj, SEXP order, SEXP tol, SEXP doError); - -int dgCMatrix_orf_(const cs *A, css **S, csn **N, int order); -SEXP dgCMatrix_orf(SEXP obj, SEXP order, SEXP doError); - -int dpCMatrix_trf_(cholmod_sparse *A, cholmod_factor **L, - int perm, int ldl, int super, double mult); -SEXP dpCMatrix_trf(SEXP obj, - SEXP perm, SEXP ldl, SEXP super, SEXP mult); - -SEXP BunchKaufman_expand(SEXP obj, SEXP packed); - -SEXP denseLU_determinant(SEXP obj, SEXP logarithm); -SEXP BunchKaufman_determinant(SEXP obj, SEXP logarithm, SEXP packed); -SEXP Cholesky_determinant(SEXP obj, SEXP logarithm, SEXP packed); -SEXP sparseLU_determinant(SEXP obj, SEXP logarithm); -SEXP sparseQR_determinant(SEXP obj, SEXP logarithm); -SEXP CHMfactor_determinant(SEXP obj, SEXP logarithm, SEXP sqrt); - -SEXP denseLU_solve(SEXP a, SEXP b); -SEXP BunchKaufman_solve(SEXP a, SEXP b, SEXP packed); -SEXP Cholesky_solve(SEXP a, SEXP b, SEXP packed); -SEXP sparseLU_solve(SEXP a, SEXP b, SEXP sparse); -/* MJ: not needed since we have 'sparseQR_matmult' : */ -#if 0 -SEXP sparseQR_solve(SEXP a, SEXP b, SEXP sparse); -#endif /* MJ */ -SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP sparse, SEXP system); -SEXP dtrMatrix_solve(SEXP a, SEXP b, SEXP packed); -SEXP dtCMatrix_solve(SEXP a, SEXP b, SEXP sparse); - -SEXP sparseQR_matmult(SEXP qr, SEXP y, SEXP op, SEXP complete, SEXP yxjj); - -SEXP CHMfactor_diag_get(SEXP obj, SEXP square); -SEXP CHMfactor_update(SEXP obj, SEXP parent, SEXP mult); -SEXP CHMfactor_updown(SEXP obj, SEXP parent, SEXP update); +#include + +SEXP dgeMatrix_trf(SEXP, SEXP); +SEXP dsyMatrix_trf(SEXP, SEXP); +SEXP dspMatrix_trf(SEXP, SEXP); +SEXP dpoMatrix_trf(SEXP, SEXP, SEXP, SEXP); +SEXP dppMatrix_trf(SEXP, SEXP); + +SEXP dgCMatrix_trf(SEXP, SEXP, SEXP, SEXP); +SEXP dgCMatrix_orf(SEXP, SEXP, SEXP); +SEXP dpCMatrix_trf(SEXP, SEXP, SEXP, SEXP, SEXP); + +SEXP BunchKaufman_expand(SEXP, SEXP); + +SEXP CHMfactor_diag_get(SEXP, SEXP); +SEXP CHMfactor_update(SEXP, SEXP, SEXP); +SEXP CHMfactor_updown(SEXP, SEXP, SEXP); #endif /* MATRIX_FACTORIZATIONS_H */ diff -Nru rmatrix-1.6-1.1/src/idz.c rmatrix-1.6-5/src/idz.c --- rmatrix-1.6-1.1/src/idz.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/idz.c 2023-09-22 05:53:14.000000000 +0000 @@ -0,0 +1,536 @@ +#include "Mdefines.h" +#include "idz.h" + +#define IDZ \ +TEMPLATE(i, int, 0 , 1 ) \ +TEMPLATE(d, double, 0.0, 1.0) \ +TEMPLATE(z, Rcomplex, Matrix_zzero, Matrix_zone) + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +static void _PREFIX_ ## \ +swap(int n, _CTYPE_ *x, int incx, _CTYPE_ *y, int incy) \ +{ \ + _CTYPE_ tmp; \ + while (n--) { \ + tmp = *x; \ + *x = *y; \ + *y = tmp; \ + x += incx; \ + y += incy; \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +static void _PREFIX_ ## \ +syswapr(char uplo, int n, _CTYPE_ *x, int k0, int k1) \ +{ \ + _CTYPE_ *x0 = x + (R_xlen_t) k0 * n, *x1 = x + (R_xlen_t) k1 * n, \ + tmp; \ + if (uplo == 'U') { \ + _PREFIX_ ## swap(k0, x0, 1, x1, 1); \ + tmp = x0[k0]; \ + x0[k0] = x1[k1]; \ + x1[k1] = tmp; \ + _PREFIX_ ## swap(k1 - k0 - 1, x0 + k0 + n, n, x1 + k0 + 1, 1); \ + _PREFIX_ ## swap(n - k1 - 1, x1 + k0 + n, n, x1 + k1 + n, n); \ + } else { \ + _PREFIX_ ## swap(k0, x + k0, n, x + k1, n); \ + tmp = x0[k0]; \ + x0[k0] = x1[k1]; \ + x1[k1] = tmp; \ + _PREFIX_ ## swap(k1 - k0 - 1, x0 + k0 + 1, 1, x0 + k1 + n, n); \ + _PREFIX_ ## swap(n - k1 - 1, x0 + k1 + 1, 1, x1 + k1 + 1, 1); \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +rowperm2(_CTYPE_ *x, int m, int n, int *p, int off, int invert) \ +{ \ + int i, k0, k1; \ + for (i = 0; i < m; ++i) \ + p[i] = -(p[i] - off + 1); \ + if (!invert) { \ + for (i = 0; i < m; ++i) { \ + if (p[i] > 0) \ + continue; \ + k0 = i; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + while (p[k1] < 0) { \ + _PREFIX_ ## swap(n, x + k0, m, x + k1, m); \ + k0 = k1; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + } \ + } \ + } else { \ + for (i = 0; i < m; ++i) { \ + if (p[i] > 0) \ + continue; \ + k0 = i; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + while (k1 != k0) { \ + _PREFIX_ ## swap(n, x + k0, m, x + k1, m); \ + p[k1] = -p[k1]; \ + k1 = p[k1] - 1; \ + } \ + } \ + } \ + for (i = 0; i < m; ++i) \ + p[i] = p[i] + off - 1; \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +symperm2(_CTYPE_ *x, int n, char uplo, int *p, int off, int invert) \ +{ \ + int i, k0, k1; \ + for (i = 0; i < n; ++i) \ + p[i] = -(p[i] - off + 1); \ + if (!invert) { \ + for (i = 0; i < n; ++i) { \ + if (p[i] > 0) \ + continue; \ + k0 = i; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + while (p[k1] < 0) { \ + if (k0 < k1) \ + _PREFIX_ ## syswapr(uplo, n, x, k0, k1); \ + else \ + _PREFIX_ ## syswapr(uplo, n, x, k1, k0); \ + k0 = k1; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + } \ + } \ + } else { \ + for (i = 0; i < n; ++i) { \ + if (p[i] > 0) \ + continue; \ + k0 = i; \ + p[k0] = -p[k0]; \ + k1 = p[k0] - 1; \ + while (k1 != k0) { \ + if (k0 < k1) \ + _PREFIX_ ## syswapr(uplo, n, x, k0, k1); \ + else \ + _PREFIX_ ## syswapr(uplo, n, x, k1, k0); \ + p[k1] = -p[k1]; \ + k1 = p[k1] - 1; \ + } \ + } \ + } \ + for (i = 0; i < n; ++i) \ + p[i] = p[i] + off - 1; \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +pack2(_CTYPE_ *dest, const _CTYPE_ *src, int n, char uplo, char diag) \ +{ \ + int i, j; \ + R_xlen_t dpos = 0, spos = 0; \ + if (uplo == 'U') { \ + for (j = 0; j < n; spos += n-(++j)) \ + for (i = 0; i <= j; ++i) \ + dest[dpos++] = src[spos++]; \ + if (diag != 'N') { \ + dpos = 0; \ + for (j = 0; j < n; dpos += (++j)+1) \ + dest[dpos] = _ONE_; \ + } \ + } else { \ + for (j = 0; j < n; spos += (++j)) \ + for (i = j; i < n; ++i) \ + dest[dpos++] = src[spos++]; \ + if (diag != 'N') { \ + dpos = 0; \ + for (j = 0; j < n; dpos += n-(j++)) \ + dest[dpos] = _ONE_; \ + } \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +unpack1(_CTYPE_ *dest, const _CTYPE_ *src, int n, char uplo, char diag) \ +{ \ + int i, j; \ + R_xlen_t dpos = 0, spos = 0; \ + if (uplo == 'U') { \ + for (j = 0; j < n; dpos += n-(++j)) \ + for (i = 0; i <= j; ++i) \ + dest[dpos++] = src[spos++]; \ + } else { \ + for (j = 0; j < n; dpos += (++j)) \ + for (i = j; i < n; ++i) \ + dest[dpos++] = src[spos++]; \ + } \ + if (diag != 'N') { \ + dpos = 0; \ + R_xlen_t n1a = (R_xlen_t) n + 1; \ + for (j = 0; j < n; ++j, dpos += n1a) \ + dest[dpos] = _ONE_; \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +transpose2(_CTYPE_ *dest, const _CTYPE_ *src, int m, int n) \ +{ \ + R_xlen_t mn1s = (R_xlen_t) m * n - 1; \ + int i, j; \ + for (j = 0; j < m; ++j, src -= mn1s) \ + for (i = 0; i < n; ++i, src += m) \ + *(dest++) = *src; \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +transpose1(_CTYPE_ *dest, const _CTYPE_ *src, int n, char uplo) \ +{ \ + int i, j; \ + if (uplo == 'U') { \ + for (j = 0; j < n; ++j) \ + for (i = j; i < n; ++i) \ + *(dest++) = *(src + PACKED_AR21_UP(j, i)); \ + } else { \ + R_xlen_t n2 = (R_xlen_t) n * 2; \ + for (j = 0; j < n; ++j) \ + for (i = 0; i <= j; ++i) \ + *(dest++) = *(src + PACKED_AR21_LO(j, i, n2)); \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define ASSIGN_JJ_i(_X_) +#define ASSIGN_JJ_d(_X_) +#define ASSIGN_JJ_z(_X_) \ + _X_.i = 0.0 +#define ASSIGN_JI_i(_X_, _Y_) \ + _X_ = _Y_ +#define ASSIGN_JI_d(_X_, _Y_) \ + _X_ = _Y_ +#define ASSIGN_JI_z(_X_, _Y_) \ + do { \ + _X_.r = _Y_.r; \ + _X_.i = -_Y_.i; \ + } while (0) + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +syforce2(_CTYPE_ *x, int n, char uplo) \ +{ \ + _CTYPE_ *y = x; \ + int i, j; \ + if (uplo == 'U') { \ + for (j = 0; j < n; ++j) { \ + ASSIGN_JJ_ ## _PREFIX_((*x)); \ + x += 1; \ + y += n; \ + for (i = j + 1; i < n; ++i) { \ + ASSIGN_JI_ ## _PREFIX_((*x), (*y)); \ + x += 1; \ + y += n; \ + } \ + x = y = x + j + 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + ASSIGN_JJ_ ## _PREFIX_((*y)); \ + x += 1; \ + y += n; \ + for (i = j + 1; i < n; ++i) { \ + ASSIGN_JI_ ## _PREFIX_((*y), (*x)); \ + x += 1; \ + y += n; \ + } \ + x = y = x + j + 1; \ + } \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#undef ASSIGN_JJ_i +#undef ASSIGN_JJ_d +#undef ASSIGN_JJ_z +#undef ASSIGN_JI_i +#undef ASSIGN_JI_d +#undef ASSIGN_JI_z + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +trforce2(_CTYPE_ *x, int m, int n, char uplo, char diag) \ +{ \ + _CTYPE_ *y = x; \ + int i, j, r = (m < n) ? m : n; \ + if (uplo == 'U') { \ + for (j = 0; j < r; ++j) { \ + for (i = j + 1; i < m; ++i) \ + *(++x) = _ZERO_; \ + x += j + 2; \ + } \ + } else { \ + for (j = 0; j < r; ++j) { \ + for (i = 0; i < j; ++i) \ + *(x++) = _ZERO_; \ + x += m - j; \ + } \ + for (j = r; j < n; ++j) \ + for (i = 0; i < m; ++i) \ + *(x++) = _ZERO_; \ + } \ + if (diag != 'N') { \ + R_xlen_t m1a = (R_xlen_t) m + 1; \ + for (j = 0; j < r; ++j) { \ + *y = _ONE_; \ + y += m1a; \ + } \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +band2(_CTYPE_ *x, int m, int n, int a, int b, char diag) \ +{ \ + if (m == 0 || n == 0) \ + return; \ + if (a > b || a >= n || b <= -m) { \ + Matrix_memset(x, 0, (R_xlen_t) m * n, sizeof(_CTYPE_)); \ + return; \ + } \ + if (a <= -m) a = 1-m; \ + if (b >= n) b = n-1; \ + \ + int i, j, i0, i1, \ + j0 = (a < 0) ? 0 : a, \ + j1 = (b < n-m) ? m+b : n; \ + \ + if (j0 > 0) { \ + R_xlen_t dx = (R_xlen_t) m * j0; \ + Matrix_memset(x, 0, dx, sizeof(_CTYPE_)); \ + x += dx; \ + } \ + for (j = j0; j < j1; ++j, x += m) { \ + i0 = j - b; \ + i1 = j - a + 1; \ + for (i = 0; i < i0; ++i) \ + *(x + i) = _ZERO_; \ + for (i = i1; i < m; ++i) \ + *(x + i) = _ZERO_; \ + } \ + if (j1 < n) \ + Matrix_memset(x, 0, (R_xlen_t) m * (n - j1), sizeof(_CTYPE_)); \ + if (diag != 'N' && a <= 0 && b >= 0) { \ + x -= m * (R_xlen_t) j; \ + R_xlen_t m1a = (R_xlen_t) m + 1; \ + for (j = 0; j < n; ++j, x += m1a) \ + *x = _ONE_; \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +band1(_CTYPE_ *x, int n, int a, int b, char uplo, char diag) \ +{ \ + if (n == 0) \ + return; \ + if (a > b || a >= n || b <= -n) { \ + Matrix_memset(x, 0, PACKED_LENGTH(n), sizeof(_CTYPE_)); \ + return; \ + } \ + if (uplo == 'U') { \ + if (a < 0) a = 0; \ + if (b >= n) b = n-1; \ + } else { \ + if (b > 0) b = 0; \ + if (a <= -n) a = 1-n; \ + } \ + \ + int i, j, i0, i1, \ + j0 = (a < 0) ? 0 : a, \ + j1 = (b < 0) ? n+b : n; \ + \ + if (uplo == 'U') { \ + if (j0 > 0) { \ + R_xlen_t dx; \ + Matrix_memset(x, 0, dx = PACKED_LENGTH(j0), \ + sizeof(_CTYPE_)); \ + x += dx; \ + } \ + for (j = j0; j < j1; x += (++j)) { \ + i0 = j - b; \ + i1 = j - a + 1; \ + for (i = 0; i < i0; ++i) \ + *(x + i) = _ZERO_; \ + for (i = i1; i <= j; ++i) \ + *(x + i) = _ZERO_; \ + } \ + if (j1 < n) \ + Matrix_memset(x, 0, PACKED_LENGTH(n) - PACKED_LENGTH(j1), \ + sizeof(_CTYPE_)); \ + if (diag != 'N' && a == 0) { \ + x -= PACKED_LENGTH(j); \ + for (j = 0; j < n; x += (++j)+1) \ + *x = _ONE_; \ + } \ + } else { \ + if (j0 > 0) { \ + R_xlen_t dx = PACKED_LENGTH(n) - PACKED_LENGTH(j0); \ + Matrix_memset(x, 0, dx, sizeof(_CTYPE_)); \ + x += dx; \ + } \ + for (j = j0; j < j1; x += n-(j++)) { \ + i0 = j - b; \ + i1 = j - a + 1; \ + for (i = j; i < i0; ++i) \ + *(x + i - j) = _ZERO_; \ + for (i = i1; i < n; ++i) \ + *(x + i - j) = _ZERO_; \ + } \ + if (j1 < n) \ + Matrix_memset(x, 0, PACKED_LENGTH(n - j1), \ + sizeof(_CTYPE_)); \ + if (diag != 'N' && b == 0) { \ + x -= PACKED_LENGTH(n) - PACKED_LENGTH(j); \ + for (j = 0; j < n; x += n-(j++)) \ + *x = _ONE_; \ + } \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +dcpy2(_CTYPE_ *dest, const _CTYPE_ *src, int n, R_xlen_t length, \ + char uplo, char diag) \ +{ \ + int j; \ + R_xlen_t n1a = (R_xlen_t) n + 1; \ + if (diag != 'N') { \ + for (j = 0; j < n; ++j, dest += n1a) \ + *dest = _ONE_; \ + } else if (length == n) { \ + /* copying from diagonalMatrix */ \ + for (j = 0; j < n; ++j, dest += n1a, ++src) \ + *dest = *src; \ + } else if (length == (n * n1a) / 2) { \ + /* copying from packedMatrix */ \ + if (uplo == 'U') { \ + for (j = 0; j < n; dest += n1a, src += (++j)+1) \ + *dest = *src; \ + } else { \ + for (j = 0; j < n; dest += n1a, src += n-(j++)) \ + *dest = *src; \ + } \ + } else if (length == (R_xlen_t) n * n) { \ + /* copying from square unpackedMatrix */ \ + for (j = 0; j < n; ++j, dest += n1a, src += n1a) \ + *dest = *src; \ + } else { \ + error(_("incompatible '%s' and '%s' in '%s'"), \ + "n", "length", __func__); \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ +void _PREFIX_ ## \ +dcpy1(_CTYPE_ *dest, const _CTYPE_ *src, int n, R_xlen_t length, \ + char uplo_dest, char uplo_src, char diag) \ +{ \ + int j; \ + if (diag != 'N') { \ + if (uplo_dest == 'U') { \ + for (j = 0; j < n; dest += (++j)+1) \ + *dest = _ONE_; \ + } else { \ + for (j = 0; j < n; dest += n-(j++)) \ + *dest = _ONE_; \ + } \ + } else if (length == n) { \ + /* copying from diagonalMatrix */ \ + if (uplo_dest == 'U') { \ + for (j = 0; j < n; dest += (++j)+1, ++src) \ + *dest = *src; \ + } else { \ + for (j = 0; j < n; dest += n-(j++), ++src) \ + *dest = *src; \ + } \ + } else if (length == PACKED_LENGTH(n)) { \ + /* copying from packedMatrix */ \ + if (uplo_dest == 'U') { \ + if (uplo_src == 'U') { \ + for (j = 0; j < n; src += (++j)+1, dest += j+1) \ + *dest = *src; \ + } else { \ + for (j = 0; j < n; src += n-j, dest += (++j)+1) \ + *dest = *src; \ + } \ + } else { \ + if (uplo_src == 'U') { \ + for (j = 0; j < n; dest += n-(j++), src += j+1) \ + *dest = *src; \ + } else { \ + for (j = 0; j < n; dest += n-j, src += n-(j++)) \ + *dest = *src; \ + } \ + } \ + } else if (length == (R_xlen_t) n * n) { \ + /* copying from square unpackedMatrix */ \ + R_xlen_t n1a = (R_xlen_t) n + 1; \ + if (uplo_dest == 'U') { \ + for (j = 0; j < n; dest += (++j)+1, src += n1a) \ + *dest = *src; \ + } else { \ + for (j = 0; j < n; dest += n-(j++), src += n1a) \ + *dest = *src; \ + } \ + } else { \ + error(_("incompatible '%s' and '%s' in '%s'"), \ + "n", "length", __func__); \ + } \ + return; \ +} +IDZ +#undef TEMPLATE + +#undef IDZ diff -Nru rmatrix-1.6-1.1/src/idz.h rmatrix-1.6-5/src/idz.h --- rmatrix-1.6-1.1/src/idz.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/idz.h 2023-09-22 04:52:11.000000000 +0000 @@ -0,0 +1,85 @@ +#ifndef MATRIX_IDZ_H +#define MATRIX_IDZ_H + +#include + +#define IDZ \ +TEMPLATE(i, int); \ +TEMPLATE(d, double); \ +TEMPLATE(z, Rcomplex); + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +rowperm2(_CTYPE_ *, int, int, int *, int, int) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +symperm2(_CTYPE_ *, int, char, int *, int, int) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +pack2(_CTYPE_ *, const _CTYPE_ *, int, char, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +unpack1(_CTYPE_ *, const _CTYPE_ *, int, char, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +transpose2(_CTYPE_ *, const _CTYPE_ *, int, int) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +transpose1(_CTYPE_ *, const _CTYPE_ *, int, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +syforce2(_CTYPE_ *, int, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +trforce2(_CTYPE_ *, int, int, char, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +band2(_CTYPE_ *, int, int, int, int, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +band1(_CTYPE_ *, int, int, int, char, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +dcpy2(_CTYPE_ *, const _CTYPE_ *, int, R_xlen_t, char, char) +IDZ +#undef TEMPLATE + +#define TEMPLATE(_PREFIX_, _CTYPE_) \ +void _PREFIX_ ## \ +dcpy1(_CTYPE_ *, const _CTYPE_ *, int, R_xlen_t, char, char, char) +IDZ +#undef TEMPLATE + +#undef IDZ + +#endif /* MATRIX_IDZ_H */ diff -Nru rmatrix-1.6-1.1/src/init.c rmatrix-1.6-5/src/init.c --- rmatrix-1.6-1.1/src/init.c 2023-07-31 19:50:15.000000000 +0000 +++ rmatrix-1.6-5/src/init.c 2024-01-06 06:59:15.000000000 +0000 @@ -1,21 +1,24 @@ -#include /* SEXP, Rcomplex */ +#include "Mdefines.h" #include "Csparse.h" -#include "CHMfactor.h" #include "abIndex.h" +#include "attrib.h" #include "bind.h" #include "chm_common.h" #include "coerce.h" #include "dense.h" +#include "determinant.h" #include "dgCMatrix.h" #include "dgeMatrix.h" #include "factorizations.h" #include "kappa.h" -#include "packedMatrix.h" +#include "objects.h" +#include "perm.h" #include "products.h" +#include "solve.h" #include "sparse.h" #include "sparseVector.h" #include "subscript.h" -#include "unpackedMatrix.h" +#include "utils-R.h" #include "validity.h" #include #include @@ -25,39 +28,25 @@ #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} #define EXTDEF(name, n) {#name, (DL_FUNC) &name, n} +#define RREGDEF(name ) R_RegisterCCallable("Matrix", #name, (DL_FUNC) name) static R_CallMethodDef CallEntries[] = { - CALLDEF(CHM_set_common_env, 1), - CALLDEF(get_SuiteSparse_version, 0), - CALLDEF(m_encodeInd, 4), CALLDEF(m_encodeInd2, 5), CALLDEF(Matrix_rle_i, 2), CALLDEF(Matrix_rle_d, 2), - CALLDEF(Csparse_Csparse_prod, 3), - CALLDEF(Csparse_Csparse_crossprod, 4), - CALLDEF(Csparse_MatrixMarket, 2), - CALLDEF(Csparse_crossprod, 3), - CALLDEF(Csparse_dense_crossprod, 3), - CALLDEF(Csparse_dense_prod, 3), - CALLDEF(Csparse_horzcat, 2), - CALLDEF(Csparse_sort, 1), - - CALLDEF(dCsparse_subassign, 4), + CALLDEF(tCsparse_diag, 2), + CALLDEF(nCsparse_subassign, 4), CALLDEF(lCsparse_subassign, 4), CALLDEF(iCsparse_subassign, 4), - CALLDEF(nCsparse_subassign, 4), + CALLDEF(dCsparse_subassign, 4), CALLDEF(zCsparse_subassign, 4), - - CALLDEF(Csparse_validate2, 2), - CALLDEF(Csparse_vertcat, 2), CALLDEF(Csparse_dmperm, 3), - CALLDEF(diag_tC, 2), + CALLDEF(Csparse_MatrixMarket, 2), CALLDEF(Matrix_expand_pointers, 1), - CALLDEF(R_rbind2_vector, 2), CALLDEF(R_all0, 1), CALLDEF(R_any0, 1), @@ -69,28 +58,15 @@ CALLDEF(dgeMatrix_Schur, 3), CALLDEF(dgeMatrix_exp, 1), - CALLDEF(dgeMatrix_crossprod, 2), - CALLDEF (geMatrix_crossprod, 2), - CALLDEF(dgeMatrix_dgeMatrix_crossprod, 3), - CALLDEF (geMatrix_geMatrix_crossprod, 3), - CALLDEF(dgeMatrix_matrix_crossprod, 3), - CALLDEF (geMatrix_matrix_crossprod, 3), - CALLDEF(dgeMatrix_matrix_mm, 3), - CALLDEF (geMatrix_matrix_mm, 3), - CALLDEF(dtrMatrix_dtrMatrix_mm, 4), - CALLDEF(dtrMatrix_matrix_mm, 4), - CALLDEF(dtpMatrix_matrix_mm, 4), - CALLDEF(dgeMatrix_dtpMatrix_mm, 2), - CALLDEF(dsyMatrix_matrix_mm, 3), - CALLDEF(dspMatrix_matrix_mm, 2), + CALLDEF(CsparseMatrix_validate_maybe_sorting, 1), CALLDEF(Matrix_validate, 1), CALLDEF(MatrixFactorization_validate, 1), - CALLDEF(dMatrix_validate, 1), + CALLDEF(nMatrix_validate, 1), CALLDEF(lMatrix_validate, 1), - CALLDEF(ndenseMatrix_validate, 1), CALLDEF(iMatrix_validate, 1), + CALLDEF(dMatrix_validate, 1), CALLDEF(zMatrix_validate, 1), CALLDEF(compMatrix_validate, 1), @@ -130,6 +106,12 @@ CALLDEF(corMatrix_validate, 1), CALLDEF(pcorMatrix_validate, 1), + CALLDEF(sparseVector_validate, 1), + CALLDEF(lsparseVector_validate, 1), + CALLDEF(isparseVector_validate, 1), + CALLDEF(dsparseVector_validate, 1), + CALLDEF(zsparseVector_validate, 1), + CALLDEF(denseLU_validate, 1), CALLDEF(sparseLU_validate, 1), CALLDEF(sparseQR_validate, 1), @@ -149,10 +131,10 @@ CALLDEF(R_DimNames_fixup, 1), CALLDEF(R_DimNames_is_symmetric, 1), - CALLDEF(R_symmDN, 1), + CALLDEF(R_symDN, 1), CALLDEF(R_revDN, 1), CALLDEF(R_Matrix_nonvirtual, 2), - CALLDEF(R_Matrix_kind, 2), + CALLDEF(R_Matrix_kind, 1), CALLDEF(R_Matrix_shape, 1), CALLDEF(R_Matrix_repr, 1), CALLDEF(R_index_triangle, 4), @@ -163,64 +145,46 @@ CALLDEF(R_invertPerm, 3), CALLDEF(R_asPerm, 4), CALLDEF(R_set_factor, 4), - CALLDEF(R_empty_factors, 2), CALLDEF(R_subscript_1ary, 2), CALLDEF(R_subscript_1ary_mat, 2), CALLDEF(R_subscript_2ary, 3), + CALLDEF(R_dense_band, 3), + CALLDEF(R_dense_diag_get, 2), + CALLDEF(R_dense_diag_set, 2), + CALLDEF(R_dense_transpose, 1), + CALLDEF(R_dense_force_symmetric, 2), + CALLDEF(R_dense_symmpart, 1), + CALLDEF(R_dense_skewpart, 1), + CALLDEF(R_dense_is_symmetric, 2), + CALLDEF(R_dense_is_triangular, 2), + CALLDEF(R_dense_is_diagonal, 1), + CALLDEF(R_dense_marginsum, 4), + CALLDEF(R_dense_sum, 2), + CALLDEF(R_dense_prod, 2), + CALLDEF(R_sparse_drop0, 2), + CALLDEF(R_sparse_diag_U2N, 1), + CALLDEF(R_sparse_diag_N2U, 1), CALLDEF(R_sparse_band, 3), CALLDEF(R_sparse_diag_get, 2), CALLDEF(R_sparse_diag_set, 2), - CALLDEF(R_sparse_diag_U2N, 1), - CALLDEF(R_sparse_diag_N2U, 1), CALLDEF(R_sparse_transpose, 2), CALLDEF(R_sparse_force_symmetric, 2), CALLDEF(R_sparse_symmpart, 1), CALLDEF(R_sparse_skewpart, 1), - + CALLDEF(R_sparse_is_symmetric, 2), + CALLDEF(R_sparse_is_triangular, 2), + CALLDEF(R_sparse_is_diagonal, 1), + CALLDEF(R_sparse_marginsum, 5), + CALLDEF(R_sparse_sum, 2), + CALLDEF(R_sparse_prod, 2), CALLDEF(Tsparse_aggregate, 1), - CALLDEF(Csparse_is_diagonal, 1), - CALLDEF(Rsparse_is_diagonal, 1), - CALLDEF(Tsparse_is_diagonal, 1), - CALLDEF(Csparse_is_triangular, 2), - CALLDEF(Rsparse_is_triangular, 2), - CALLDEF(Tsparse_is_triangular, 2), - CALLDEF(Csparse_is_symmetric, 2), - CALLDEF(Rsparse_is_symmetric, 2), - CALLDEF(CRsparse_colSums, 4), - CALLDEF(CRsparse_rowSums, 4), - CALLDEF(R_dense_band, 3), - CALLDEF(R_dense_colSums, 3), - CALLDEF(R_dense_rowSums, 3), - - CALLDEF(matrix_is_symmetric, 2), - CALLDEF(matrix_is_triangular, 2), - CALLDEF(matrix_is_diagonal, 1), - CALLDEF(matrix_symmpart, 1), - CALLDEF(matrix_skewpart, 1), - - CALLDEF(unpackedMatrix_force_symmetric, 2), - CALLDEF(unpackedMatrix_is_symmetric, 2), - CALLDEF(unpackedMatrix_is_triangular, 2), - CALLDEF(unpackedMatrix_is_diagonal, 1), - CALLDEF(unpackedMatrix_transpose, 1), - CALLDEF(unpackedMatrix_diag_get, 2), - CALLDEF(unpackedMatrix_diag_set, 2), - CALLDEF(unpackedMatrix_symmpart, 1), - CALLDEF(unpackedMatrix_skewpart, 1), - - CALLDEF(packedMatrix_force_symmetric, 2), - CALLDEF(packedMatrix_is_symmetric, 2), - CALLDEF(packedMatrix_is_triangular, 2), - CALLDEF(packedMatrix_is_diagonal, 1), - CALLDEF(packedMatrix_transpose, 1), - CALLDEF(packedMatrix_diag_get, 2), - CALLDEF(packedMatrix_diag_set, 2), - CALLDEF(packedMatrix_symmpart, 1), - CALLDEF(packedMatrix_skewpart, 1), + CALLDEF(R_dense_matmult, 4), + CALLDEF(R_sparse_matmult, 6), + CALLDEF(R_diagonal_matmult, 5), CALLDEF(dgeMatrix_trf, 2), CALLDEF(dsyMatrix_trf, 2), @@ -234,22 +198,18 @@ CALLDEF(BunchKaufman_expand, 2), CALLDEF(denseLU_determinant, 2), - CALLDEF(BunchKaufman_determinant, 3), - CALLDEF(Cholesky_determinant, 3), + CALLDEF(BunchKaufman_determinant, 2), + CALLDEF(Cholesky_determinant, 2), CALLDEF(sparseLU_determinant, 2), CALLDEF(sparseQR_determinant, 2), CALLDEF(CHMfactor_determinant, 3), CALLDEF(denseLU_solve, 2), - CALLDEF(BunchKaufman_solve, 3), - CALLDEF(Cholesky_solve, 3), + CALLDEF(BunchKaufman_solve, 2), + CALLDEF(Cholesky_solve, 2), + CALLDEF(dtrMatrix_solve, 2), CALLDEF(sparseLU_solve, 3), -/* MJ: not needed since we have 'sparseQR_matmult' : */ -#if 0 - CALLDEF(sparseQR_solve, 3), -#endif CALLDEF(CHMfactor_solve, 4), - CALLDEF(dtrMatrix_solve, 3), CALLDEF(dtCMatrix_solve, 3), CALLDEF(sparseQR_matmult, 5), @@ -259,29 +219,31 @@ CALLDEF(CHMfactor_updown, 3), CALLDEF(dgeMatrix_norm, 2), - CALLDEF(dtrMatrix_norm, 2), - CALLDEF(dtpMatrix_norm, 2), CALLDEF(dsyMatrix_norm, 2), CALLDEF(dspMatrix_norm, 2), + CALLDEF(dtrMatrix_norm, 2), + CALLDEF(dtpMatrix_norm, 2), CALLDEF(dgeMatrix_rcond, 3), - CALLDEF(dtrMatrix_rcond, 2), - CALLDEF(dtpMatrix_rcond, 2), CALLDEF(dsyMatrix_rcond, 3), CALLDEF(dspMatrix_rcond, 3), CALLDEF(dpoMatrix_rcond, 3), CALLDEF(dppMatrix_rcond, 3), + CALLDEF(dtrMatrix_rcond, 2), + CALLDEF(dtpMatrix_rcond, 2), CALLDEF(v2spV, 1), CALLDEF(CR2spV, 1), - CALLDEF(R_matrix_as_dense, 4), + CALLDEF(R_vector_as_dense, 8), + CALLDEF(R_matrix_as_dense, 5), CALLDEF(R_sparse_as_dense, 2), - CALLDEF(R_diagonal_as_dense, 4), + CALLDEF(R_diagonal_as_dense, 5), CALLDEF(R_index_as_dense, 2), - CALLDEF(R_matrix_as_sparse, 4), + CALLDEF(R_vector_as_sparse, 8), + CALLDEF(R_matrix_as_sparse, 5), CALLDEF(R_dense_as_sparse, 2), - CALLDEF(R_diagonal_as_sparse, 4), + CALLDEF(R_diagonal_as_sparse, 5), CALLDEF(R_index_as_sparse, 3), CALLDEF(R_dense_as_kind, 2), CALLDEF(R_sparse_as_kind, 2), @@ -304,6 +266,9 @@ CALLDEF(R_Matrix_as_kind, 3), CALLDEF(R_Matrix_as_general, 2), + CALLDEF(R_Matrix_version, 0), + CALLDEF(R_cholmod_common_envini, 1), + {NULL, NULL, 0} }; @@ -313,40 +278,13 @@ {NULL, NULL, 0} }; -void attribute_visible R_init_Matrix(DllInfo *dll) +void attribute_visible R_init_Matrix(DllInfo *info) { - R_registerRoutines(dll, NULL, CallEntries, NULL, ExtEntries); - R_useDynamicSymbols(dll, FALSE); + R_registerRoutines(info, NULL, CallEntries, NULL, ExtEntries); + R_useDynamicSymbols(info, FALSE); /* These are callable from other packages' C code: */ -#define RREGDEF(name) R_RegisterCCallable("Matrix", #name, (DL_FUNC) name) - - /* Matrix: SEXP -> CHOLMOD */ - RREGDEF(as_cholmod_dense); - RREGDEF(as_cholmod_factor); - RREGDEF(as_cholmod_sparse); - RREGDEF(as_cholmod_triplet); - - /* Matrix: CHOLMOD -> SEXP */ - RREGDEF(chm_factor_to_SEXP); - RREGDEF(chm_sparse_to_SEXP); - RREGDEF(chm_triplet_to_SEXP); - - /* Matrix: miscellaneous */ - RREGDEF(chm_factor_ldetL2); - RREGDEF(chm_factor_update); - RREGDEF(numeric_as_chm_dense); -#if 0 - RREGDEF(Csparse_diagU2N); - RREGDEF(dpoMatrix_chol); -#else - R_RegisterCCallable( - "Matrix", "Csparse_diagU2N", (DL_FUNC) R_sparse_diag_U2N); - R_RegisterCCallable( - "Matrix", "dpoMatrix_chol", (DL_FUNC) dpoMatrix_trf); -#endif - /* CHOLMOD: */ RREGDEF(cholmod_aat); RREGDEF(cholmod_add); @@ -361,6 +299,7 @@ RREGDEF(cholmod_copy_dense); RREGDEF(cholmod_copy_factor); RREGDEF(cholmod_copy_sparse); + RREGDEF(cholmod_defaults); RREGDEF(cholmod_dense_to_sparse); RREGDEF(cholmod_factor_to_sparse); RREGDEF(cholmod_factorize); @@ -385,14 +324,20 @@ RREGDEF(cholmod_submatrix); RREGDEF(cholmod_transpose); RREGDEF(cholmod_triplet_to_sparse); - RREGDEF(cholmod_vertcat); RREGDEF(cholmod_updown); - - R_cholmod_start(&c); -#if 0 - /* TODO: needs more work in ./chm_common.c, etc. */ - R_cholmod_start(&cl); -#endif + RREGDEF(cholmod_vertcat); + /* Matrix: */ + RREGDEF(sexp_as_cholmod_factor); + RREGDEF(sexp_as_cholmod_sparse); + RREGDEF(sexp_as_cholmod_triplet); + RREGDEF(sexp_as_cholmod_dense); + RREGDEF(numeric_as_cholmod_dense); + RREGDEF(cholmod_factor_as_sexp); + RREGDEF(cholmod_sparse_as_sexp); + RREGDEF(cholmod_triplet_as_sexp); + RREGDEF(cholmod_dense_as_sexp); + RREGDEF(cholmod_factor_ldetA); + RREGDEF(cholmod_factor_update); Matrix_DimNamesSym = install("Dimnames"); Matrix_DimSym = install("Dim"); @@ -404,7 +349,7 @@ Matrix_VSym = install("V"); Matrix_betaSym = install("beta"); Matrix_diagSym = install("diag"); - Matrix_factorSym = install("factors"); + Matrix_factorsSym = install("factors"); Matrix_iSym = install("i"); Matrix_jSym = install("j"); Matrix_lengthSym = install("length"); @@ -416,25 +361,15 @@ Matrix_uploSym = install("uplo"); Matrix_xSym = install("x"); - MatrixNamespace = R_FindNamespace(mkString("Matrix")); - if (MatrixNamespace == R_UnboundValue) - error(_("missing 'Matrix' namespace; should never happen")); -#ifdef Matrix_Debug - if(isEnvironment(MatrixNamespace)) - Rprintf("MatrixNamespace: %s\n", - CHAR(asChar(eval(lang2(install("format"), MatrixNamespace), - R_GlobalEnv)))); - else -#else - if (!isEnvironment(MatrixNamespace)) -#endif - error(_("'Matrix' namespace not determined correctly")); - Matrix_zzero.r = 0.0; Matrix_zone.r = 1.0; Matrix_zna.r = NA_REAL; Matrix_zzero.i = 0.0; Matrix_zone.i = 0.0; Matrix_zna.i = NA_REAL; + + R_cholmod_start(&c); + return; } -void R_unload_Matrix(DllInfo *dll) +void R_unload_Matrix(DllInfo *info) { - cholmod_finish(&c); + R_cholmod_finish(&c); + return; } diff -Nru rmatrix-1.6-1.1/src/kappa.c rmatrix-1.6-5/src/kappa.c --- rmatrix-1.6-1.1/src/kappa.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/kappa.c 2023-10-11 01:54:13.000000000 +0000 @@ -1,6 +1,9 @@ +#include "Lapack-etc.h" +#include "Mdefines.h" #include "kappa.h" -static char La_norm_type(SEXP s) +static +char La_norm_type(SEXP s) { #define ARGNAME "type" if (TYPEOF(s) != STRSXP) @@ -13,37 +16,38 @@ if (type[0] == '\0' || type[1] != '\0') error(_("argument '%s' (\"%s\") does not have string length %d"), ARGNAME, type, 1); - char type_ = '\0'; + char t = '\0'; switch (type[0]) { case 'M': case 'm': - type_ = 'M'; + t = 'M'; break; case 'O': case 'o': case '1': - type_ = 'O'; + t = 'O'; break; case 'I': case 'i': - type_ = 'I'; + t = 'I'; break; case 'F': case 'f': case 'E': case 'e': - type_ = 'F'; + t = 'F'; break; default: error(_("argument '%s' (\"%s\") is not \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", or \"%s\""), ARGNAME, type, "M", "O", "1", "I", "F", "E"); break; } - return type_; + return t; #undef ARGNAME } -static char La_rcond_type(SEXP s) +static +char La_rcond_type(SEXP s) { #define ARGNAME "norm" if (TYPEOF(s) != STRSXP) @@ -56,284 +60,287 @@ if (type[0] == '\0' || type[1] != '\0') error(_("argument '%s' (\"%s\") does not have string length %d"), ARGNAME, type, 1); - char type_ = '\0'; + char t = '\0'; switch (type[0]) { case 'O': case 'o': case '1': - type_ = 'O'; + t = 'O'; break; case 'I': case 'i': - type_ = 'I'; + t = 'I'; break; default: error(_("argument '%s' (\"%s\") is not \"%s\", \"%s\", or \"%s\""), ARGNAME, type, "O", "1", "I"); break; } - return type_; + return t; #undef ARGNAME } SEXP dgeMatrix_norm(SEXP obj, SEXP type) { - char type_ = La_norm_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_norm_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ if (m == 0 || n == 0) return ScalarReal(0.0); SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); double norm, *work = NULL; - if (type_ == 'I') + if (t == 'I') work = (double *) R_alloc((size_t) m, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) + norm = + F77_CALL(zlange)(&t, &m, &n, COMPLEX(x), &m, work FCONE); + else +#endif norm = - F77_CALL(dlange)(&type_, &m, &n, REAL(x), &m, - work FCONE); + F77_CALL(dlange)(&t, &m, &n, REAL(x), &m, work FCONE); UNPROTECT(1); /* x */ return ScalarReal(norm); } -SEXP dgeMatrix_rcond(SEXP obj, SEXP trf, SEXP type) +SEXP dsyMatrix_norm(SEXP obj, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ - if (m != n) - error(_("%s(%s) is undefined: '%s' is not square"), "rcond", "x", "x"); - if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + char t = La_norm_type(type); - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - y = PROTECT(GET_SLOT(trf, Matrix_xSym)); - double norm, rcond, - *work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - norm = - F77_CALL(dlange)(&type_, &n, &n, REAL(x), &n, - work FCONE); - F77_CALL(dgecon)(&type_, &n, REAL(y), &n, &norm, &rcond, - work, iwork, &info FCONE); - UNPROTECT(2); /* x, y */ - - return ScalarReal(rcond); -} - -SEXP dtrMatrix_norm(SEXP obj, SEXP type) -{ - char type_ = La_norm_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int n = INTEGER(dim)[1]; if (n == 0) return ScalarReal(0.0); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)), - diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0], - diag_ = CHAR(STRING_ELT(diag, 0))[0]; - UNPROTECT(2); /* uplo, diag */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); double norm, *work = NULL; - if (type_ == 'I') + if (t == 'O' || t == 'I') work = (double *) R_alloc((size_t) n, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) norm = - F77_CALL(dlantr)(&type_, &uplo_, &diag_, &n, &n, REAL(x), &n, - work FCONE FCONE FCONE); + F77_CALL(zlansy)(&t, &ul, &n, COMPLEX(x), &n, work FCONE FCONE); + else +#endif + norm = + F77_CALL(dlansy)(&t, &ul, &n, REAL(x), &n, work FCONE FCONE); UNPROTECT(1); /* x */ return ScalarReal(norm); } -SEXP dtrMatrix_rcond(SEXP obj, SEXP type) +SEXP dspMatrix_norm(SEXP obj, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ - if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); - - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)), - diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0], - diag_ = CHAR(STRING_ELT(diag, 0))[0]; - UNPROTECT(2); /* uplo, diag */ + char t = La_norm_type(type); - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - double rcond, - *work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - F77_CALL(dtrcon)(&type_, &uplo_, &diag_, &n, REAL(x), &n, &rcond, - work, iwork, &info FCONE FCONE FCONE); - UNPROTECT(1); /* x */ - - return ScalarReal(rcond); -} - -SEXP dtpMatrix_norm(SEXP obj, SEXP type) -{ - char type_ = La_norm_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int n = INTEGER(dim)[1]; if (n == 0) return ScalarReal(0.0); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)), - diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0], - diag_ = CHAR(STRING_ELT(diag, 0))[0]; - UNPROTECT(2); /* uplo, diag */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); double norm, *work = NULL; - if (type_ == 'I') + if (t == 'O' || t == 'I') work = (double *) R_alloc((size_t) n, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) norm = - F77_CALL(dlantp)(&type_, &uplo_, &diag_, &n, REAL(x), - work FCONE FCONE FCONE); + F77_CALL(zlansp)(&t, &ul, &n, COMPLEX(x), work FCONE FCONE); + else +#endif + norm = + F77_CALL(dlansp)(&t, &ul, &n, REAL(x), work FCONE FCONE); UNPROTECT(1); /* x */ return ScalarReal(norm); } -SEXP dtpMatrix_rcond(SEXP obj, SEXP type) +SEXP dtrMatrix_norm(SEXP obj, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_norm_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + return ScalarReal(0.0); + + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)), - diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0], - diag_ = CHAR(STRING_ELT(diag, 0))[0]; - UNPROTECT(2); /* uplo, diag */ + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + char di = CHAR(STRING_ELT(diag, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - double rcond, - *work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - F77_CALL(dtpcon)(&type_, &uplo_, &diag_, &n, REAL(x), &rcond, - work, iwork, &info FCONE FCONE FCONE); + double norm, *work = NULL; + if (t == 'I') + work = (double *) R_alloc((size_t) n, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) + norm = + F77_CALL(zlantr)(&t, &ul, &di, &n, &n, COMPLEX(x), &n, work FCONE FCONE FCONE); + else +#endif + norm = + F77_CALL(dlantr)(&t, &ul, &di, &n, &n, REAL(x), &n, work FCONE FCONE FCONE); UNPROTECT(1); /* x */ - return ScalarReal(rcond); + return ScalarReal(norm); } -SEXP dsyMatrix_norm(SEXP obj, SEXP type) +SEXP dtpMatrix_norm(SEXP obj, SEXP type) { - char type_ = La_norm_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_norm_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) return ScalarReal(0.0); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; + + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + char di = CHAR(STRING_ELT(diag, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); double norm, *work = NULL; - if (type_ == 'O' || type_ == 'I') + if (t == 'I') work = (double *) R_alloc((size_t) n, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) norm = - F77_CALL(dlansy)(&type_, &uplo_, &n, REAL(x), &n, - work FCONE FCONE); + F77_CALL(zlantp)(&t, &ul, &di, &n, COMPLEX(x), work FCONE FCONE FCONE); + else +#endif + norm = + F77_CALL(dlantp)(&t, &ul, &di, &n, REAL(x), work FCONE FCONE FCONE); UNPROTECT(1); /* x */ return ScalarReal(norm); } -SEXP dsyMatrix_rcond(SEXP obj, SEXP trf, SEXP type) +SEXP dgeMatrix_rcond(SEXP obj, SEXP trf, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ - if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + char t = La_rcond_type(type); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + if (m != n) + error(_("%s(%s) is undefined: '%s' is not square"), "rcond", "x", "x"); + if (n == 0) + return(ScalarReal(R_PosInf)); SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - y = PROTECT(GET_SLOT(trf, Matrix_xSym)), - pivot = PROTECT(GET_SLOT(trf, Matrix_permSym)); - double norm, rcond, - *work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - norm = - F77_CALL(dlansy)(&type_, &uplo_, &n, REAL(x), &n, - work FCONE FCONE); - F77_CALL(dsycon)( &uplo_, &n, REAL(y), &n, - INTEGER(pivot), &norm, &rcond, - work, iwork, &info FCONE); - UNPROTECT(3); /* x, y, pivot */ + y = PROTECT(GET_SLOT(trf, Matrix_xSym)); + double norm, rcond; + int info; + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double *rwork = (double *) R_alloc((size_t) 2 * n, sizeof(double)); + norm = + F77_CALL(zlange)(&t, &n, &n, COMPLEX(x), &n, work FCONE); + F77_CALL(zgecon)(&t, &n, COMPLEX(y), &n, &norm, &rcond, + (Rcomplex *) work, rwork, &info FCONE); + } else { +#endif + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + norm = + F77_CALL(dlange)(&t, &n, &n, REAL(x), &n, work FCONE); + F77_CALL(dgecon)(&t, &n, REAL(y), &n, &norm, &rcond, + (double *) work, iwork, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + UNPROTECT(2); /* x, y */ return ScalarReal(rcond); } -SEXP dspMatrix_norm(SEXP obj, SEXP type) +SEXP dsyMatrix_rcond(SEXP obj, SEXP trf, SEXP type) { - char type_ = La_norm_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) - return ScalarReal(0.0); + return(ScalarReal(R_PosInf)); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - double norm, *work = NULL; - if (type_ == 'O' || type_ == 'I') - work = (double *) R_alloc((size_t) n, sizeof(double)); + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + y = PROTECT(GET_SLOT(trf, Matrix_xSym)), + pivot = PROTECT(GET_SLOT(trf, Matrix_permSym)); + double norm, rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); norm = - F77_CALL(dlansp)(&type_, &uplo_, &n, REAL(x), - work FCONE FCONE); - UNPROTECT(1); /* x */ + F77_CALL(zlansy)(&t, &ul, &n, COMPLEX(x), &n, work FCONE FCONE); + F77_CALL(zsycon)( &ul, &n, COMPLEX(y), &n, INTEGER(pivot), &norm, &rcond, + (Rcomplex *) work, &info FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + norm = + F77_CALL(dlansy)(&t, &ul, &n, REAL(x), &n, work FCONE FCONE); + F77_CALL(dsycon)( &ul, &n, REAL(y), &n, INTEGER(pivot), &norm, &rcond, + (double *) work, iwork, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + UNPROTECT(3); /* x, y, pivot */ - return ScalarReal(norm); + return ScalarReal(rcond); } SEXP dspMatrix_rcond(SEXP obj, SEXP trf, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + return(ScalarReal(R_PosInf)); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), y = PROTECT(GET_SLOT(trf, Matrix_xSym)), pivot = PROTECT(GET_SLOT(trf, Matrix_permSym)); - double norm, rcond, - *work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - norm = - F77_CALL(dlansp)(&type_, &uplo_, &n, REAL(x), - work FCONE FCONE); - F77_CALL(dspcon)( &uplo_, &n, REAL(y), - INTEGER(pivot), &norm, &rcond, - work, iwork, &info FCONE); + double norm, rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); + norm = + F77_CALL(zlansp)(&t, &ul, &n, COMPLEX(x), work FCONE FCONE); + F77_CALL(zspcon)( &ul, &n, COMPLEX(y), INTEGER(pivot), &norm, &rcond, + (Rcomplex *) work, &info FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 2 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + norm = + F77_CALL(dlansp)(&t, &ul, &n, REAL(x), work FCONE FCONE); + F77_CALL(dspcon)( &ul, &n, REAL(y), INTEGER(pivot), &norm, &rcond, + (double *) work, iwork, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif UNPROTECT(3); /* x, y, pivot */ return ScalarReal(rcond); @@ -341,27 +348,39 @@ SEXP dpoMatrix_rcond(SEXP obj, SEXP trf, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + return(ScalarReal(R_PosInf)); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), y = PROTECT(GET_SLOT(trf, Matrix_xSym)); - double norm, rcond, - *work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - norm = - F77_CALL(dlansy)(&type_, &uplo_, &n, REAL(x), &n, - work FCONE FCONE); - F77_CALL(dpocon)( &uplo_, &n, REAL(y), &n, &norm, &rcond, - work, iwork, &info FCONE); + double norm, rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); + double *rwork = (double *) R_alloc((size_t) n, sizeof(double)); + norm = + F77_CALL(zlansy)(&t, &ul, &n, COMPLEX(x), &n, work FCONE FCONE); + F77_CALL(zpocon)( &ul, &n, COMPLEX(y), &n, &norm, &rcond, + (Rcomplex *) work, rwork, &info FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + norm = + F77_CALL(dlansy)(&t, &ul, &n, REAL(x), &n, work FCONE FCONE); + F77_CALL(dpocon)( &ul, &n, REAL(y), &n, &norm, &rcond, + (double *) work, iwork, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif UNPROTECT(2); /* x, y */ return ScalarReal(rcond); @@ -369,28 +388,116 @@ SEXP dppMatrix_rcond(SEXP obj, SEXP trf, SEXP type) { - char type_ = La_rcond_type(type); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ if (n == 0) - error(_("%s(%s) is undefined: '%s' has length %d"), "rcond", "x", "x", 0); + return(ScalarReal(R_PosInf)); - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char uplo_ = CHAR(STRING_ELT(uplo, 0))[0]; - UNPROTECT(1); /* uplo */ + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), y = PROTECT(GET_SLOT(trf, Matrix_xSym)); - double norm, rcond, - *work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); - int info, *iwork = (int *) R_alloc((size_t) n, sizeof(int)); - norm = - F77_CALL(dlansp)(&type_, &uplo_, &n, REAL(x), - work FCONE FCONE); - F77_CALL(dppcon)( &uplo_, &n, REAL(y), &norm, &rcond, - work, iwork, &info FCONE); + double norm, rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); + double *rwork = (double *) R_alloc((size_t) n, sizeof(double)); + norm = + F77_CALL(zlansp)(&t, &ul, &n, COMPLEX(x), work FCONE FCONE); + F77_CALL(zppcon)( &ul, &n, COMPLEX(y), &norm, &rcond, + (Rcomplex *) work, rwork, &info FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + norm = + F77_CALL(dlansp)(&t, &ul, &n, REAL(x), work FCONE FCONE); + F77_CALL(dppcon)( &ul, &n, REAL(y), &norm, &rcond, + (double *) work, iwork, &info FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif UNPROTECT(2); /* x, y */ return ScalarReal(rcond); } + +SEXP dtrMatrix_rcond(SEXP obj, SEXP type) +{ + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int n = INTEGER(dim)[0]; + if (n == 0) + return(ScalarReal(R_PosInf)); + + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; + + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + char di = CHAR(STRING_ELT(diag, 0))[0]; + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + double rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); + double *rwork = (double *) R_alloc((size_t) n, sizeof(double)); + F77_CALL(ztrcon)(&t, &ul, &di, &n, COMPLEX(x), &n, &rcond, + (Rcomplex *) work, rwork, &info FCONE FCONE FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + F77_CALL(dtrcon)(&t, &ul, &di, &n, REAL(x), &n, &rcond, + (double *) work, iwork, &info FCONE FCONE FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + UNPROTECT(1); /* x */ + + return ScalarReal(rcond); +} + +SEXP dtpMatrix_rcond(SEXP obj, SEXP type) +{ + char t = La_rcond_type(type); + + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int n = INTEGER(dim)[0]; + if (n == 0) + return(ScalarReal(R_PosInf)); + + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = CHAR(STRING_ELT(uplo, 0))[0]; + + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + char di = CHAR(STRING_ELT(diag, 0))[0]; + + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); + double rcond; + int info; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(x) == CPLXSXP) { + double * work = (double *) R_alloc((size_t) 4 * n, sizeof(double)); + double *rwork = (double *) R_alloc((size_t) n, sizeof(double)); + F77_CALL(ztpcon)(&t, &ul, &di, &n, COMPLEX(x), &rcond, + (Rcomplex *) work, rwork, &info FCONE FCONE FCONE); + } else { +#endif + double * work = (double *) R_alloc((size_t) 3 * n, sizeof(double)); + int *iwork = (int *) R_alloc((size_t) n, sizeof(int )); + F77_CALL(dtpcon)(&t, &ul, &di, &n, REAL(x), &rcond, + (double *) work, iwork, &info FCONE FCONE FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + UNPROTECT(1); /* x */ + + return ScalarReal(rcond); +} diff -Nru rmatrix-1.6-1.1/src/kappa.h rmatrix-1.6-5/src/kappa.h --- rmatrix-1.6-1.1/src/kappa.h 2023-06-24 01:53:34.000000000 +0000 +++ rmatrix-1.6-5/src/kappa.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,26 +1,20 @@ #ifndef MATRIX_KAPPA_H #define MATRIX_KAPPA_H -#include "Lapack-etc.h" -#include "Mutils.h" +#include -SEXP dgeMatrix_norm(SEXP obj, SEXP type); -SEXP dgeMatrix_rcond(SEXP obj, SEXP trf, SEXP type); - -SEXP dtrMatrix_norm(SEXP obj, SEXP type); -SEXP dtrMatrix_rcond(SEXP obj, SEXP type); - -SEXP dtpMatrix_norm(SEXP obj, SEXP type); -SEXP dtpMatrix_rcond(SEXP obj, SEXP type); - -SEXP dsyMatrix_norm(SEXP obj, SEXP type); -SEXP dsyMatrix_rcond(SEXP obj, SEXP trf, SEXP type); - -SEXP dspMatrix_norm(SEXP obj, SEXP type); -SEXP dspMatrix_rcond(SEXP obj, SEXP trf, SEXP type); - -SEXP dpoMatrix_rcond(SEXP obj, SEXP trf, SEXP type); - -SEXP dppMatrix_rcond(SEXP obj, SEXP trf, SEXP type); +SEXP dgeMatrix_norm(SEXP, SEXP); +SEXP dsyMatrix_norm(SEXP, SEXP); +SEXP dspMatrix_norm(SEXP, SEXP); +SEXP dtrMatrix_norm(SEXP, SEXP); +SEXP dtpMatrix_norm(SEXP, SEXP); + +SEXP dgeMatrix_rcond(SEXP, SEXP, SEXP); +SEXP dsyMatrix_rcond(SEXP, SEXP, SEXP); +SEXP dspMatrix_rcond(SEXP, SEXP, SEXP); +SEXP dpoMatrix_rcond(SEXP, SEXP, SEXP); +SEXP dppMatrix_rcond(SEXP, SEXP, SEXP); +SEXP dtrMatrix_rcond(SEXP, SEXP); +SEXP dtpMatrix_rcond(SEXP, SEXP); #endif /* MATRIX_KAPPA_H */ diff -Nru rmatrix-1.6-1.1/src/objects.c rmatrix-1.6-5/src/objects.c --- rmatrix-1.6-1.1/src/objects.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/objects.c 2023-10-11 13:25:02.000000000 +0000 @@ -0,0 +1,174 @@ +#include "Mdefines.h" +#include "objects.h" + +SEXP newObject(const char *what) +{ + SEXP class = PROTECT(R_do_MAKE_CLASS(what)), obj = R_do_new_object(class); + UNPROTECT(1); + return obj; +} + +char typeToKind(SEXPTYPE type) +{ + switch (type) { + case LGLSXP: + return 'l'; + case INTSXP: + return 'i'; + case REALSXP: + return 'd'; + case CPLXSXP: + return 'z'; + default: + error(_("unexpected type \"%s\" in '%s'"), type2char(type), __func__); + return '\0'; + } +} + +SEXPTYPE kindToType(char kind) +{ + switch (kind) { + case 'n': + case 'l': + return LGLSXP; + case 'i': + return INTSXP; + case 'd': + return REALSXP; + case 'z': + return CPLXSXP; + default: + error(_("unexpected kind \"%c\" in '%s'"), kind, __func__); + return NILSXP; + } +} + +size_t kindToSize(char kind) +{ + switch (kind) { + case 'n': + case 'l': + case 'i': + return sizeof(int); + case 'd': + return sizeof(double); + case 'z': + return sizeof(Rcomplex); + default: + error(_("unexpected kind \"%c\" in '%s'"), kind, __func__); + return 0; + } +} + +const char *Matrix_nonvirtual(SEXP obj, int strict) +{ + if (!IS_S4_OBJECT(obj)) + return ""; + static const char *valid[] = { VALID_NONVIRTUAL, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + return ""; + if (!strict) + ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); + return valid[ivalid]; +} + +char Matrix_kind(SEXP obj) +{ + if (IS_S4_OBJECT(obj)) { + static const char *valid[] = { VALID_NONVIRTUAL, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + return '\0'; + ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); + const char *cl = valid[ivalid]; + return (cl[2] == 'd') ? 'n' : cl[0]; + } else { + switch (TYPEOF(obj)) { + case LGLSXP: + return 'l'; + case INTSXP: + return 'i'; + case REALSXP: + return 'd'; + case CPLXSXP: + return 'z'; + default: + return '\0'; + } + } +} + +char Matrix_shape(SEXP obj) +{ + if (!IS_S4_OBJECT(obj)) + return '\0'; + static const char *valid[] = { VALID_NONVIRTUAL, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + return '\0'; + ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); + const char *cl = valid[ivalid]; + return (cl[2] == 'd' || cl[3] != 'M') ? 'g' : cl[1]; +} + +char Matrix_repr(SEXP obj) +{ + if (!IS_S4_OBJECT(obj)) + return '\0'; + static const char *valid[] = { VALID_NONVIRTUAL_MATRIX, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + return '\0'; + ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1); + const char *cl = valid[ivalid]; + switch (cl[2]) { + case 'e': + case 'y': + case 'r': + return 'u'; /* unpackedMatrix */ + case 'p': + return 'p'; /* packedMatrix */ + case 'C': + case 'R': + case 'T': + return cl[2]; /* [CRT]sparseMatrix */ + case 'i': + return 'd'; /* diagonalMatrix */ + case 'd': + return 'i'; /* indMatrix */ + default: + return '\0'; + } +} + +SEXP R_Matrix_nonvirtual(SEXP obj, SEXP strict) +{ + return mkString(Matrix_nonvirtual(obj, asLogical(strict))); +} + +#define RETURN_AS_STRSXP(_C_) \ +do { \ + char c = _C_; \ + if (!c) \ + return mkString(""); \ + else { \ + char s[] = { c, '\0' }; \ + return mkString(s); \ + } \ +} while (0) + +SEXP R_Matrix_kind(SEXP obj) +{ + RETURN_AS_STRSXP(Matrix_kind (obj)); +} + +SEXP R_Matrix_shape(SEXP obj) +{ + RETURN_AS_STRSXP(Matrix_shape(obj)); +} + +SEXP R_Matrix_repr(SEXP obj) +{ + RETURN_AS_STRSXP(Matrix_repr (obj)); +} diff -Nru rmatrix-1.6-1.1/src/objects.h rmatrix-1.6-5/src/objects.h --- rmatrix-1.6-1.1/src/objects.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/objects.h 2023-10-11 13:25:02.000000000 +0000 @@ -0,0 +1,11 @@ +#ifndef MATRIX_OBJECTS_H +#define MATRIX_OBJECTS_H + +#include + +SEXP R_Matrix_nonvirtual(SEXP, SEXP); +SEXP R_Matrix_kind (SEXP); +SEXP R_Matrix_shape(SEXP); +SEXP R_Matrix_repr (SEXP); + +#endif /* MATRIX_OBJECTS_H */ diff -Nru rmatrix-1.6-1.1/src/packedMatrix.c rmatrix-1.6-5/src/packedMatrix.c --- rmatrix-1.6-1.1/src/packedMatrix.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/packedMatrix.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1056 +0,0 @@ -#include "packedMatrix.h" - -#define UNPACK(_PREFIX_, _CTYPE_, _ONE_) \ -void _PREFIX_ ## dense_unpack(_CTYPE_ *dest, const _CTYPE_ *src, int n, \ - char uplo, char diag) \ -{ \ - int i, j; \ - R_xlen_t dpos = 0, spos = 0; \ - if (uplo == 'U') { \ - for (j = 0; j < n; dpos += n-(++j)) \ - for (i = 0; i <= j; ++i) \ - dest[dpos++] = src[spos++]; \ - } else { \ - for (j = 0; j < n; dpos += (++j)) \ - for (i = j; i < n; ++i) \ - dest[dpos++] = src[spos++]; \ - } \ - if (diag != 'N') { \ - dpos = 0; \ - R_xlen_t n1a = (R_xlen_t) n + 1; \ - for (j = 0; j < n; ++j, dpos += n1a) \ - dest[dpos] = _ONE_; \ - } \ - return; \ -} - -/** - * @brief Unpack a `packedMatrix`. - * - * Copies `src` to the upper or lower triangular part of `dest`, - * where it is stored _non_-contiguously ("unpacked"). Optionally - * resets the diagonal elements to 1. - * - * @param dest,src Pointers to the first elements of length-`n*n` and - * length-`(n*(n+1))/2` (resp.) arrays, usually the "data" of the - * `x` slot of an `n`-by-`n` `unpackedMatrix` and `packedMatrix` - * (resp.). - * @param n Size of matrix being unpacked. - * @param uplo,diag `char` specifying whether to copy `src` to - * the upper (`'U'`) or lower (`'L'`) triangle of `dest` and - * whether to "force" a unit diagonal (`'U'`) or not (`'N'`). - */ -/* ddense_unpack() */ -UNPACK(d, double, 1.0) -/* idense_unpack() */ -UNPACK(i, int, 1) -/* zdense_unpack() */ -UNPACK(z, Rcomplex, Matrix_zone) - -#undef UNPACK - -#define MAKE_BANDED(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ -void _PREFIX_ ## dense_packed_make_banded(_CTYPE_ *x, int n, \ - int a, int b, \ - char uplo, char diag) \ -{ \ - if (n == 0) \ - return; \ - if (a > b || a >= n || b <= -n) { \ - Matrix_memset(x, 0, PM_LENGTH(n), sizeof(_CTYPE_)); \ - return; \ - } \ - if (uplo == 'U') { \ - if (a < 0) a = 0; \ - if (b >= n) b = n-1; \ - } else { \ - if (b > 0) b = 0; \ - if (a <= -n) a = 1-n; \ - } \ - \ - int i, j, i0, i1, \ - j0 = (a < 0) ? 0 : a, \ - j1 = (b < 0) ? n+b : n; \ - \ - if (uplo == 'U') { \ - if (j0 > 0) { \ - R_xlen_t dx; \ - Matrix_memset(x, 0, dx = PM_LENGTH(j0), \ - sizeof(_CTYPE_)); \ - x += dx; \ - } \ - for (j = j0; j < j1; x += (++j)) { \ - i0 = j - b; \ - i1 = j - a + 1; \ - for (i = 0; i < i0; ++i) \ - *(x + i) = _ZERO_; \ - for (i = i1; i <= j; ++i) \ - *(x + i) = _ZERO_; \ - } \ - if (j1 < n) \ - Matrix_memset(x, 0, PM_LENGTH(n) - PM_LENGTH(j1), \ - sizeof(_CTYPE_)); \ - if (diag != 'N' && a == 0) { \ - x -= PM_LENGTH(j); \ - for (j = 0; j < n; x += (++j)+1) \ - *x = _ONE_; \ - } \ - } else { \ - if (j0 > 0) { \ - R_xlen_t dx; \ - Matrix_memset(x, 0, dx = PM_LENGTH(n) - PM_LENGTH(j0), \ - sizeof(_CTYPE_)); \ - x += dx; \ - } \ - for (j = j0; j < j1; x += n-(j++)) { \ - i0 = j - b; \ - i1 = j - a + 1; \ - for (i = j; i < i0; ++i) \ - *(x + i - j) = _ZERO_; \ - for (i = i1; i < n; ++i) \ - *(x + i - j) = _ZERO_; \ - } \ - if (j1 < n) \ - Matrix_memset(x, 0, PM_LENGTH(n - j1), \ - sizeof(_CTYPE_)); \ - if (diag != 'N' && b == 0) { \ - x -= PM_LENGTH(n) - PM_LENGTH(j); \ - for (j = 0; j < n; x += n-(j++)) \ - *x = _ONE_; \ - } \ - } \ - return; \ -} -MAKE_BANDED(d, double, 0.0, 1.0) -MAKE_BANDED(i, int, 0, 1) -MAKE_BANDED(z, Rcomplex, Matrix_zzero, Matrix_zone) - -#undef MAKE_BANDED - -#define COPY_DIAGONAL(_PREFIX_, _CTYPE_, _ONE_) \ -void _PREFIX_ ## dense_packed_copy_diagonal(_CTYPE_ *dest, \ - const _CTYPE_ *src, \ - int n, R_xlen_t len, \ - char uplo_dest, \ - char uplo_src, \ - char diag) \ -{ \ - int j; \ - if (diag != 'N') { \ - if (uplo_dest != 'L') { \ - for (j = 0; j < n; dest += (++j)+1) \ - *dest = _ONE_; \ - } else { \ - for (j = 0; j < n; dest += n-(j++)) \ - *dest = _ONE_; \ - } \ - } else if (len == n) { \ - /* copying from diagonalMatrix */ \ - if (uplo_dest != 'L') { \ - for (j = 0; j < n; dest += (++j)+1, ++src) \ - *dest = *src; \ - } else { \ - for (j = 0; j < n; dest += n-(j++), ++src) \ - *dest = *src; \ - } \ - } else if (len == PM_LENGTH(n)) { \ - /* copying from packedMatrix */ \ - if (uplo_dest != 'L') { \ - if (uplo_src != 'L') { \ - for (j = 0; j < n; src += (++j)+1, dest += j+1) \ - *dest = *src; \ - } else { \ - for (j = 0; j < n; src += n-j, dest += (++j)+1) \ - *dest = *src; \ - } \ - } else { \ - if (uplo_src != 'L') { \ - for (j = 0; j < n; dest += n-(j++), src += j+1) \ - *dest = *src; \ - } else { \ - for (j = 0; j < n; dest += n-j, src += n-(j++)) \ - *dest = *src; \ - } \ - } \ - } else if (len == (R_xlen_t) n * n) { \ - /* copying from square unpackedMatrix */ \ - R_xlen_t n1a = (R_xlen_t) n + 1; \ - if (uplo_dest != 'L') { \ - for (j = 0; j < n; dest += (++j)+1, src += n1a) \ - *dest = *src; \ - } else { \ - for (j = 0; j < n; dest += n-(j++), src += n1a) \ - *dest = *src; \ - } \ - } else { \ - error(_("incompatible '%s' and '%s' in %s()"), "n", "len", __func__); \ - } \ - return; \ -} - -/** - * Copy a length-`n` diagonal to a length-`(n*(n+1))/2` array. - * - * @param dest A pointer to the first element of a length-`(n*(n+1))/2` array, - * usually the "data" of the `x` slot of an `n`-by-`n` `packedMatrix`. - * @param src A pointer to the first element of a length-`n`, - * length-`(n*(n+1))/2`, or length-`n*n` array, usually the "data" - * of the `x` slot of an `n`-by-`n` `diagonalMatrix`, `packedMatrix`, - * or `unpackedMatrix`, respectively. - * @param n Size of matrix being copied from and to. - * @param len Length of `src` array. - * @param uplo_dest,uplo_src,diag_src `char` constants specifying - * whether `dest` stores an upper (`'U'`) or lower (`'L'`) triangle, - * whether `src` stores an upper (`'U'`) or lower (`'L'`) triangle - * when `len == (n*(n+1))/2`, and whether the matrix should have a - * unit diagonal (`'U'`) or not (`'N'`). - */ -/* ddense_packed_copy_diagonal() */ -COPY_DIAGONAL(d, double, 1.0) -/* idense_packed_copy_diagonal() */ -COPY_DIAGONAL(i, int, 1) -/* zdense_packed_copy_diagonal() */ -COPY_DIAGONAL(z, Rcomplex, Matrix_zone) - -#undef COPY_DIAGONAL - -#define IS_DIAGONAL(_PREFIX_, _CTYPE_, \ - _U_IS_NOT_ZERO_, _L_IS_NOT_ZERO_) \ -static Rboolean _PREFIX_ ## dense_packed_is_diagonal(const _CTYPE_ *x, \ - int n, char uplo) \ -{ \ - int i, j; \ - if (uplo == 'U') { \ - for (j = 0; j < n; ++j, ++x) \ - for (i = 0; i < j; ++i) \ - if (_U_IS_NOT_ZERO_) \ - return FALSE; \ - } else { \ - for (j = 0; j < n; ++j, ++x) \ - for (i = j+1; i < n; ++i) \ - if (_L_IS_NOT_ZERO_) \ - return FALSE; \ - } \ - return TRUE; \ -} - -/* ddense_packed_is_diagonal() */ -IS_DIAGONAL(d, double, - ISNAN(*x) || *(x++) != 0.0, - ISNAN(*(++x)) || *x != 0.0) -/* idense_packed_is_diagonal() */ -IS_DIAGONAL(i, int, - *(x++) != 0, - *(++x) != 0) -/* zdense_packed_is_diagonal() */ -IS_DIAGONAL(z, Rcomplex, - ISNAN((*x).r) || (*x).r != 0.0 || - ISNAN((*x).i) || (*(x++)).i != 0.0, - ISNAN((*(++x)).r) || (*x).r != 0.0 || - ISNAN((*x).i) || (*x).i != 0.0) - -#undef IS_DIAGONAL - -#define TRANSPOSE(_PREFIX_, _CTYPE_) \ -static void _PREFIX_ ## dense_packed_transpose(_CTYPE_ *dest, \ - const _CTYPE_ *src, \ - int n, char uplo) \ -{ \ - int i, j; \ - if (uplo == 'U') { \ - for (j = 0; j < n; ++j) \ - for (i = j; i < n; ++i) \ - *(dest++) = *(src + PM_AR21_UP(j, i)); \ - } else { \ - R_xlen_t n2 = (R_xlen_t) n * 2; \ - for (j = 0; j < n; ++j) \ - for (i = 0; i <= j; ++i) \ - *(dest++) = *(src + PM_AR21_LO(j, i, n2)); \ - } \ - return; \ -} - -/* ddense_packed_transpose() */ -TRANSPOSE(d, double) -/* idense_packed_transpose() */ -TRANSPOSE(i, int) -/* zdense_packed_transpose() */ -TRANSPOSE(z, Rcomplex) - -#undef TRANSPOSE - -SEXP packed_transpose(SEXP x, int n, char uplo) -{ - SEXPTYPE tx = TYPEOF(x); - if (tx < LGLSXP || tx > CPLXSXP) - ERROR_INVALID_TYPE(x, __func__); - R_xlen_t nx = XLENGTH(x); - SEXP y = PROTECT(allocVector(tx, nx)); - -#define TRANSPOSE(_PREFIX_, _PTR_) \ - _PREFIX_ ## dense_packed_transpose(_PTR_(y), _PTR_(x), n, uplo) - - switch (tx) { - case LGLSXP: - TRANSPOSE(i, LOGICAL); - break; - case INTSXP: - TRANSPOSE(i, INTEGER); - break; - case REALSXP: - TRANSPOSE(d, REAL); - break; - case CPLXSXP: - TRANSPOSE(z, COMPLEX); - break; - default: - break; - } - -#undef TRANSPOSE - - UNPROTECT(1); - return y; -} - -/* forceSymmetric(x, uplo), returning .spMatrix */ -SEXP packedMatrix_force_symmetric(SEXP from, SEXP uplo_to) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *clf = valid[ivalid]; - - SEXP uplo_from = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ulf = *CHAR(STRING_ELT(uplo_from, 0)), ult = ulf; - UNPROTECT(1); /* uplo_from */ - - if (!isNull(uplo_to) && - (TYPEOF(uplo_to) != STRSXP || LENGTH(uplo_to) < 1 || - (uplo_to = STRING_ELT(uplo_to, 0)) == NA_STRING || - ((ult = *CHAR(uplo_to)) != 'U' && ult != 'L'))) - error(_("invalid '%s' to %s()"), "uplo", __func__); - - if (clf[1] == 's') { - /* .spMatrix */ - if (ulf == ult) - return from; - SEXP to = PROTECT(packedMatrix_transpose(from)); - if (clf[0] == 'z') { - /* Need _conjugate_ transpose */ - SEXP x_to = PROTECT(GET_SLOT(to, Matrix_xSym)); - conjugate(x_to); - UNPROTECT(1); /* x_to */ - } - UNPROTECT(1); /* to */ - return to; - } - - /* Now handling just .tpMatrix ... */ - - char clt[] = ".spMatrix"; - clt[0] = clf[0]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)), - x_from = PROTECT(GET_SLOT(from, Matrix_xSym)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - set_symmetrized_DimNames(to, dimnames, -1); - UNPROTECT(1); /* dimnames */ - - if (ult != 'U') { - PROTECT(uplo_to = mkString("L")); - SET_SLOT(to, Matrix_uploSym, uplo_to); - UNPROTECT(1); /* uplo_to */ - } - - if (ulf == ult) { - /* .tpMatrix with correct uplo */ - SET_SLOT(to, Matrix_xSym, x_from); - } else { - /* .tpMatrix with incorrect uplo */ - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - - SEXPTYPE tx = TYPEOF(x_from); - R_xlen_t nx = XLENGTH(x_from); - SEXP x_to = PROTECT(allocVector(tx, nx)); - -#define COPY_DIAGONAL(_PREFIX_, _CTYPE_, _PTR_) \ - do { \ - Matrix_memset(_PTR_(x_to), 0, nx, sizeof(_CTYPE_)); \ - _PREFIX_ ## dense_packed_copy_diagonal( \ - _PTR_(x_to), _PTR_(x_from), n, nx, ult, ulf, di); \ - } while (0) - - switch (tx) { - case LGLSXP: /* [nl]..Matrix */ - COPY_DIAGONAL(i, int, LOGICAL); - break; - case INTSXP: /* i..Matrix */ - COPY_DIAGONAL(i, int, INTEGER); - break; - case REALSXP: /* d..Matrix */ - COPY_DIAGONAL(d, double, REAL); - break; - case CPLXSXP: /* z..Matrix */ - COPY_DIAGONAL(z, Rcomplex, COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x_from, __func__); - break; - } - -#undef COPY_DIAGONAL - - SET_SLOT(to, Matrix_xSym, x_to); - UNPROTECT(1); /* x_to */ - } - - UNPROTECT(2); /* x_from, to */ - return to; -} - -#define PM_IS_DI(_RES_, _X_, _N_, _UPLO_) \ -do { \ - switch (TYPEOF(_X_)) { \ - case LGLSXP: \ - _RES_ = idense_packed_is_diagonal(LOGICAL(_X_), _N_, _UPLO_); \ - break; \ - case INTSXP: \ - _RES_ = idense_packed_is_diagonal(INTEGER(_X_), _N_, _UPLO_); \ - break; \ - case REALSXP: \ - _RES_ = ddense_packed_is_diagonal(REAL(_X_), _N_, _UPLO_); \ - break; \ - case CPLXSXP: \ - _RES_ = zdense_packed_is_diagonal(COMPLEX(_X_), _N_, _UPLO_); \ - break; \ - default: \ - ERROR_INVALID_TYPE(_X_, __func__); \ - _RES_ = FALSE; \ - break; \ - } \ -} while (0) - -/* isTriangular(x, upper) */ -SEXP packedMatrix_is_triangular(SEXP obj, SEXP upper) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - - int need_upper = asLogical(upper); - - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - -#define IF_DIAGONAL \ - Rboolean res = FALSE; \ - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), \ - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int n = INTEGER(dim)[0]; \ - PM_IS_DI(res, x, n, ul); \ - UNPROTECT(2); /* dim, x */ \ - if (res) - - if (ivalid < 3) { - /* .tpMatrix: fast if 'upper', 'uplo' agree; else need diagonal */ - if (need_upper == NA_LOGICAL) - RETURN_TRUE_OF_KIND((ul == 'U') ? "U" : "L"); - else if ((need_upper) ? ul == 'U' : ul != 'U') - return ScalarLogical(1); - else { - IF_DIAGONAL { - return ScalarLogical(1); - } - } - } else { - /* .spMatrix: triangular iff diagonal */ - IF_DIAGONAL { - if (need_upper == NA_LOGICAL) - RETURN_TRUE_OF_KIND("U"); - else - return ScalarLogical(1); - } - } - -#undef IF_DIAGONAL - - return ScalarLogical(0); -} - -/* isSymmetric(x, tol = 0, checkDN) */ -/* FIXME: not checking for real diagonal in complex case */ -SEXP packedMatrix_is_symmetric(SEXP obj, SEXP checkDN) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) { - ERROR_INVALID_CLASS(obj, __func__); - return R_NilValue; - } else if (ivalid < 3) { - /* .tpMatrix: symmetric iff diagonal */ - if (asLogical(checkDN) != 0) { - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - int s = DimNames_is_symmetric(dimnames); - UNPROTECT(1); /* dimnames */ - if (!s) - return ScalarLogical(0); - } - Rboolean res = FALSE; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int n = INTEGER(dim)[0]; - char ul = *CHAR(STRING_ELT(uplo, 0)); - PM_IS_DI(res, x, n, ul); - UNPROTECT(3); /* uplo, dim, x */ - return ScalarLogical(res); - } else { - /* .spMatrix: symmetric by definition */ - return ScalarLogical(1); - } -} - -/* isDiagonal(x) */ -SEXP packedMatrix_is_diagonal(SEXP obj) -{ - /* _Not_ checking class of 'obj' */ - Rboolean res = FALSE; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)), - uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - int n = INTEGER(dim)[0]; - char ul = *CHAR(STRING_ELT(uplo, 0)); - PM_IS_DI(res, x, n, ul); - UNPROTECT(3); /* uplo, dim, x */ - return ScalarLogical(res); -} - -#undef PM_IS_DI - -/* t(x) */ -SEXP packedMatrix_transpose(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "pcorMatrix", "dppMatrix", - /* 5 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(valid[ivalid])); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (ivalid < 3) - set_reversed_DimNames(to, dimnames); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - SEXP uplo_from = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ulf = *CHAR(STRING_ELT(uplo_from, 0)); - UNPROTECT(1); /* uplo_from */ - - if (ulf == 'U') { - SEXP uplo_to = PROTECT(mkString("L")); - SET_SLOT(to, Matrix_uploSym, uplo_to); - UNPROTECT(1); /* uplo_to */ - } - - if (ivalid < 3) { - /* .tpMatrix */ - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - if (di != 'N') - SET_SLOT(to, Matrix_diagSym, diag); - UNPROTECT(1); /* diag */ - } else { - /* .spMatrix */ - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); - if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); - UNPROTECT(1); /* factors */ - - if (ivalid == 3) { - /* pcorMatrix */ - SEXP sd = PROTECT(GET_SLOT(from, Matrix_sdSym)); - if (LENGTH(sd) > 0) - SET_SLOT(to, Matrix_sdSym, sd); - UNPROTECT(1); /* sd */ - } - } - - SEXP x_from = PROTECT(GET_SLOT(from, Matrix_xSym)), - x_to = PROTECT(packed_transpose(x_from, n, ulf)); - SET_SLOT(to, Matrix_xSym, x_to); - - UNPROTECT(3); /* x_to, x_from, to */ - return to; -} - -/* diag(x, names) */ -SEXP packedMatrix_diag_get(SEXP obj, SEXP nms) -{ - int do_nms = asLogical(nms); - if (do_nms == NA_LOGICAL) - error(_("'%s' must be %s or %s"), "names", "TRUE", "FALSE"); - - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ - - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - - char di = '\0'; - if (HAS_SLOT(obj, Matrix_diagSym)) { - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - } - - SEXPTYPE tx; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - res = PROTECT(allocVector(tx = TYPEOF(x), n)); - -#define PM_D_G(_CTYPE_, _PTR_, _ONE_) \ - do { \ - _CTYPE_ *pres = _PTR_(res); \ - int j; \ - if (di == 'U') { \ - for (j = 0; j < n; ++j) \ - *(pres++) = _ONE_; \ - } else { \ - _CTYPE_ *px = _PTR_(x); \ - if (ul == 'U') \ - for (j = 0; j < n; px += (++j)+1) \ - *(pres++) = *px; \ - else \ - for (j = 0; j < n; px += n-(j++)) \ - *(pres++) = *px; \ - } \ - } while (0) - - switch (tx) { - case LGLSXP: /* [nl]..Matrix */ - PM_D_G(int, LOGICAL, 1); - break; - case INTSXP: /* i..Matrix */ - PM_D_G(int, INTEGER, 1); - break; - case REALSXP: /* d..Matrix */ - PM_D_G(double, REAL, 1.0); - break; - case CPLXSXP: /* z..Matrix */ - PM_D_G(Rcomplex, COMPLEX, Matrix_zone); - break; - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - -#undef PM_D_G - - if (do_nms) { - /* NB: The logic here must be adjusted once the validity method - for 'symmetricMatrix' enforces symmetric 'Dimnames' */ - SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), - rn = VECTOR_ELT(dn, 0), - cn = VECTOR_ELT(dn, 1); - if (isNull(cn)) { - if (di == '\0' && !isNull(rn)) - setAttrib(res, R_NamesSymbol, rn); - } else { - if (di == '\0' || - (!isNull(rn) && - (rn == cn || equal_string_vectors(rn, cn, n)))) - setAttrib(res, R_NamesSymbol, cn); - } - UNPROTECT(1); /* dn */ - } - - UNPROTECT(2); /* res, x */ - return res; -} - -/* diag(x) <- value */ -SEXP packedMatrix_diag_set(SEXP obj, SEXP val) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - - SEXPTYPE tv = TYPEOF(val); - if (tv < LGLSXP || tv > REALSXP) - /* Upper bound can become CPLXSXP once we have proper zMatrix */ - error(_("replacement diagonal has incompatible type \"%s\""), - type2char(tv)); - - R_xlen_t nv = XLENGTH(val); - if (nv != 1 && nv != n) - error(_("replacement diagonal has wrong length")); - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(obj, Matrix_xSym), &pid); - SEXPTYPE tx = TYPEOF(x); - - /* Allocate and coerce as necessary */ - SEXP res; - if (tv <= tx) { - PROTECT(val = coerceVector(val, tv = tx)); - PROTECT(res = NEW_OBJECT_OF_CLASS(valid[ivalid])); - REPROTECT(x = duplicate(x), pid); - } else { /* tv > tx */ - /* dMatrix is only possibility until we have proper [iz]Matrix */ - PROTECT(val = coerceVector(val, tv = REALSXP)); - char cl[] = "d.pMatrix"; - cl[1] = valid[ivalid][1]; - PROTECT(res = NEW_OBJECT_OF_CLASS(cl)); - REPROTECT(x = coerceVector(x, tx = tv), pid); - } - - if (n > 0) - SET_SLOT(res, Matrix_DimSym, dim); - - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - SET_SLOT(res, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - if (ul != 'U') - SET_SLOT(res, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - -#define PM_D_S(_CTYPE_, _PTR_) \ - do { \ - _CTYPE_ *px = _PTR_(x), *pval = _PTR_(val); \ - int j; \ - if (nv == 1) { \ - if (ul == 'U') \ - for (j = 0; j < n; px += (++j)+1) \ - *px = *pval; \ - else \ - for (j = 0; j < n; px += n-(j++)) \ - *px = *pval; \ - } else { \ - if (ul == 'U') \ - for (j = 0; j < n; px += (++j)+1) \ - *px = *(pval++); \ - else \ - for (j = 0; j < n; px += n-(j++)) \ - *px = *(pval++); \ - } \ - } while (0) - - switch (tx) { - case LGLSXP: - PM_D_S(int, LOGICAL); - break; - case INTSXP: - PM_D_S(int, INTEGER); - break; - case REALSXP: - PM_D_S(double, REAL); - break; - case CPLXSXP: - PM_D_S(Rcomplex, COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - -#undef PM_D_S - - SET_SLOT(res, Matrix_xSym, x); - - UNPROTECT(4); /* x, res, val, dim */ - return res; -} - -/* symmpart(x) */ -SEXP packedMatrix_symmpart(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - - const char *clf = valid[ivalid]; - if (clf[0] == 'd' && clf[1] == 's') - return from; - - char clt[] = ".spMatrix"; - clt[0] = (clf[0] != 'z') ? 'd' : 'z'; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (clf[1] != 's') - set_symmetrized_DimNames(to, dimnames, -1); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - if (ul != 'U') - SET_SLOT(to, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(from, Matrix_xSym), &pid); - REPROTECT(x = (clf[0] == clt[0]) ? duplicate(x) : coerceVector(x, REALSXP), - pid); - if (clf[0] == 'n') - na2one(x); - - if (clf[1] != 's') { - - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - - int i, j; - -#define PM_SYMMPART_TP(_CTYPE_, _PTR_, _ASSIGN_OFFDIAG_, _ASSIGN_ONDIAG_) \ - do { \ - _CTYPE_ *px = _PTR_(x); \ - if (ul == 'U') { \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - _ASSIGN_OFFDIAG_; \ - ++px; \ - } \ - if (di != 'N') { \ - px = _PTR_(x); \ - for (j = 0; j < n; px += (++j)+1) \ - _ASSIGN_ONDIAG_; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - ++px; \ - for (i = j+1; i < n; ++i, ++px) \ - _ASSIGN_OFFDIAG_; \ - } \ - if (di != 'N') { \ - px = _PTR_(x); \ - for (j = 0; j < n; px += n-(j++)) \ - _ASSIGN_ONDIAG_; \ - } \ - } \ - } while (0) - - if (clt[0] != 'z') - PM_SYMMPART_TP(double, REAL, - *px *= 0.5, - *px = 1.0); - else - PM_SYMMPART_TP(Rcomplex, COMPLEX, - do { (*px).r *= 0.5; (*px).i *= 0.5; } while (0), - do { (*px).r = 1.0; (*px).i = 0.0; } while (0)); - -#undef PM_SYMMPART_TP - - } else { /* clf[1] == 's' */ - - if (clt[0] == 'z') - /* Symmetric part of Hermitian matrix is real part */ - zeroIm(x); - - } - - SET_SLOT(to, Matrix_xSym, x); - - UNPROTECT(2); /* x, to */ - return to; -} - -/* skewpart(x) */ -SEXP packedMatrix_skewpart(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dtpMatrix", "ltpMatrix", "ntpMatrix", - /* 3 */ "dspMatrix", "lspMatrix", "nspMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *clf = valid[ivalid]; - - char clt[] = "...Matrix"; - clt[0] = (clf[0] != 'z') ? 'd' : 'z'; - clt[1] = (clf[1] != 's') ? 'g' : 's'; - clt[2] = (clf[1] != 's') ? 'e' : ((clf[0] != 'z') ? 'C' : 'p'); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (clf[1] != 's') - set_symmetrized_DimNames(to, dimnames, -1); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - if (clf[1] == 's' && ul != 'U') - SET_SLOT(to, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(from, Matrix_xSym), &pid); - - if (clf[1] != 's') { - - if ((double) n * n > R_XLEN_T_MAX) - error(_("attempt to allocate vector of length exceeding %s"), - "R_XLEN_T_MAX"); - - SEXP y; - int i, j; - R_xlen_t upos = 0, lpos = 0; - -#define PM_SKEWPART(_CTYPE_, _PTR_, _ASSIGN_OFFDIAG_, _ASSIGN_ONDIAG_) \ - do { \ - _CTYPE_ *px = _PTR_(x), *py = _PTR_(y); \ - if (ul == 'U') { \ - for (j = 0; j < n; ++j) { \ - lpos = j; \ - for (i = 0; i < j; ++i) { \ - _ASSIGN_OFFDIAG_(upos, lpos); \ - ++px; ++upos; lpos += n; \ - } \ - _ASSIGN_ONDIAG_(upos); \ - ++px; upos += n-j; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - upos = lpos; \ - _ASSIGN_ONDIAG_(lpos); \ - for (i = j+1; i < n; ++i) { \ - ++px; upos += n; ++lpos; \ - _ASSIGN_OFFDIAG_(lpos, upos); \ - } \ - ++px; lpos += j+2; \ - } \ - } \ - } while (0) - - if (clf[0] != 'z') { - PROTECT(y = allocVector(REALSXP, (R_xlen_t) n * n)); - REPROTECT(x = coerceVector(x, REALSXP), pid); - if (clf[0] == 'n') - na2one(x); - -#define ASSIGN_OFFDIAG_DTP(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_] = 0.5 * *px; \ - py[_LPOS_] = -py[_UPOS_]; \ - } while (0) - -#define ASSIGN_ONDIAG_DTP(_DPOS_) \ - py[_DPOS_] = 0.0 - - PM_SKEWPART(double, REAL, - ASSIGN_OFFDIAG_DTP, ASSIGN_ONDIAG_DTP); - -#undef ASSIGN_OFFDIAG_DTP -#undef ASSIGN_ONDIAG_DTP - - } else { /* clf[0] == 'z' */ - - PROTECT(y = allocVector(CPLXSXP, (R_xlen_t) n * n)); - -#define ASSIGN_OFFDIAG_ZTP(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_].r = 0.5 * (*px).r; \ - py[_UPOS_].i = 0.5 * (*px).i; \ - py[_LPOS_].r = -py[upos].r; \ - py[_LPOS_].i = -py[upos].i; \ - } while (0) - -#define ASSIGN_ONDIAG_ZTP(_DPOS_) \ - py[_DPOS_].r = py[_DPOS_].i = 0.0 - - PM_SKEWPART(Rcomplex, COMPLEX, - ASSIGN_OFFDIAG_ZTP, ASSIGN_ONDIAG_ZTP); - -#undef ASSIGN_OFFDIAG_ZTP -#undef ASSIGN_ONDIAG_ZTP - - } - -#undef PM_SKEWPART - - SET_SLOT(to, Matrix_xSym, y); - UNPROTECT(1); /* y */ - - } else { /* clf[1] == 's' */ - - if (clf[0] != 'z') { - /* Skew-symmetric part of symmetric matrix is zero matrix */ - R_xlen_t n1a = (R_xlen_t) n + 1; - SEXP p = PROTECT(allocVector(INTSXP, n1a)); - int *pp = INTEGER(p); - Matrix_memset(pp, 0, n1a, sizeof(int)); - SET_SLOT(to, Matrix_pSym, p); - UNPROTECT(1); /* p */ - } else { - /* Skew-symmetric part of Hermitian matrix is imaginary part */ - REPROTECT(x = duplicate(x), pid); - zeroRe(x); - SET_SLOT(to, Matrix_xSym, x); - } - - } - - UNPROTECT(2); /* x, to */ - return to; -} diff -Nru rmatrix-1.6-1.1/src/packedMatrix.h rmatrix-1.6-5/src/packedMatrix.h --- rmatrix-1.6-1.1/src/packedMatrix.h 2023-07-30 16:26:24.000000000 +0000 +++ rmatrix-1.6-5/src/packedMatrix.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -#ifndef MATRIX_PACKEDMATRIX_H -#define MATRIX_PACKEDMATRIX_H - -#include "Mutils.h" - -SEXP packedMatrix_force_symmetric(SEXP from, SEXP uplo_to); - -SEXP packedMatrix_is_triangular(SEXP obj, SEXP upper); -SEXP packedMatrix_is_symmetric(SEXP obj, SEXP checkDN); -SEXP packedMatrix_is_diagonal(SEXP obj); - -SEXP packedMatrix_transpose(SEXP from); -SEXP packedMatrix_diag_get(SEXP obj, SEXP nms); -SEXP packedMatrix_diag_set(SEXP obj, SEXP val); - -SEXP packedMatrix_symmpart(SEXP from); -SEXP packedMatrix_skewpart(SEXP from); - -#endif /* MATRIX_PACKEDMATRIX_H */ diff -Nru rmatrix-1.6-1.1/src/perm.c rmatrix-1.6-5/src/perm.c --- rmatrix-1.6-1.1/src/perm.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/perm.c 2023-09-22 05:53:14.000000000 +0000 @@ -0,0 +1,155 @@ +#include "Mdefines.h" +#include "perm.h" + +int isPerm(const int *p, int n, int off) +{ + int res = 1; + if (n <= 0) + return res; + int i, j; + char *work; + Matrix_Calloc(work, n, char); + for (i = 0; i < n; ++i) { + if (p[i] == NA_INTEGER || (j = p[i] - off) < 0 || j >= n || work[j]) { + res = 0; + break; + } + work[j] = 1; + } + Matrix_Free(work, n); + return res; +} + +int signPerm(const int *p, int n, int off) +{ + if (!isPerm(p, n, off)) + error(_("attempt to get sign of non-permutation")); + int sign = 1; + if (n <= 0) + return sign; + int i, pos = 0; + char *work; + Matrix_Calloc(work, n, char); + while (pos < n) { + work[pos] = 1; + i = p[pos] - off; + while (!work[i]) { /* transposition */ + sign = -sign; + work[i] = 1; + i = p[i] - off; + } + while (pos < n && work[pos]) + ++pos; + } + Matrix_Free(work, n); + return sign; +} + +void invertPerm(const int *p, int *ip, int n, int off, int ioff) +{ + if (!isPerm(p, n, off)) + error(_("attempt to invert non-permutation")); + int j; + for (j = 0; j < n; ++j) + ip[p[j] - off] = j + ioff; + return; +} + +void asPerm(const int *p, int *ip, int m, int n, int off, int ioff) +{ + int i, j, tmp; + for (i = 0; i < n; ++i) + ip[i] = i + ioff; + for (i = 0; i < m; ++i) { + j = p[i] - off; + if (j < 0 || j >= n) + error(_("invalid transposition vector")); + if (j != i) { + tmp = ip[j]; + ip[j] = ip[i]; + ip[i] = tmp; + } + } + return; +} + +SEXP R_isPerm(SEXP p, SEXP off) +{ + if (TYPEOF(p) != INTSXP) + error(_("'%s' is not of type \"%s\""), "p", "integer"); + if (TYPEOF(off) != INTSXP) + error(_("'%s' is not of type \"%s\""), "off", "integer"); + if (XLENGTH(off) != 1) + error(_("'%s' does not have length %d"), "off", 1); + int off_ = INTEGER(off)[0]; + if (off_ == NA_INTEGER) + error(_("'%s' is NA"), "off"); + R_xlen_t n_ = XLENGTH(p); + if (n_ > INT_MAX) + return ScalarLogical(0); + return ScalarLogical(isPerm(INTEGER(p), (int) n_, off_)); +} + +SEXP R_signPerm(SEXP p, SEXP off) +{ + if (TYPEOF(p) != INTSXP) + error(_("'%s' is not of type \"%s\""), "p", "integer"); + if (TYPEOF(off) != INTSXP) + error(_("'%s' is not of type \"%s\""), "off", "integer"); + if (XLENGTH(off) != 1) + error(_("'%s' does not have length %d"), "off", 1); + int off_ = INTEGER(off)[0]; + if (off_ == NA_INTEGER) + error(_("'%s' is NA"), "off"); + R_xlen_t n_ = XLENGTH(p); + if (n_ > INT_MAX) + error(_("attempt to get sign of non-permutation")); + return ScalarInteger(signPerm(INTEGER(p), (int) n_, off_)); +} + +SEXP R_invertPerm(SEXP p, SEXP off, SEXP ioff) +{ + if (TYPEOF(p) != INTSXP) + error(_("'%s' is not of type \"%s\""), "p", "integer"); + if (TYPEOF(off) != INTSXP || TYPEOF(ioff) != INTSXP) + error(_("'%s' or '%s' is not of type \"%s\""), "off", "ioff", "integer"); + if (XLENGTH(off) != 1 || XLENGTH(ioff) != 1) + error(_("'%s' or '%s' does not have length %d"), "off", "ioff", 1); + int off_ = INTEGER(off)[0], ioff_ = INTEGER(ioff)[0]; + if (off_ == NA_INTEGER || ioff_ == NA_INTEGER) + error(_("'%s' or '%s' is NA"), "off", "ioff"); + R_xlen_t n_ = XLENGTH(p); + if (n_ > INT_MAX) + error(_("attempt to invert non-permutation")); + SEXP ip = PROTECT(allocVector(INTSXP, n_)); + invertPerm(INTEGER(p), INTEGER(ip), (int) n_, off_, ioff_); + UNPROTECT(1); + return ip; +} + +SEXP R_asPerm(SEXP p, SEXP off, SEXP ioff, SEXP n) +{ + if (TYPEOF(p) != INTSXP) + error(_("'%s' is not of type \"%s\""), "p", "integer"); + R_xlen_t m_ = XLENGTH(p); + if (m_ > INT_MAX) + error(_("'%s' has length exceeding %s"), "p", "2^31-1"); + if (TYPEOF(off) != INTSXP || TYPEOF(ioff) != INTSXP) + error(_("'%s' or '%s' is not of type \"%s\""), "off", "ioff", "integer"); + if (XLENGTH(off) != 1 || XLENGTH(ioff) != 1) + error(_("'%s' or '%s' does not have length %d"), "off", "ioff", 1); + int off_ = INTEGER(off)[0], ioff_ = INTEGER(ioff)[0]; + if (off_ == NA_INTEGER || ioff_ == NA_INTEGER) + error(_("'%s' or '%s' is NA"), "off", "ioff"); + if (TYPEOF(n) != INTSXP) + error(_("'%s' is not of type \"%s\""), "n", "integer"); + if (XLENGTH(n) != 1) + error(_("'%s' does not have length %d"), "n", 1); + int n_ = INTEGER(n)[0]; + if (n_ == NA_INTEGER || n_ < m_) + error(_("'%s' is NA or less than %s"), "n", "length(p)"); + SEXP ip = PROTECT(allocVector(INTSXP, n_)); + asPerm(INTEGER(p), INTEGER(ip), (int) m_, n_, off_, ioff_); + UNPROTECT(1); + return ip; +} diff -Nru rmatrix-1.6-1.1/src/perm.h rmatrix-1.6-5/src/perm.h --- rmatrix-1.6-1.1/src/perm.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/perm.h 2023-09-22 05:53:14.000000000 +0000 @@ -0,0 +1,11 @@ +#ifndef MATRIX_PERM_H +#define MATRIX_PERM_H + +#include + +SEXP R_isPerm(SEXP, SEXP); +SEXP R_signPerm(SEXP, SEXP); +SEXP R_invertPerm(SEXP, SEXP, SEXP); +SEXP R_asPerm(SEXP, SEXP, SEXP, SEXP); + +#endif /* MATRIX_PERM_H */ diff -Nru rmatrix-1.6-1.1/src/products.c rmatrix-1.6-5/src/products.c --- rmatrix-1.6-1.1/src/products.c 2023-07-30 19:24:16.000000000 +0000 +++ rmatrix-1.6-5/src/products.c 2023-10-18 15:45:08.000000000 +0000 @@ -1,992 +1,1549 @@ -#include "products.h" -#include "chm_common.h" +#include "Lapack-etc.h" +#include "cholmod-etc.h" +#include "Mdefines.h" +#include "idz.h" #include "coerce.h" +#include "dense.h" +#include "sparse.h" +#include "products.h" -/* Given a denseMatrix, diagonalMatrix, matrix, or vector, - return a newly allocated dgeMatrix with newly allocated 'x' - and 'Dimnames' slots and an empty 'factors' slot; the 'Dim' - slot and elements of the 'Dimnames' slots need not be newly - allocated. - - FIXME: Refactor the products and avoid such complexity altogether. -*/ -static SEXP asdge(SEXP from, int transpose_if_vector) -{ - static const char *valid[] = { - VALID_DDENSE, VALID_LDENSE, VALID_NDENSE, VALID_DIAGONAL, "" }; - int ivalid = R_check_class_etc(from, valid); - - SEXP to; - if (ivalid < 0) - PROTECT(to = matrix_as_dense(from, "dge", '\0', '\0', - transpose_if_vector, 1)); - else { - const char *cl = valid[ivalid]; - if (cl[0] == 'd' && cl[1] == 'g' && cl[2] == 'e') { - PROTECT(to = NEW_OBJECT_OF_CLASS("dgeMatrix")); - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)), - dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)), - x = PROTECT(GET_SLOT(from, Matrix_xSym)); - PROTECT(x = duplicate(x)); - SET_SLOT(to, Matrix_DimSym, dim); - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - SET_SLOT(to, Matrix_xSym, x); - UNPROTECT(4); - } else if (cl[0] == 'd') { - if (cl[1] == 'd' && cl[2] == 'i') - PROTECT(to = diagonal_as_dense(from, cl, 'g', 0, '\0')); - else { - PROTECT(to = dense_as_general(from, cl, 1)); - SEXP factors = PROTECT(allocVector(VECSXP, 0)); - SET_SLOT(to, Matrix_factorSym, factors); - UNPROTECT(1); +static +void matmultDim(SEXP x, SEXP y, int *xtrans, int *ytrans, int *ztrans, + int *m, int *n, int *v) +{ + *xtrans = (*xtrans) ? 1 : 0; + *ytrans = (*ytrans) ? 1 : 0; + *ztrans = (*ztrans) ? 1 : 0; + if (y == R_NilValue) { + SEXP + xdim = (TYPEOF(x) == S4SXP) + ? GET_SLOT(x, Matrix_DimSym) : getAttrib(x, R_DimSymbol); + if (TYPEOF(xdim) == INTSXP && LENGTH(xdim) == 2) { + *v = 0; + *m = *n = INTEGER(xdim)[(*xtrans) ? 1 : 0]; + } else if (XLENGTH(x) <= INT_MAX) { + *v = 1; + *m = *n = (*xtrans) ? 1 : LENGTH(x); + } else + error(_("dimensions cannot exceed %s"), "2^31-1"); + *ytrans = (*xtrans) ? 0 : 1; + } else { + /* MJ: So that I don't lose my mind ... : */ + if (*ztrans) { + int tmp = !(*xtrans); *xtrans = !(*ytrans); *ytrans = tmp; + SEXP s = x; x = y; y = s; + } + SEXP + xdim = (TYPEOF(x) == S4SXP) + ? GET_SLOT(x, Matrix_DimSym) : getAttrib(x, R_DimSymbol), + ydim = (TYPEOF(y) == S4SXP) + ? GET_SLOT(y, Matrix_DimSym) : getAttrib(y, R_DimSymbol); + int xm, xn, ym, yn, x2, y2; + xm = xn = ym = yn = -1; + x2 = TYPEOF(xdim) == INTSXP && LENGTH(xdim) == 2; + y2 = TYPEOF(ydim) == INTSXP && LENGTH(ydim) == 2; + if (x2) { + int *pxdim = INTEGER(xdim); + xm = pxdim[0]; + xn = pxdim[1]; + } else if (XLENGTH(x) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + if (y2) { + int *pydim = INTEGER(ydim); + ym = pydim[0]; + yn = pydim[1]; + } else if (XLENGTH(y) > INT_MAX) + error(_("dimensions cannot exceed %s"), "2^31-1"); + /* MJ: R's do_matprod behaves quite asymmetrically ... what a pain */ + if (x2 && y2) + *v = 0; + else if (y2) { + *v = (*ztrans) ? 2 : 1; + int k = (*ytrans) ? yn : ym, xl = LENGTH(x); + if (k == xl || (k == 1 && !(*xtrans))) { + xm = (int) xl; + xn = 1; + *xtrans = (k == xl) ? 1 : 0; + } + } else if (x2) { + *v = (*ztrans) ? 1 : 2; + int k = (*xtrans) ? xm : xn, yl = LENGTH(y); + if (*ytrans) { + if (xm == 1 || xn == 1) { + ym = (int) yl; + yn = 1; + *ytrans = (((*xtrans) ? xn : xm) == 1) ? 0 : 1; + } + } else { + if (k == yl || k == 1) { + ym = (int) yl; + yn = 1; + *ytrans = (k == yl) ? 0 : 1; + } } } else { - char cl_[] = "d..Matrix"; - cl_[1] = cl[1]; cl_[2] = cl[2]; - if (cl[1] == 'd' && cl[2] == 'i') { - to = diagonal_as_kind(from, cl, 'd'); - PROTECT(to); - to = diagonal_as_dense(to, cl_, 'g', 0, '\0'); + *v = 3; + int xl = LENGTH(x), yl = LENGTH(y); + if (*xtrans) { + xm = xl; + xn = 1; + ym = yl; + yn = 1; + *ytrans = xl == 1; + } else if (*ytrans) { + xm = xl; + xn = 1; + ym = yl; + yn = 1; + /* *xtrans = 0; */ } else { - to = dense_as_kind(from, cl, 'd'); - PROTECT(to); - to = dense_as_general(to, cl_, 0); + xm = 1; + xn = xl; + ym = (xl == 1) ? 1 : yl; + yn = (xl == 1) ? yl : 1; } - UNPROTECT(1); - PROTECT(to); } + if (((*xtrans) ? xm : xn) != ((*ytrans) ? yn : ym)) + error(_("non-conformable arguments")); + *m = (*xtrans) ? xn : xm; + *n = (*ytrans) ? ym : yn; + if (*ztrans) { + int tmp = !(*xtrans); *xtrans = !(*ytrans); *ytrans = tmp; + tmp = *m; *m = *n; *n = tmp; + } + } + return; +} + +static +void matmultDN(SEXP dest, SEXP asrc, int ai, SEXP bsrc, int bi) { + SEXP s; + if (!isNull(s = VECTOR_ELT(asrc, ai))) + SET_VECTOR_ELT(dest, 0, s); + if (!isNull(s = VECTOR_ELT(bsrc, bi))) + SET_VECTOR_ELT(dest, 1, s); + PROTECT(asrc = getAttrib(asrc, R_NamesSymbol)); + PROTECT(bsrc = getAttrib(bsrc, R_NamesSymbol)); + if (!isNull(asrc) || !isNull(bsrc)) { + SEXP destnms = PROTECT(allocVector(STRSXP, 2)); + if (!isNull(asrc) && *CHAR(s = STRING_ELT(asrc, ai)) != '\0') + SET_STRING_ELT(destnms, 0, s); + if (!isNull(bsrc) && *CHAR(s = STRING_ELT(bsrc, bi)) != '\0') + SET_STRING_ELT(destnms, 1, s); + setAttrib(dest, R_NamesSymbol, destnms); + UNPROTECT(1); } + UNPROTECT(2); + return; +} + +/* op() * op() */ +static +SEXP dgeMatrix_matmult(SEXP a, SEXP b, int atrans, int btrans) +{ + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int *padim = INTEGER(adim), am = padim[0], an = padim[1], + rm = (atrans) ? an : am, rk = (atrans) ? am : an; + + if (b == R_NilValue) { + + if ((Matrix_int_fast64_t) rm * rm > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = ".poMatrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = prdim[1] = rm; + + SEXP adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + symDN(rdimnames, adimnames, (atrans) ? 1 : 0); + UNPROTECT(2); /* rdimnames, adimnames */ + + if (rm > 0) { + SEXP rx = PROTECT(allocVector(TYPEOF(ax), (R_xlen_t) rm * rm)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *prx = COMPLEX(rx); + Matrix_memset(prx, 0, (R_xlen_t) rm * rm, sizeof(Rcomplex)); + if (rk > 0) { + Rcomplex *pax = COMPLEX(ax), + zero = Matrix_zzero, one = Matrix_zone; + F77_CALL(zsyrk)( + "U", (atrans) ? "T" : "N", &rm, &rk, + &one, pax, &am, &zero, prx, &rm FCONE FCONE); + } + } else { +#endif + double *prx = REAL(rx); + Matrix_memset(prx, 0, (R_xlen_t) rm * rm, sizeof(double)); + if (rk > 0) { + double *pax = REAL(ax), + zero = 0.0, one = 1.0; + F77_CALL(dsyrk)( + "U", (atrans) ? "T" : "N", &rm, &rk, + &one, pax, &am, &zero, prx, &rm FCONE FCONE); + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(1); /* rx */ + } + + UNPROTECT(2); /* r, ax */ + return r; - SEXP dn0 = PROTECT(GET_SLOT(to, Matrix_DimNamesSym)), - dn1 = PROTECT(allocVector(VECSXP, 2)); - for (int i = 0; i < 2; ++i) - SET_VECTOR_ELT(dn1, i, VECTOR_ELT(dn0, i)); - SET_SLOT(to, Matrix_DimNamesSym, dn1); - - UNPROTECT(3); - return to; -} - -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))); -} - -static 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; - Matrix_Calloc(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 R_Free(.) - Matrix_Free(x_x, nn); -#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 -static 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(asdge(x, 0)), - 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 -static 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(asdge(x, 0)), - gy = PROTECT(asdge(y, 0)), - 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 -static 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(asdge(x, 0)), - 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(asdge(bP, 0)); - 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 -static 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(asdge(a, 0)), - db = PROTECT(asdge(b, 0)), - val = _geMatrix_matrix_mm(da, db, right); - UNPROTECT(2); - 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): asdge(b, 0); */ - 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" ! */ - 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, GET_SLOT(b, Matrix_DimNamesSym)); - 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(asdge(b, 0)); - 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) { - /* set "other triangle" to 0 */ - if (tr) - ddense_unpacked_make_triangular(valx, n, n, *uplo_b_ch, *diag_b_ch); + } else { + + SEXP bdim = GET_SLOT(b, Matrix_DimSym); + int *pbdim = INTEGER(bdim), bm = pbdim[0], bn = pbdim[1], + rn = (btrans) ? bm : bn; + + if (rk != ((btrans) ? bn : bm)) + error(_("non-conformable arguments")); + if ((Matrix_int_fast64_t) rm * rn > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = ".geMatrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = rm; + prdim[1] = rn; + + SEXP adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)), + bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + matmultDN(rdimnames, + adimnames, (atrans) ? 1 : 0, + bdimnames, (btrans) ? 0 : 1); + UNPROTECT(3); /* rdimnames, bdimnames, adimnames */ + + if (rm > 0 && rn > 0) { + SEXP rx = PROTECT(allocVector(TYPEOF(ax), (R_xlen_t) rm * rn)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *prx = COMPLEX(rx); + if (rk == 0) + Matrix_memset(prx, 0, (R_xlen_t) rm * rn, sizeof(Rcomplex)); + else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + Rcomplex *pax = COMPLEX(ax), *pbx = COMPLEX(bx), + zero = Matrix_zzero, one = Matrix_zone; + F77_CALL(zgemm)( + (atrans) ? "T" : "N", (btrans) ? "T" : "N", &rm, &rn, &rk, + &one, pax, &am, pbx, &bm, &zero, prx, &rm FCONE FCONE); + UNPROTECT(1); /* bx */ + } + } else { +#endif + double *prx = REAL(rx); + if (rk == 0) + Matrix_memset(prx, 0, (R_xlen_t) rm * rn, sizeof(double)); + else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + double *pax = REAL(ax), *pbx = REAL(bx), + zero = 0.0, one = 1.0; + F77_CALL(dgemm)( + (atrans) ? "T" : "N", (btrans) ? "T" : "N", &rm, &rn, &rk, + &one, pax, &am, pbx, &bm, &zero, prx, &rm FCONE FCONE); + UNPROTECT(1); /* bx */ + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(1); /* rx */ + } + + UNPROTECT(2); /* r, ax */ + return r; + + } +} + +/* * op() or op() * */ +static +SEXP dsyMatrix_matmult(SEXP a, SEXP b, int aleft, int btrans) +{ + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int rk = INTEGER(adim)[0]; + + SEXP bdim = GET_SLOT(b, Matrix_DimSym); + int *pbdim = INTEGER(bdim), bm = pbdim[0], bn = pbdim[1], + rm = (btrans) ? bn : bm, rn = (btrans) ? bm : bn; + + if (rk != ((aleft == btrans) ? bn : bm)) + error(_("non-conformable arguments")); + if ((Matrix_int_fast64_t) rm * rn > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = ".geMatrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = rm; + prdim[1] = rn; + + SEXP adimnames = PROTECT(get_symmetrized_DimNames(a, -1)), + bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + if (aleft) + matmultDN(rdimnames, adimnames, 0, bdimnames, !btrans); else - ddense_unpacked_make_triangular(valx, n, n, *uplo_a_ch, *diag_a_ch); - if(*diag_a_ch == 'U' && uDiag_b) /* result remains uni-diagonal */ - SET_SLOT(val, Matrix_diagSym, duplicate(diag_a)); - } - UNPROTECT(1); - return val; -} - -// 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(asdge(b, 0)); - 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; -} - -SEXP dtpMatrix_matrix_mm(SEXP x, SEXP y, SEXP right, SEXP trans) -{ - SEXP val = PROTECT(asdge(y, 0)); - 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")); + matmultDN(rdimnames, bdimnames, btrans, adimnames, 1); + UNPROTECT(3); /* rdimnames, bdimnames, adimnames */ + + if (rm > 0 && rn > 0) { + SEXP auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)), + bx = PROTECT(GET_SLOT(b, Matrix_xSym)), + rx = PROTECT(allocVector(TYPEOF(ax), (R_xlen_t) rm * rn)); + char aul = *CHAR(STRING_ELT(auplo, 0)); + int i, d = (aleft) ? rn : rm, + binc = (aleft) ? bm : 1, bincp = (aleft) ? 1 : bm, + rinc = (aleft) ? 1 : rm, rincp = (aleft) ? rm : 1; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *pax = COMPLEX(ax), *pbx = COMPLEX(bx), *prx = COMPLEX(rx), + zero = Matrix_zero, one = Matrix_zone; + if (!btrans) + F77_CALL(zsymm)( + (aleft) ? "L" : "R", &aul, &rm, &rn, + &one, pax, &rk, pbx, &bm, &zero, prx, &rm FCONE FCONE); + else { + for (i = 0; i < d; ++i) { + F77_CALL(zsymv)( + &aul, &rk, &one, pax, &rk, pbx, &binc, &zero, prx, &rinc FCONE); + pbx += bincp; + prx += rincp; + } + } } 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; -} - -/* FIXME: This function should be removed and a 'right' 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 dspMatrix_matrix_mm(SEXP a, SEXP b) -{ - SEXP val = PROTECT(asdge(b, 0)); - 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; - - if (bdims[0] != n) - error(_("Matrices are not conformable for multiplication")); - if (nrhs >= 1 && n >= 1) { - Matrix_Calloc(bx, nn, double); - Memcpy(bx, vx, nn); - - 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); - } - - Matrix_Free(bx, nn); - } - UNPROTECT(1); - return val; -} - -SEXP dsyMatrix_matrix_mm(SEXP a, SEXP b, SEXP right) -{ - SEXP val = PROTECT(asdge(b, 0));// incl. dimnames - int rt = asLogical(right); /* 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)); - Matrix_Calloc(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(get_symmetrized_DimNames(a, -1), nd)); - SET_VECTOR_ELT(GET_SLOT(val, Matrix_DimNamesSym), nd, nms); - Matrix_Free(bcp, mn); - UNPROTECT(2); - return val; -} - -/** - * 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 `trans` is '2' or 'B' - * @param trans 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 trans 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 trans_a, Rboolean trans_b, Rboolean trans_ans) -{ - static const char *valid[] = { VALID_CSPARSE, "" }; - int ivalid = R_check_class_etc(a, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(a, __func__); - const char *cl = valid[ivalid]; +#endif + double *pax = REAL(ax), *pbx = REAL(bx), *prx = REAL(rx), + zero = 0.0, one = 1.0; + if (!btrans) + F77_CALL(dsymm)( + (aleft) ? "L" : "R", &aul, &rm, &rn, + &one, pax, &rk, pbx, &bm, &zero, prx, &rm FCONE FCONE); + else { + for (i = 0; i < d; ++i) { + F77_CALL(dsymv)( + &aul, &rk, &one, pax, &rk, pbx, &binc, &zero, prx, &rinc FCONE); + pbx += bincp; + prx += rincp; + } + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(3); /* rx, bx, auplo */ + } + + UNPROTECT(2); /* r, ax */ + return r; +} + +/* * op() or op() * */ +static +SEXP dspMatrix_matmult(SEXP a, SEXP b, int aleft, int btrans) +{ + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int rk = INTEGER(adim)[0]; + + SEXP bdim = GET_SLOT(b, Matrix_DimSym); + int *pbdim = INTEGER(bdim), bm = pbdim[0], bn = pbdim[1], + rm = (btrans) ? bn : bm, rn = (btrans) ? bm : bn; + + if (rk != ((aleft == btrans) ? bn : bm)) + error(_("non-conformable arguments")); + if ((Matrix_int_fast64_t) rm * rn > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = ".geMatrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = rm; + prdim[1] = rn; + + SEXP adimnames = PROTECT(get_symmetrized_DimNames(a, -1)), + bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + if (aleft) + matmultDN(rdimnames, adimnames, 0, bdimnames, !btrans); + else + matmultDN(rdimnames, bdimnames, btrans, adimnames, 1); + UNPROTECT(3); /* rdimnames, bdimnames, adimnames */ + + if (rm > 0 && rn > 0) { + SEXP auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)), + bx = PROTECT(GET_SLOT(b, Matrix_xSym)), + rx = PROTECT(allocVector(REALSXP, (R_xlen_t) rm * rn)); + char aul = *CHAR(STRING_ELT(auplo, 0)); + int i, d = (aleft) ? rn : rm, + binc = (aleft == btrans) ? bm : 1, bincp = (aleft == btrans) ? 1 : bm, + rinc = (aleft ) ? 1 : rm, rincp = (aleft ) ? rm : 1; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *pax = COMPLEX(ax), *pbx = COMPLEX(bx), *prx = COMPLEX(rx), + zero = Matrix_zzero, one = Matrix_zone; + for (i = 0; i < d; ++i) { + F77_CALL(zspmv)( + &aul, &rk, &one, pax, pbx, &binc, &zero, prx, &rinc FCONE); + pbx += bincp; + prx += rincp; + } + } else { +#endif + double *pax = REAL(ax), *pbx = REAL(bx), *prx = REAL(rx), + zero = 0.0, one = 1.0; + for (i = 0; i < d; ++i) { + F77_CALL(dspmv)( + &aul, &rk, &one, pax, pbx, &binc, &zero, prx, &rinc FCONE); + pbx += bincp; + prx += rincp; + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(3); /* rx, bx, auplo */ + } + + UNPROTECT(2); /* r, ax */ + return r; +} + +/* op() * op() or op() * op() */ +static +SEXP dtrMatrix_matmult(SEXP a, SEXP b, int aleft, int atrans, int btrans, + int triangular) +{ + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int rk = INTEGER(adim)[0]; + + SEXP bdim = GET_SLOT(b, Matrix_DimSym); + int *pbdim = INTEGER(bdim), bm = pbdim[0], bn = pbdim[1], + rm = (btrans) ? bn : bm, rn = (btrans) ? bm : bn; + + if (rk != ((aleft == btrans) ? bn : bm)) + error(_("non-conformable arguments")); + if ((Matrix_int_fast64_t) rm * rn > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = "...Matrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + rcl[1] = (triangular > 0) ? 't' : 'g'; + rcl[2] = (triangular > 0) ? 'r' : 'e'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = rm; + prdim[1] = rn; + + SEXP adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)), + bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + if (aleft) + matmultDN(rdimnames, adimnames, atrans, bdimnames, !btrans); + else + matmultDN(rdimnames, bdimnames, btrans, adimnames, !atrans); + UNPROTECT(3); /* rdimnames, bdimnames, adimnames */ + + SEXP auplo = GET_SLOT(a, Matrix_uploSym); + char aul = *CHAR(STRING_ELT(auplo, 0)); + if (triangular > 0 && ((atrans) ? aul == 'U' : aul != 'U')) { + if (atrans) + auplo = mkString("L"); + PROTECT(auplo); + SET_SLOT(r, Matrix_uploSym, auplo); + UNPROTECT(1); /* auplo */ + } - if (cl[0] == 'n') { -#if 0 - warning(_("cholmod_sdmult() not yet implemented for pattern matrices -> coercing to double")); -#endif - a = sparse_as_kind(a, cl, 'd'); - } - PROTECT(a); - - CHM_SP cha = AS_CHM_SP(a); - R_CheckStack(); - size_t - a_nc = trans_a ? cha->nrow : cha->ncol, - a_nr = trans_a ? cha->ncol : cha->nrow; - - Rboolean - b_is_vector = !(IS_S4_OBJECT(b) || isMatrix(b)), - b_transpose_if_vector = b_is_vector && XLENGTH(b) != a_nc; - if (b_is_vector) - trans_b = FALSE; /* don't transpose twice! */ - PROTECT(b = asdge(b, b_transpose_if_vector)); - - CHM_DN chb = AS_CHM_DN(b); - R_CheckStack(); - if (trans_b) { - CHM_DN chbt = cholmod_allocate_dense(chb->ncol, chb->nrow, chb->ncol, - chb->xtype, &c); - chm_transpose_dense(chbt, chb); - chb = chbt; - } - size_t b_nc = chb->ncol; - - CHM_DN chc = cholmod_allocate_dense(a_nr, b_nc, a_nr, chb->xtype, &c); - double one[] = {1.0, 0.0}, zero[] = {0.0, 0.0}; - cholmod_sdmult(cha, trans_a, one, zero, chb, chc, &c); - - SEXP dna = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)), - dnb = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), - dnc = PROTECT(allocVector(VECSXP, 2)); - SET_VECTOR_ELT(dnc, (trans_ans) ? 1 : 0, VECTOR_ELT(dna, (trans_a) ? 1 : 0)); - SET_VECTOR_ELT(dnc, (trans_ans) ? 0 : 1, VECTOR_ELT(dnb, (trans_b) ? 0 : 1)); - - if (trans_b) - cholmod_free_dense(&chb, &c); - SEXP ans = chm_dense_to_SEXP(chc, 1, 0, dnc, trans_ans); - UNPROTECT(5); - 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 boolArith) + SEXP adiag = GET_SLOT(a, Matrix_diagSym); + char adi = *CHAR(STRING_ELT(adiag, 0)); + if (triangular > 1 && adi != 'N') { + PROTECT(adiag); + SET_SLOT(r, Matrix_diagSym, adiag); + UNPROTECT(1); /* adiag */ + } + + if (rm > 0 && rn > 0) { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)), + rx = PROTECT(allocVector(TYPEOF(ax), (R_xlen_t) rm * rn)); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *pax = COMPLEX(ax), *pbx = COMPLEX(bx), *prx = COMPLEX(rx), + one = Matrix_zone; + if (!btrans) + Matrix_memcpy(prx, pbx, (R_xlen_t) bm * bn, sizeof(Rcomplex)); + else + ztranspose2(prx, pbx, bm, bn); + F77_CALL(ztrmm)( + (aleft) ? "L" : "R", &aul, (atrans) ? "T" : "N", &adi, &rm, &rn, + &one, pax, &rk, prx, &rm FCONE FCONE FCONE FCONE); + } else { +#endif + double *pax = REAL(ax), *pbx = REAL(bx), *prx = REAL(rx), + one = 1.0; + if (!btrans) + Matrix_memcpy(prx, pbx, (R_xlen_t) bm * bn, sizeof(double)); + else + dtranspose2(prx, pbx, bm, bn); + F77_CALL(dtrmm)( + (aleft) ? "L" : "R", &aul, (atrans) ? "T" : "N", &adi, &rm, &rn, + &one, pax, &rk, prx, &rm FCONE FCONE FCONE FCONE); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(2); /* rx, bx */ + } + + UNPROTECT(2); /* r, ax */ + return r; +} + +/* op() * op() or op() * op() */ +static +SEXP dtpMatrix_matmult(SEXP a, SEXP b, int aleft, int atrans, int btrans, + int triangular) +{ + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int rk = INTEGER(adim)[0]; + + SEXP bdim = GET_SLOT(b, Matrix_DimSym); + int *pbdim = INTEGER(bdim), bm = pbdim[0], bn = pbdim[1], + rm = (btrans) ? bn : bm, rn = (btrans) ? bm : bn; + + if (rk != ((aleft == btrans) ? bn : bm)) + error(_("non-conformable arguments")); + if ((Matrix_int_fast64_t) rm * rn > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = "...Matrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + rcl[1] = (triangular > 0) ? 't' : 'g'; + rcl[2] = (triangular > 0) ? 'r' : 'e'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = rm; + prdim[1] = rn; + + SEXP adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)), + bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)), + rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)); + if (aleft) + matmultDN(rdimnames, adimnames, atrans, bdimnames, !btrans); + else + matmultDN(rdimnames, bdimnames, btrans, adimnames, !atrans); + UNPROTECT(3); /* rdimnames, bdimnames, adimnames */ + + SEXP auplo = GET_SLOT(a, Matrix_uploSym); + char aul = *CHAR(STRING_ELT(auplo, 0)); + if (triangular > 0 && ((atrans) ? aul == 'U' : aul != 'U')) { + if (atrans) + auplo = mkString("L"); + PROTECT(auplo); + SET_SLOT(r, Matrix_uploSym, auplo); + UNPROTECT(1); /* auplo */ + } + + SEXP adiag = GET_SLOT(a, Matrix_diagSym); + char adi = *CHAR(STRING_ELT(adiag, 0)); + if (triangular > 1 && adi != 'N') { + PROTECT(adiag); + SET_SLOT(r, Matrix_diagSym, adiag); + UNPROTECT(1); /* adiag */ + } + + if (rm > 0 && rn > 0) { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)), + rx = PROTECT(allocVector(REALSXP, (R_xlen_t) rm * rn)); + int i, rinc = (aleft) ? 1 : rm, rincp = (aleft) ? rm : 1; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *pax = COMPLEX(ax), *pbx = COMPLEX(bx), *prx = COMPLEX(rx); + if (!btrans) + Matrix_memcpy(prx, pbx, (R_xlen_t) bm * bn, sizeof(Rcomplex)); + else + ztranspose2(prx, pbx, bm, bn); + for (i = 0; i < rn; ++i) { + F77_CALL(ztpmv)( + &aul, (aleft == atrans) ? "T" : "N", &adi, &rk, + pax, prx, &rinc FCONE FCONE FCONE); + prx += rincp; + } + } else { +#endif + double *pax = REAL(ax), *pbx = REAL(bx), *prx = REAL(rx); + if (!btrans) + Matrix_memcpy(prx, pbx, (R_xlen_t) bm * bn, sizeof(double)); + else + dtranspose2(prx, pbx, bm, bn); + for (i = 0; i < rn; ++i) { + F77_CALL(dtpmv)( + &aul, (aleft == atrans) ? "T" : "N", &adi, &rk, + pax, prx, &rinc FCONE FCONE FCONE); + prx += rincp; + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(2); /* rx, bx */ + } + + UNPROTECT(2); /* r, ax */ + return r; +} + +SEXP R_dense_matmult(SEXP x, SEXP y, SEXP xtrans, SEXP ytrans) { - static const char *valid[] = { VALID_CSPARSE, "" }; - int ivalid = R_check_class_etc(a, valid); + int xtrans_ = LOGICAL(xtrans)[0], ytrans_ = LOGICAL(ytrans)[0], + ztrans_ = 0, m, n, v; + matmultDim(x, y, &xtrans_, &ytrans_, &ztrans_, &m, &n, &v); + + PROTECT_INDEX xpid, ypid; + PROTECT_WITH_INDEX(x, &xpid); + PROTECT_WITH_INDEX(y, &ypid); + + if (TYPEOF(x) != S4SXP) { + REPROTECT(x = matrix_as_dense(x, ",ge", '\0', '\0', xtrans_, 0), xpid); + if (v == 1) { + /* Vector: discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), + (xtrans_) ? 1 : 0, R_NilValue); + xtrans_ = 0; + } + } + if (TYPEOF(y) != S4SXP && y != R_NilValue) { + REPROTECT(y = matrix_as_dense(y, ",ge", '\0', '\0', ytrans_, 0), ypid); + if (v == 2) { + /* Vector: discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(y, Matrix_DimNamesSym), + (ytrans_) ? 1 : 0, R_NilValue); + ytrans_ = 0; + } + } + + static const char *valid[] = { VALID_DENSE, "" }; + const char *xcl = NULL, *ycl = NULL; + int ivalid; + ivalid = R_check_class_etc(x, valid); if (ivalid < 0) - ERROR_INVALID_CLASS(a, __func__); - const char *acl = valid[ivalid]; - ivalid = R_check_class_etc(b, valid); + ERROR_INVALID_CLASS(x, __func__); + xcl = valid[ivalid]; + if (y != R_NilValue) { + ivalid = R_check_class_etc(y, valid); if (ivalid < 0) - ERROR_INVALID_CLASS(b, __func__); - const char *bcl = valid[ivalid]; + ERROR_INVALID_CLASS(y, __func__); + ycl = valid[ivalid]; + } - int doBool = asLogical(boolArith); - if (doBool == NA_LOGICAL) - doBool = (acl[0] == 'n' && bcl[0] == 'n'); - if (doBool) { - if (acl[0] != 'n') - a = sparse_as_kind(a, acl, 'n'); - PROTECT(a); - if (bcl[0] != 'n') - b = sparse_as_kind(b, bcl, 'n'); - PROTECT(b); + char kind = (xcl[0] == 'z' || (y != R_NilValue && ycl[0] == 'z')) + ? 'z' : 'd'; + if (xcl[0] != kind) { + REPROTECT(x = dense_as_kind(x, xcl, kind, 0), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (y != R_NilValue) { + if (ycl[0] != kind) { + REPROTECT(y = dense_as_kind(y, ycl, kind, 0), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + } + + if (y == R_NilValue) { + REPROTECT(x = dense_as_general(x, xcl, 1), xpid); + x = dgeMatrix_matmult(x, y, xtrans_, !xtrans_); + } else if (xcl[1] == 'g' && ycl[1] == 'g') { + x = dgeMatrix_matmult(x, y, xtrans_, ytrans_); + } else if (xcl[1] == 'g' || ycl[1] == 'g') { + x = (xcl[1] == 'g') + ? ((ycl[1] == 's') + ? ((ycl[2] != 'p') + ? dsyMatrix_matmult(y, x, 0, xtrans_) + : dspMatrix_matmult(y, x, 0, xtrans_)) + : ((ycl[2] != 'p') + ? dtrMatrix_matmult(y, x, 0, ytrans_, xtrans_, 0) + : dtpMatrix_matmult(y, x, 0, ytrans_, xtrans_, 0))) + : ((xcl[1] == 's') + ? ((xcl[2] != 'p') + ? dsyMatrix_matmult(x, y, 1, ytrans_) + : dspMatrix_matmult(x, y, 1, ytrans_)) + : ((xcl[2] != 'p') + ? dtrMatrix_matmult(x, y, 1, xtrans_, ytrans_, 0) + : dtpMatrix_matmult(x, y, 1, xtrans_, ytrans_, 0))); + } else if (xcl[1] == 's' && ycl[1] == 's') { + if (xcl[2] == 'p' && ycl[2] == 'p') { + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + x = dspMatrix_matmult(x, y, 1, ytrans_); + } else if (xcl[2] == 'p') { + REPROTECT(x = dense_as_general(x, xcl, 1), xpid); + x = dsyMatrix_matmult(y, x, 0, xtrans_); + } else { + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + x = dsyMatrix_matmult(x, y, 1, ytrans_); + } + } else if (xcl[1] == 's' || ycl[1] == 's') { + if (xcl[1] == 's') { + REPROTECT(x = dense_as_general(x, xcl, 1), xpid); + x = (ycl[2] != 'p') + ? dtrMatrix_matmult(y, x, 0, ytrans_, 0, 0) + : dtpMatrix_matmult(y, x, 0, ytrans_, 0, 0); + } else { + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + x = (xcl[2] != 'p') + ? dtrMatrix_matmult(x, y, 1, xtrans_, 0, 0) + : dtpMatrix_matmult(x, y, 1, xtrans_, 0, 0); + } } else { - if (acl[0] != 'd') - a = sparse_as_kind(a, acl, 'd'); - PROTECT(a); - if (bcl[0] != 'd') - b = sparse_as_kind(b, bcl, 'd'); - PROTECT(b); + SEXP + xuplo = PROTECT(GET_SLOT(x, Matrix_uploSym)), + yuplo = PROTECT(GET_SLOT(y, Matrix_uploSym)), + xdiag = PROTECT(GET_SLOT(x, Matrix_diagSym)), + ydiag = PROTECT(GET_SLOT(y, Matrix_diagSym)); + char + xul = *CHAR(STRING_ELT(xuplo, 0)), + yul = *CHAR(STRING_ELT(yuplo, 0)), + xdi = *CHAR(STRING_ELT(xdiag, 0)), + ydi = *CHAR(STRING_ELT(ydiag, 0)); + if (xtrans_) + xul = (xul == 'U') ? 'L' : 'U'; + if (ytrans_) + yul = (yul == 'U') ? 'L' : 'U'; + int triangular = (xul != yul) ? 0 : ((xdi != ydi || xdi == 'N') ? 1 : 2); + UNPROTECT(4); /* ydiag, xdiag, yuplo, xuplo */ + + if (xcl[2] == 'p' && ycl[2] == 'p') { + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + x = dtpMatrix_matmult(x, y, 1, xtrans_, ytrans_, triangular); + } else if (xcl[2] == 'p') { + REPROTECT(x = dense_as_general(x, xcl, 1), xpid); + x = dtrMatrix_matmult(y, x, 0, ytrans_, xtrans_, triangular); + } else { + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + x = dtrMatrix_matmult(x, y, 1, xtrans_, ytrans_, triangular); + } } - CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chc; - R_CheckStack(); - chc = cholmod_ssmult(cha, chb, 0, !doBool, 1, &c); + UNPROTECT(2); /* y, x */ + return x; +} - char ul = '\0', di = '\0'; - if (acl[1] == 't' && bcl[1] == 't') { - SEXP auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)), - buplo = PROTECT(GET_SLOT(b, Matrix_uploSym)); - char aul = *CHAR(STRING_ELT(auplo, 0)), - bul = *CHAR(STRING_ELT(buplo, 0)); - if (aul == bul) { - ul = aul; - di = 'N'; - SEXP adiag = PROTECT(GET_SLOT(a, Matrix_diagSym)), - bdiag = PROTECT(GET_SLOT(b, Matrix_diagSym)); - char adi = *CHAR(STRING_ELT(adiag, 0)), - bdi = *CHAR(STRING_ELT(bdiag, 0)); - if (adi != 'N' && bdi != 'N') { - di = 'U'; - chm_diagN2U(chc, (ul == 'U') ? 1 : -1, 0); - } - UNPROTECT(2); +/* boolean: op(op(<.gC>) & op(<.gC>)) */ +/* numeric: op(op() * op()) */ +static +SEXP dgCMatrix_dgCMatrix_matmult(SEXP x, SEXP y, int xtrans, int ytrans, + int ztrans, int triangular, int boolean) +{ + PROTECT_INDEX zpid; + SEXP z; + char zcl[] = "..CMatrix"; + zcl[0] = (boolean) ? 'n' : 'd'; + if (y == R_NilValue) { + zcl[1] = 's'; + cholmod_sparse *X = M2CHS(x, !boolean); + if (X->xtype == CHOLMOD_COMPLEX) + error(_("'%s' does not support complex matrices"), "cholmod_aat"); + if (xtrans) + X = cholmod_transpose(X, !boolean, &c); + cholmod_sparse *Z = cholmod_aat(X, (int *) NULL, 0, !boolean, &c); + if (xtrans) + cholmod_free_sparse(&X, &c); + Z->stype = (ztrans) ? -1 : 1; + cholmod_sort(Z, &c); + PROTECT_WITH_INDEX(z = CHS2M(Z, !boolean, zcl[1]), &zpid); + cholmod_free_sparse(&Z, &c); + SEXP xdimnames = PROTECT(GET_SLOT(x, Matrix_DimNamesSym)), + zdimnames = PROTECT(GET_SLOT(z, Matrix_DimNamesSym)); + symDN(zdimnames, xdimnames, (xtrans) ? 1 : 0); + UNPROTECT(2); /* zdimnames, xdimnames */ + if (ztrans) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(z, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ } - UNPROTECT(2); + } else { + zcl[1] = (triangular != 0) ? 't' : 'g'; + cholmod_sparse + *X = M2CHS(x, !boolean), + *Y = M2CHS(y, !boolean); + if (X->xtype == CHOLMOD_COMPLEX || Y->xtype == CHOLMOD_COMPLEX) + error(_("'%s' does not support complex matrices"), "cholmod_ssmult"); + if (((xtrans) ? X->nrow : X->ncol) != ((ytrans) ? Y->ncol : Y->nrow)) + error(_("non-conformable arguments")); + if (xtrans) + X = cholmod_transpose(X, !boolean, &c); + if (ytrans) + Y = cholmod_transpose(Y, !boolean, &c); + cholmod_sparse *Z = cholmod_ssmult(X, Y, 0, !boolean, 1, &c); + if (xtrans) + cholmod_free_sparse(&X, &c); + if (ytrans) + cholmod_free_sparse(&Y, &c); + PROTECT_WITH_INDEX(z = CHS2M(Z, !boolean, zcl[1]), &zpid); + cholmod_free_sparse(&Z, &c); + SEXP xdimnames = PROTECT(GET_SLOT(x, Matrix_DimNamesSym)), + ydimnames = PROTECT(GET_SLOT(y, Matrix_DimNamesSym)), + zdimnames = PROTECT(GET_SLOT(z, Matrix_DimNamesSym)); + matmultDN(zdimnames, + xdimnames, (xtrans) ? 1 : 0, + ydimnames, (ytrans) ? 0 : 1); + UNPROTECT(3); /* zdimnames, ydimnames, xdimnames */ + if (triangular < 0) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(z, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + if (triangular < -1 || triangular > 1) + REPROTECT(z = sparse_diag_N2U(z, zcl), zpid); + } + if (ztrans) + REPROTECT(z = sparse_transpose(z, zcl, 1), zpid); + UNPROTECT(1); /* z */ + return z; +} + +/* op(op() * op()) */ +static +SEXP dgCMatrix_dgeMatrix_matmult(SEXP x, SEXP y, int xtrans, int ytrans, + int ztrans, int triangular, int symmetric) +{ + SEXP z; + char zcl[] = "...Matrix"; + cholmod_sparse *X = M2CHS(x, 1); + cholmod_dense *Y = M2CHD(y, ytrans); + zcl[0] = (X->xtype == CHOLMOD_COMPLEX || Y->xtype == CHOLMOD_COMPLEX) + ? 'z' : 'd'; + zcl[1] = (triangular) ? 't' : 'g'; + zcl[2] = (triangular) ? 'r' : 'e'; + X->stype = symmetric; + if (((xtrans) ? X->nrow : X->ncol) != Y->nrow) { + if (ytrans) + R_Free(Y->x); + error(_("non-conformable arguments")); + } + int m = (int) ((xtrans) ? X->ncol : X->nrow), n = (int) Y->ncol; + if ((Matrix_int_fast64_t) m * n > R_XLEN_T_MAX) { + if (ytrans) + R_Free(Y->x); + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); } + cholmod_dense *Z = (cholmod_dense *) R_alloc(1, sizeof(cholmod_dense)); + memset(Z, 0, sizeof(cholmod_dense)); + Z->nrow = (size_t) m; + Z->ncol = (size_t) n; + Z->d = Z->nrow; + Z->nzmax = Z->nrow * Z->ncol; + Z->xtype = Y->xtype; + Z->dtype = Y->dtype; + double alpha[2] = { 1.0, 0.0 }, beta[2] = { 0.0, 0.0 }; + if (ztrans) { + if (Z->xtype == CHOLMOD_COMPLEX) + Z->x = R_Calloc(Z->nzmax, Rcomplex); + else + Z->x = R_Calloc(Z->nzmax, double); + cholmod_sdmult(X, xtrans, alpha, beta, Y, Z, &c); + PROTECT(z = CHD2M(Z, ztrans, zcl[1])); + R_Free(Z->x); + } else { + PROTECT(z = newObject(zcl)); + SEXP zdim = GET_SLOT(z, Matrix_DimSym); + INTEGER(zdim)[0] = m; + INTEGER(zdim)[1] = n; + SEXP zx; + if (Z->xtype == CHOLMOD_COMPLEX) { + PROTECT(zx = allocVector(CPLXSXP, (R_xlen_t) m * n)); + Z->x = COMPLEX(zx); + } else { + PROTECT(zx = allocVector(REALSXP, (R_xlen_t) m * n)); + Z->x = REAL(zx); + } + cholmod_sdmult(X, xtrans, alpha, beta, Y, Z, &c); + SET_SLOT(z, Matrix_xSym, zx); + UNPROTECT(1); /* zx */ + } + if (ytrans) + R_Free(Y->x); + SEXP xdimnames = (symmetric) + ? PROTECT(get_symmetrized_DimNames(x, -1)) + : PROTECT(GET_SLOT(x, Matrix_DimNamesSym)), + ydimnames = PROTECT(GET_SLOT(y, Matrix_DimNamesSym)), + zdimnames = PROTECT(GET_SLOT(z, Matrix_DimNamesSym)); + if (ztrans) + matmultDN(zdimnames, + ydimnames, (ytrans) ? 0 : 1, + xdimnames, (xtrans) ? 1 : 0); + else + matmultDN(zdimnames, + xdimnames, (xtrans) ? 1 : 0, + ydimnames, (ytrans) ? 0 : 1); + UNPROTECT(3); /* zdimnames, ydimnames, xdimnames */ + if (triangular != 0 && ztrans == (triangular > 0)) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(z, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + if (triangular < -1 || triangular > 1) { + SEXP diag = PROTECT(mkString("U")); + SET_SLOT(z, Matrix_diagSym, diag); + UNPROTECT(1); /* diag */ + } + UNPROTECT(1); /* z */ + return z; +} - SEXP - dna = PROTECT((acl[1] != 's') - ? GET_SLOT(a, Matrix_DimNamesSym) - : get_symmetrized_DimNames(a, -1)), - dnb = PROTECT((bcl[1] != 's') - ? GET_SLOT(b, Matrix_DimNamesSym) - : get_symmetrized_DimNames(b, -1)), - dnc = PROTECT(allocVector(VECSXP, 2)); - SET_VECTOR_ELT(dnc, 0, VECTOR_ELT(dna, 0)); - SET_VECTOR_ELT(dnc, 1, VECTOR_ELT(dnb, 1)); - - SEXP ans = chm_sparse_to_SEXP(chc, - 1, - (ul == '\0') ? 0 : ((ul == 'U') ? 1 : -1), - 0, - (di == '\0') ? "" : ((di == 'N') ? "N" : "U"), - dnc); - UNPROTECT(5); - return ans; -} - -/** @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 boolArith) +SEXP R_sparse_matmult(SEXP x, SEXP y, SEXP xtrans, SEXP ytrans, SEXP ztrans, + SEXP boolean) { - static const char *valid[] = { VALID_CSPARSE, "" }; - int ivalid = R_check_class_etc(a, valid); + if (TYPEOF(boolean) != LGLSXP || LENGTH(boolean) < 1) + error(_("invalid '%s' to '%s'"), "boolean", __func__); + int boolean_ = LOGICAL(boolean)[0]; + + int xtrans_ = LOGICAL(xtrans)[0], ytrans_ = LOGICAL(ytrans)[0], + ztrans_ = LOGICAL(ztrans)[0], m, n, v; + matmultDim(x, y, &xtrans_, &ytrans_, &ztrans_, &m, &n, &v); + + PROTECT_INDEX xpid, ypid; + PROTECT_WITH_INDEX(x, &xpid); + PROTECT_WITH_INDEX(y, &ypid); + + if (TYPEOF(x) != S4SXP) { + if (boolean_ == NA_LOGICAL || !boolean_) + REPROTECT(x = matrix_as_dense( x, ",ge", '\0', '\0', xtrans_, 0), xpid); + else if (!xtrans_) + REPROTECT(x = matrix_as_sparse(x, "ngC", '\0', '\0', xtrans_ ), xpid); + else + REPROTECT(x = matrix_as_sparse(x, "ngR", '\0', '\0', xtrans_ ), xpid); + if (v == 1) { + /* Discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), + (xtrans_) ? 1 : 0, R_NilValue); + xtrans_ = 0; + } + } + if (TYPEOF(y) != S4SXP && y != R_NilValue) { + if (boolean_ == NA_LOGICAL || !boolean_) + REPROTECT(y = matrix_as_dense( y, ",ge", '\0', '\0', ytrans_, 0), ypid); + else if (!ytrans_) + REPROTECT(y = matrix_as_sparse(y, "ngC", '\0', '\0', ytrans_ ), ypid); + else + REPROTECT(y = matrix_as_sparse(y, "ngR", '\0', '\0', ytrans_ ), ypid); + if (v == 2) { + /* Discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(y, Matrix_DimNamesSym), + (ytrans_) ? 1 : 0, R_NilValue); + ytrans_ = 0; + } + } + + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, VALID_DENSE, "" }; + const char *xcl = NULL, *ycl = NULL; + int ivalid; + ivalid = R_check_class_etc(x, valid); if (ivalid < 0) - ERROR_INVALID_CLASS(a, __func__); - const char *acl = valid[ivalid]; - ivalid = R_check_class_etc(b, valid); + ERROR_INVALID_CLASS(x, __func__); + xcl = valid[ivalid]; + if (y != R_NilValue) { + ivalid = R_check_class_etc(y, valid); if (ivalid < 0) - ERROR_INVALID_CLASS(b, __func__); - const char *bcl = valid[ivalid]; + ERROR_INVALID_CLASS(y, __func__); + ycl = valid[ivalid]; + } + if (boolean_ == NA_LOGICAL) + boolean_ = xcl[0] == 'n' && (y == R_NilValue || ycl[0] == 'n'); + char kind = (boolean_) ? 'n' : + ((xcl[0] == 'z' || (y != R_NilValue && ycl[0] == 'z')) ? 'z' : 'd'); + + if (xcl[2] != 'C' && xtrans_) { + if (xcl[2] != 'R' && xcl[2] != 'T') { + REPROTECT(x = dense_as_sparse(x, xcl, 'R'), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (xcl[1] != 's' || xcl[1] != 'T') { + REPROTECT(x = sparse_transpose(x, xcl, 1), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + xtrans_ = 0; + } + if (xcl[2] != 'C') { + if (xcl[2] != 'R' && xcl[2] != 'T') + REPROTECT(x = dense_as_sparse(x, xcl, 'C'), xpid); + else + REPROTECT(x = sparse_as_Csparse(x, xcl), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (xcl[1] == 's') + xtrans_ = 0; + if (xcl[0] != kind) { + if (boolean_) + REPROTECT(x = sparse_drop0(x, xcl, 0.0), xpid); + else { + REPROTECT(x = sparse_as_kind(x, xcl, kind), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + } - int doTrans = asLogical(trans), doBool = asLogical(boolArith); - if (doBool == NA_LOGICAL) - doBool = (acl[0] == 'n' && bcl[0] == 'n'); - if (doBool) { - if (acl[0] != 'n') - a = sparse_as_kind(a, acl, 'n'); - PROTECT(a); - if (bcl[0] != 'n') - b = sparse_as_kind(b, bcl, 'n'); - PROTECT(b); - } else { - if (acl[0] != 'd') - a = sparse_as_kind(a, acl, 'd'); - PROTECT(a); - if (bcl[0] != 'd') - b = sparse_as_kind(b, bcl, 'd'); - PROTECT(b); + if (y == R_NilValue) { + REPROTECT(x = sparse_as_general(x, xcl), xpid); + x = dgCMatrix_dgCMatrix_matmult( + x, y, xtrans_, !xtrans_, ztrans_, 0, boolean_); + UNPROTECT(2); /* y, x */ + return x; } - CHM_SP cha = AS_CHM_SP(a), chb = AS_CHM_SP(b), chc; - R_CheckStack(); - if (doTrans) - chb = cholmod_transpose(chb, chb->xtype, &c); - else - cha = cholmod_transpose(cha, cha->xtype, &c); - chc = cholmod_ssmult(cha, chb, 0, !doBool, 1, &c); - if (doTrans) - cholmod_free_sparse(&chb, &c); - else - cholmod_free_sparse(&cha, &c); + int triangular = 0; + if (xcl[1] == 't' && ycl[1] == 't') { + SEXP + xuplo = PROTECT(GET_SLOT(x, Matrix_uploSym)), + yuplo = PROTECT(GET_SLOT(y, Matrix_uploSym)), + xdiag = PROTECT(GET_SLOT(x, Matrix_diagSym)), + ydiag = PROTECT(GET_SLOT(y, Matrix_diagSym)); + char + xul = *CHAR(STRING_ELT(xuplo, 0)), + yul = *CHAR(STRING_ELT(yuplo, 0)), + xdi = *CHAR(STRING_ELT(xdiag, 0)), + ydi = *CHAR(STRING_ELT(ydiag, 0)); + if (xtrans_) + xul = (xul == 'U') ? 'L' : 'U'; + if (ytrans_) + yul = (yul == 'U') ? 'L' : 'U'; + triangular = (xul != yul) ? 0 : ((xdi != ydi || xdi == 'N') ? 1 : 2); + if (xul != 'U') + triangular = -triangular; + UNPROTECT(4); /* ydiag, xdiag, yuplo, xuplo */ + } - char ul = '\0', di = '\0'; - if (acl[1] == 't' && bcl[1] == 't') { - SEXP auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)), - buplo = PROTECT(GET_SLOT(b, Matrix_uploSym)); - char aul = *CHAR(STRING_ELT(auplo, 0)), - bul = *CHAR(STRING_ELT(buplo, 0)); - if (aul != bul) { - ul = (doTrans) ? aul : bul; - di = 'N'; - SEXP adiag = PROTECT(GET_SLOT(a, Matrix_diagSym)), - bdiag = PROTECT(GET_SLOT(b, Matrix_diagSym)); - char adi = *CHAR(STRING_ELT(adiag, 0)), - bdi = *CHAR(STRING_ELT(bdiag, 0)); - if (adi != 'N' && bdi != 'N') { - di = 'U'; - chm_diagN2U(chc, (ul == 'U') ? 1 : -1, 0); - } - UNPROTECT(2); + if (!boolean_ && ycl[2] != 'C' && ycl[2] != 'R' && ycl[2] != 'T') { + int symmetric = xcl[1] == 's'; + if (symmetric) { + SEXP xuplo = PROTECT(GET_SLOT(x, Matrix_uploSym)); + char xul = *CHAR(STRING_ELT(xuplo, 0)); + if (xul != 'U') + symmetric = -1; + UNPROTECT(1); /* xuplo */ } - UNPROTECT(2); + if (ycl[0] != kind) { + REPROTECT(y = dense_as_kind(y, ycl, kind, 0), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + REPROTECT(y = dense_as_general(y, ycl, 1), ypid); + if (xcl[1] == 't') + REPROTECT(x = sparse_diag_U2N(x, xcl), xpid); + x = dgCMatrix_dgeMatrix_matmult( + x, y, xtrans_, ytrans_, ztrans_, triangular, symmetric); + UNPROTECT(2); /* y, x */ + return x; } - SEXP - dna = PROTECT((acl[1] != 's') - ? GET_SLOT(a, Matrix_DimNamesSym) - : get_symmetrized_DimNames(a, -1)), - dnb = PROTECT((bcl[1] != 's') - ? GET_SLOT(b, Matrix_DimNamesSym) - : get_symmetrized_DimNames(b, -1)), - dnc = PROTECT(allocVector(VECSXP, 2)); - SET_VECTOR_ELT(dnc, 0, VECTOR_ELT(dna, (doTrans) ? 0 : 1)); - SET_VECTOR_ELT(dnc, 1, VECTOR_ELT(dnb, (doTrans) ? 0 : 1)); - - SEXP ans = chm_sparse_to_SEXP(chc, - 1, - (ul == '\0') ? 0 : ((ul == 'U') ? 1 : -1), - 0, - (di == '\0') ? "" : ((di == 'N') ? "N" : "U"), - dnc); - UNPROTECT(5); - return ans; -} - -/** @brief Computes x'x or x x' -- *also* for Tsparse - * see Csparse_Csparse_crossprod above for x'y and x y' - */ -SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP boolArith) -{ - static const char *valid[] = { VALID_CSPARSE, VALID_TSPARSE, "" }; - int ivalid = R_check_class_etc(x, valid); + if (ycl[2] != 'C' && ytrans_) { + if (ycl[2] != 'R' && ycl[2] != 'T') { + REPROTECT(y = dense_as_sparse(y, ycl, 'R'), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + if (ycl[1] != 's' || ycl[1] != 'T') { + REPROTECT(y = sparse_transpose(y, ycl, 1), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + ytrans_ = 0; + } + if (ycl[2] != 'C') { + if (ycl[2] != 'R' && ycl[2] != 'T') + REPROTECT(y = dense_as_sparse(y, ycl, 'C'), ypid); + else + REPROTECT(y = sparse_as_Csparse(y, ycl), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + if (ycl[1] == 's') + ytrans_ = 0; + if (ycl[0] != kind) { + if (boolean_) + REPROTECT(y = sparse_drop0(y, ycl, 0.0), ypid); + else { + REPROTECT(y = sparse_as_kind(y, ycl, kind), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + } + + REPROTECT(x = sparse_as_general(x, xcl), xpid); + REPROTECT(y = sparse_as_general(y, ycl), ypid); + x = dgCMatrix_dgCMatrix_matmult( + x, y, xtrans_, ytrans_, ztrans_, triangular, boolean_); + UNPROTECT(2); /* y, x */ + return x; +} + +#define MULTIPLY_COMPLEX(_X_, _D_) \ + do { \ + tmp = (_X_); \ + (_X_).r = tmp.r * (_D_).r - tmp.i * (_D_).i; \ + (_X_).i = tmp.r * (_D_).i + tmp.i * (_D_).r; \ + } while (0) +#define MULTIPLY_REAL(_X_, _D_) \ + (_X_) = (_X_) * (_D_) +#define MULTIPLY_LOGICAL(_X_, _D_) \ + (_X_) = (_X_) && (_D_) + +#define SCALE_CASES(_J_) \ + do { \ + switch (TYPEOF(d)) { \ + case CPLXSXP: \ + { \ + Rcomplex tmp; \ + SCALE(Rcomplex, COMPLEX, MULTIPLY_COMPLEX, _J_); \ + break; \ + } \ + case REALSXP: \ + SCALE(double, REAL, MULTIPLY_REAL, _J_); \ + break; \ + default: \ + SCALE(int, LOGICAL, MULTIPLY_LOGICAL, _J_); \ + break; \ + } \ + } while (0) + +static +void dense_colscale(SEXP obj, SEXP d, int m, int n, char uplo, char diag) +{ + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j, packed = XLENGTH(x) < (R_xlen_t) m * n; + +#define SCALE(_CTYPE_, _PTR_, _OP_, _J_) \ + do { \ + _CTYPE_ *px = _PTR_(x), *pd = _PTR_(d); \ + if (uplo == '\0') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < m; ++i) { \ + _OP_(*px, pd[_J_]); \ + ++px; \ + } \ + } \ + } else if (uplo == 'U') { \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i <= j; ++i) { \ + _OP_(*px, pd[_J_]); \ + ++px; \ + } \ + if (!packed) \ + px += m - j - 1; \ + } \ + } else { \ + for (j = 0; j < n; ++j) { \ + if (!packed) \ + px += j; \ + for (i = j; i < m; ++i) { \ + _OP_(*px, pd[_J_]); \ + ++px; \ + } \ + } \ + } \ + if (diag != '\0' && diag != 'N') { \ + px = _PTR_(x); \ + if (!packed) { \ + R_xlen_t m1a = (R_xlen_t) m + 1; \ + for (j = 0; j < n; ++j, px += m1a, pd += 1) \ + *px = *pd; \ + } else if (uplo == 'U') { \ + for (j = 0; j < n; px += (++j)+1, pd += 1) \ + *px = *pd; \ + } else { \ + for (j = 0; j < n; px += m-(j++), pd += 1) \ + *px = *pd; \ + } \ + } \ + } while (0) + + SCALE_CASES(j); + return; +} + +static +void dense_rowscale(SEXP obj, SEXP d, int m, int n, char uplo, char diag) +{ + SEXP x = GET_SLOT(obj, Matrix_xSym); + int i, j, packed = XLENGTH(x) < (R_xlen_t) m * n; + SCALE_CASES(i); + +#undef SCALE + + return; +} + +/* boolean: & or & */ +/* numeric: * or * */ +static +void Csparse_colscale(SEXP obj, SEXP d) +{ + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + p = PROTECT(GET_SLOT(obj, Matrix_pSym)); + int *pp = INTEGER(p) + 1, n = (int) (XLENGTH(p) - 1), j, k = 0, kend; + UNPROTECT(2); /* p, x */ + +#define SCALE(_CTYPE_, _PTR_, _OP_, _J_) \ + do { \ + _CTYPE_ *px = _PTR_(x), *pd = _PTR_(d); \ + for (j = 0; j < n; ++j) { \ + kend = pp[j]; \ + while (k < kend) { \ + _OP_(*px, *pd); \ + ++px; \ + ++k; \ + } \ + ++pd; \ + } \ + } while (0) + + SCALE_CASES(); + +#undef SCALE + + return; +} + +/* boolean: & or & */ +/* numeric: * or * */ +static +void Csparse_rowscale(SEXP obj, SEXP d, SEXP iSym) +{ + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, iSym)); + int *pi = INTEGER(i), k, nnz = INTEGER(p)[XLENGTH(p) - 1]; + UNPROTECT(3); /* i, p, x */ + +#define SCALE(_CTYPE_, _PTR_, _OP_, _J_) \ + do { \ + _CTYPE_ *px = _PTR_(x), *pd = _PTR_(d); \ + for (k = 0; k < nnz; ++k) { \ + _OP_(*px, pd[*pi]); \ + ++px; \ + ++pi; \ + } \ + } while (0) + + SCALE_CASES(); + return; +} + +/* boolean: & or & */ +/* numeric: * or * */ +static +void Tsparse_rowscale(SEXP obj, SEXP d, SEXP iSym) +{ + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), + i = PROTECT(GET_SLOT(obj, iSym)); + int *pi = INTEGER(i); + R_xlen_t k, nnz = XLENGTH(i); + UNPROTECT(2); /* i, x */ + SCALE_CASES(); + +#undef SCALE + + return; +} + +SEXP R_diagonal_matmult(SEXP x, SEXP y, SEXP xtrans, SEXP ytrans, + SEXP boolean) +{ + SEXP x_ = x, y_ = y; /* for later pointer comparison */ + + if (TYPEOF(boolean) != LGLSXP || LENGTH(boolean) < 1) + error(_("invalid '%s' to '%s'"), "boolean", __func__); + int boolean_ = LOGICAL(boolean)[0]; + + int xtrans_ = LOGICAL(xtrans)[0], ytrans_ = LOGICAL(ytrans)[0], + ztrans_ = 0, m, n, v; + matmultDim(x, y, &xtrans_, &ytrans_, &ztrans_, &m, &n, &v); + + PROTECT_INDEX xpid, ypid; + PROTECT_WITH_INDEX(x, &xpid); + PROTECT_WITH_INDEX(y, &ypid); + + if (TYPEOF(x) != S4SXP) { + if (boolean_ == NA_LOGICAL || !boolean_) + REPROTECT(x = matrix_as_dense(x, ",ge", '\0', '\0', xtrans_, 2), xpid); + else + REPROTECT(x = matrix_as_dense(x, "nge", '\0', '\0', xtrans_, 2), xpid); + if (v == 1) { + /* Vector: discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), + (xtrans_) ? 1 : 0, R_NilValue); + xtrans_ = 0; + } + } + if (TYPEOF(y) != S4SXP) { + if (boolean_ == NA_LOGICAL || !boolean_) + REPROTECT(y = matrix_as_dense(y, ",ge", '\0', '\0', ytrans_, 2), ypid); + else + REPROTECT(y = matrix_as_dense(y, "nge", '\0', '\0', ytrans_, 2), ypid); + if (v == 2) { + /* Vector: discard names and don't transpose again */ + SET_VECTOR_ELT(GET_SLOT(y, Matrix_DimNamesSym), + (ytrans_) ? 1 : 0, R_NilValue); + ytrans_ = 0; + } + } + + static const char *valid[] = { + VALID_DIAGONAL, + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, VALID_DENSE, "" }; + const char *xcl = NULL, *ycl = NULL; + int ivalid; + ivalid = R_check_class_etc(x, valid); if (ivalid < 0) ERROR_INVALID_CLASS(x, __func__); - const char *cl = valid[ivalid]; + xcl = valid[ivalid]; + if (xcl[1] == 's') + xtrans_ = 0; + ivalid = R_check_class_etc(y, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(y, __func__); + ycl = valid[ivalid]; + if (ycl[1] == 's') + ytrans_ = 0; + if (boolean_ == NA_LOGICAL) + boolean_ = xcl[0] == 'n' && ycl[0] == 'n'; + char kind = (boolean_) ? 'n' : + ((xcl[0] == 'z' || ycl[0] == 'z') ? 'z' : 'd'); + + int margin = -1, unit = -1; + if (xcl[2] == 'i') { + margin = 0; + unit = *CHAR(STRING_ELT(GET_SLOT(x, Matrix_diagSym), 0)) != 'N'; + } else if (ycl[2] == 'i') { + margin = 1; + unit = *CHAR(STRING_ELT(GET_SLOT(y, Matrix_diagSym), 0)) != 'N'; + } else + error(_("should never happen ...")); + + char ks = (boolean_) ? 'l' : kind, kd = kind; + switch (xcl[2]) { + case 'i': + if (!unit && xcl[0] != ks) { + REPROTECT(x = diagonal_as_kind(x, xcl, ks), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + break; + case 'C': + case 'R': + case 'T': + if (xcl[0] != ks) { + REPROTECT(x = sparse_as_kind(x, xcl, ks), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (!unit && xcl[1] == 's') { + REPROTECT(x = sparse_as_general(x, xcl), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } else if (!unit && xcl[1] == 't') + REPROTECT(x = sparse_diag_U2N(x, xcl), xpid); + if (xtrans_) { + REPROTECT(x = sparse_transpose(x, xcl, 0), xpid); + xtrans_ = 0; + } + break; + default: + if (xcl[0] != kd) { + REPROTECT(x = dense_as_kind(x, xcl, kd, 1), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (!unit && xcl[1] == 's') { + REPROTECT(x = dense_as_general(x, xcl, x == x_), xpid); + xcl = valid[R_check_class_etc(x, valid)]; + } + if (xtrans_) { + REPROTECT(x = dense_transpose(x, xcl), xpid); + xtrans_ = 0; + } + break; + } + switch (ycl[2]) { + case 'i': + if (!unit && ycl[0] != ks) { + REPROTECT(y = diagonal_as_kind(y, ycl, ks), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + break; + case 'C': + case 'R': + case 'T': + if (ycl[0] != ks) { + REPROTECT(y = sparse_as_kind(y, ycl, ks), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + if (!unit && ycl[1] == 's') { + REPROTECT(y = sparse_as_general(y, ycl), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } else if (!unit && ycl[1] == 't') + REPROTECT(y = sparse_diag_U2N(y, ycl), ypid); + if (ytrans_) { + REPROTECT(y = sparse_transpose(y, ycl, 0), ypid); + ytrans_ = 0; + } + break; + default: + if (ycl[0] != kd) { + REPROTECT(y = dense_as_kind(y, ycl, kd, 1), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + if (!unit && ycl[1] == 's') { + REPROTECT(y = dense_as_general(y, ycl, y == y_), ypid); + ycl = valid[R_check_class_etc(y, valid)]; + } + if (ytrans_) { + REPROTECT(y = dense_transpose(y, ycl), ypid); + ytrans_ = 0; + } + break; + } - int doTrans = asLogical(trans), doBool = asLogical(boolArith); - if (doBool == NA_LOGICAL) - doBool = cl[0] == 'n'; - if (doBool) { - if (cl[0] != 'n') - x = sparse_as_kind(x, cl, 'n'); - } else { - if (cl[0] != 'd') - x = sparse_as_kind(x, cl, 'd'); + SEXP z; + PROTECT_INDEX zpid; + const char *zcl = (margin == 0) ? ycl : xcl; + PROTECT_WITH_INDEX(z = newObject(zcl), &zpid); + + SEXP zdim = PROTECT(GET_SLOT(z, Matrix_DimSym)); + int *pzdim = INTEGER(zdim); + pzdim[0] = m; + pzdim[1] = n; + UNPROTECT(1); /* zdim */ + + SEXP xdimnames = PROTECT(GET_SLOT(x, Matrix_DimNamesSym)), + ydimnames = PROTECT(GET_SLOT(y, Matrix_DimNamesSym)), + zdimnames = PROTECT(GET_SLOT(z, Matrix_DimNamesSym)); + matmultDN(zdimnames, + xdimnames, (xtrans_) ? 1 : 0, + ydimnames, (ytrans_) ? 0 : 1); + UNPROTECT(3); /* zdimnames, ydimnames, xdimnames */ + + char ul = '\0', di = '\0'; + if (zcl[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_uploSym)); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (ul != 'U') + SET_SLOT(z, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + + if (zcl[1] == 't') { + SEXP diag = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_diagSym)); + di = *CHAR(STRING_ELT(diag, 0)); + if (di != 'N' && unit) + SET_SLOT(z, Matrix_diagSym, diag); + UNPROTECT(1); /* diag */ + } } - PROTECT(x); - int doFree = 0; - CHM_SP chx, chc; - if (cl[2] != 'T') { - chx = AS_CHM_SP(x); - R_CheckStack(); - } else { - /* defined in ./sparse.c : */ - SEXP sparse_diag_U2N(SEXP, const char *); - x = sparse_diag_U2N(x, cl); /* work around as_cholmod_triplet (?) */ - UNPROTECT(1); - PROTECT(x); - CHM_TR tmp = AS_CHM_TR__(x); - R_CheckStack(); - chx = cholmod_triplet_to_sparse(tmp, tmp->nnz, &c); - doFree = 1; - } - if (!doTrans) { - CHM_SP tmp = cholmod_transpose(chx, chx->xtype, &c); - if (doFree) - cholmod_free_sparse(&chx, &c); - else doFree = 1; - chx = tmp; - } - if (chx->stype != 0) { - CHM_SP tmp = cholmod_copy(chx, 0, chx->xtype, &c); - if (doFree) - cholmod_free_sparse(&chx, &c); - else doFree = 1; - chx = tmp; - } - chc = cholmod_aat(chx, (int *) NULL, 0, chx->xtype, &c); - if (doFree) - cholmod_free_sparse(&chx, &c); - chc->stype = 1; - - SEXP - dnx = PROTECT((cl[1] != 's') - ? GET_SLOT(x, Matrix_DimNamesSym) - : get_symmetrized_DimNames(x, -1)), - dnc = PROTECT(allocVector(VECSXP, 2)); - SET_VECTOR_ELT(dnc, 0, VECTOR_ELT(dnx, (doTrans) ? 0 : 1)); - SET_VECTOR_ELT(dnc, 1, VECTOR_ELT(dnx, (doTrans) ? 0 : 1)); - - SEXP ans = chm_sparse_to_SEXP(chc, 1, 0, 0, "", dnc); - UNPROTECT(3); - return ans; -} - -SEXP Csparse_dense_prod(SEXP a, SEXP b, SEXP trans) -{ - return - Csp_dense_products(a, b, - /* trans_a = */ FALSE, - /* trans_b = */ (*CHAR(asChar(trans)) == '2' || *CHAR(asChar(trans)) == 'B'), - /* trans_ans = */ (*CHAR(asChar(trans)) == 'c' || *CHAR(asChar(trans)) == 'B')); -} - -SEXP Csparse_dense_crossprod(SEXP a, SEXP b, SEXP trans) -{ - return - Csp_dense_products(a, b, - /* trans_a = */ TRUE, - /* trans_b = */ (*CHAR(asChar(trans)) == '2' || *CHAR(asChar(trans)) == 'B'), - /* trans_ans = */ (*CHAR(asChar(trans)) == 'c' || *CHAR(asChar(trans)) == 'B')); + if (zcl[2] == 'C' || zcl[2] == 'R' || zcl[2] == 'T') { + if (zcl[2] != 'T') { + SEXP p = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_pSym)); + SET_SLOT(z, Matrix_pSym, p); + UNPROTECT(1); /* p */ + } + if (zcl[2] != 'R') { + SEXP i = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_iSym)); + SET_SLOT(z, Matrix_iSym, i); + UNPROTECT(1); /* i */ + } + if (zcl[2] != 'C') { + SEXP j = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_jSym)); + SET_SLOT(z, Matrix_jSym, j); + UNPROTECT(1); /* j */ + } + } + + SEXP x0 = PROTECT(GET_SLOT((margin == 0) ? y : x, Matrix_xSym)); + if (unit || ((margin == 0) ? y != y_ : x != x_)) + SET_SLOT(z, Matrix_xSym, x0); + else { + SEXP x1 = PROTECT(allocVector(TYPEOF(x0), XLENGTH(x0))); + switch (kind) { + case 'z': + Matrix_memcpy(COMPLEX(x1), COMPLEX(x0), XLENGTH(x0), sizeof(Rcomplex)); + break; + case 'd': + Matrix_memcpy( REAL(x1), REAL(x0), XLENGTH(x0), sizeof( double)); + break; + default: + Matrix_memcpy(LOGICAL(x1), LOGICAL(x0), XLENGTH(x0), sizeof( int)); + break; + } + SET_SLOT(z, Matrix_xSym, x1); + UNPROTECT(1); /* x1 */ + } + UNPROTECT(1); /* x0 */ + + if (!unit) { + SEXP d = PROTECT(GET_SLOT((margin == 0) ? x : y, Matrix_xSym)); + switch (zcl[2]) { + case 'C': + if (margin == 0) + Csparse_rowscale(z, d, Matrix_iSym); + else + Csparse_colscale(z, d); + break; + case 'R': + if (margin == 0) + Csparse_colscale(z, d); + else + Csparse_rowscale(z, d, Matrix_jSym); + break; + case 'T': + if (margin == 0) + Tsparse_rowscale(z, d, Matrix_iSym); + else + Tsparse_rowscale(z, d, Matrix_jSym); + break; + default: + if (margin == 0) + dense_rowscale(z, d, m, n, ul, di); + else + dense_colscale(z, d, m, n, ul, di); + break; + } + UNPROTECT(1); /* d */ + } + + if (boolean_ && (zcl[2] == 'C' || zcl[2] == 'R' || zcl[2] == 'T')) { + REPROTECT(z = sparse_drop0(z, zcl, 0.0), zpid); + REPROTECT(z = sparse_as_kind(z, zcl, 'n'), zpid); + } + + UNPROTECT(3); /* z, y, x */ + return z; } diff -Nru rmatrix-1.6-1.1/src/products.h rmatrix-1.6-5/src/products.h --- rmatrix-1.6-1.1/src/products.h 2023-07-29 16:13:31.000000000 +0000 +++ rmatrix-1.6-5/src/products.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,39 +1,10 @@ #ifndef MATRIX_PRODUCTS_H #define MATRIX_PRODUCTS_H -#include "Lapack-etc.h" -#include "Mutils.h" +#include -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 R_dense_matmult(SEXP, SEXP, SEXP, SEXP); +SEXP R_sparse_matmult(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +SEXP R_diagonal_matmult(SEXP, SEXP, SEXP, SEXP, SEXP); -SEXP dgeMatrix_matrix_mm(SEXP a, SEXP b, SEXP right); -SEXP geMatrix_matrix_mm(SEXP a, SEXP b, SEXP right); - -SEXP dtrMatrix_dtrMatrix_mm(SEXP a, SEXP b, SEXP right, SEXP trans); -SEXP dtrMatrix_matrix_mm (SEXP a, SEXP b, SEXP right, SEXP trans); - -SEXP dtpMatrix_matrix_mm(SEXP x, SEXP y, SEXP right, SEXP trans); -SEXP dgeMatrix_dtpMatrix_mm(SEXP x, SEXP y); - -SEXP dsyMatrix_matrix_mm(SEXP a, SEXP b, SEXP right); - -SEXP dspMatrix_matrix_mm(SEXP a, SEXP b); - -SEXP Csp_dense_products(SEXP a, SEXP b, - Rboolean trans_a, - Rboolean trans_b, - Rboolean trans_ans); - -SEXP Csparse_Csparse_prod(SEXP a, SEXP b, SEXP boolArith); -SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans, SEXP boolArith); -SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP boolArith); - -SEXP Csparse_dense_prod (SEXP a, SEXP b, SEXP trans); -SEXP Csparse_dense_crossprod(SEXP a, SEXP b, SEXP trans); - -#endif +#endif /* MATRIX_PRODUCTS_H */ diff -Nru rmatrix-1.6-1.1/src/scripts/DEPS.mkf rmatrix-1.6-5/src/scripts/DEPS.mkf --- rmatrix-1.6-1.1/src/scripts/DEPS.mkf 2023-07-25 14:16:26.000000000 +0000 +++ rmatrix-1.6-5/src/scripts/DEPS.mkf 2023-10-24 20:28:51.000000000 +0000 @@ -1,85 +1,113 @@ #-*- Makefile -*- #------------- produced by ./DEPS.mkf_make.sh (plus minimal emacs cleanup) # -CHMfactor.o: CHMfactor.c CHMfactor.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 \ - Mutils.h Mdefines.h Syms.h Minlines.h -Csparse.o: Csparse.c Csparse.h Mutils.h Mdefines.h Syms.h Minlines.h \ - chm_common.h SuiteSparse_config/SuiteSparse_config.h \ +Csparse.o: Csparse.c Mdefines.h version.h Syms.h utils.h cs-etc.h cs.h \ + cholmod-etc.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 \ - cs_utils.h cs.h t_Csparse_validate.c t_Csparse_subassign.c -Mutils.o: Mutils.c Mutils.h Mdefines.h Syms.h Minlines.h -abIndex.o: abIndex.c abIndex.h Mutils.h Mdefines.h Syms.h Minlines.h \ + Csparse.h t_Csparse_subassign.c +abIndex.o: abIndex.c Mdefines.h version.h Syms.h utils.h abIndex.h \ t_Matrix_rle.c -bind.o: bind.c bind.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -chm_common.o: chm_common.c chm_common.h \ +attrib.o: attrib.c Mdefines.h version.h Syms.h utils.h attrib.h +bind.o: bind.c Mdefines.h version.h Syms.h utils.h coerce.h bind.h +chm_common.o: chm_common.c Mdefines.h version.h \ + Syms.h utils.h chm_common.h \ + cholmod-etc.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 +cholmod-etc.o: cholmod-etc.c Mdefines.h version.h \ + Syms.h utils.h idz.h cholmod-etc.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 Mdefines.h Syms.h Minlines.h -coerce.o: coerce.c coerce.h \ - Mutils.h Mdefines.h Syms.h Minlines.h + CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h +coerce.o: coerce.c Mdefines.h version.h Syms.h utils.h idz.h coerce.h +cs-etc.o: cs-etc.c Mdefines.h version.h Syms.h utils.h cs-etc.h cs.h cs.o: cs.c cs.h -cs_utils.o: cs_utils.c cs_utils.h cs.h Mutils.h Mdefines.h Syms.h Minlines.h -dense.o: dense.c dense.h Lapack-etc.h Mutils.h Mdefines.h Syms.h Minlines.h -dgCMatrix.o: dgCMatrix.c dgCMatrix.h Mutils.h Mdefines.h Syms.h Minlines.h \ - cs_utils.h cs.h chm_common.h \ +cs_utils.o: cs_utils.c +dense.o: dense.c Mdefines.h version.h Syms.h utils.h idz.h dense.h +determinant.o: determinant.c Mdefines.h version.h \ + Syms.h utils.h cholmod-etc.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 -dgeMatrix.o: dgeMatrix.c dgeMatrix.h Lapack-etc.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -factorizations.o: factorizations.c factorizations.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -init.o: init.c abIndex.h \ - Mutils.h Mdefines.h Syms.h Minlines.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 dense.h Lapack-etc.h \ - dgCMatrix.h cs_utils.h cs.h dgeMatrix.h \ - factorizations.h packedMatrix.h products.h \ - unpackedMatrix.h sparse.h sparseVector.h subscript.h validity.h -kappa.o: kappa.c kappa.h Lapack-etc.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -packedMatrix.o: packedMatrix.c packedMatrix.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -products.o: products.c products.h Lapack-etc.h \ - Mutils.h Mdefines.h Syms.h Minlines.h \ - chm_common.h SuiteSparse_config/SuiteSparse_config.h \ + determinant.h +dgCMatrix.o: dgCMatrix.c Mdefines.h version.h \ + Syms.h utils.h cs-etc.h cs.h \ + cholmod-etc.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 -sparse.o: sparse.c sparse.h Mutils.h Mdefines.h Syms.h Minlines.h -sparseVector.o: sparseVector.c sparseVector.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -subscript.o: subscript.c subscript.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -unpackedMatrix.o: unpackedMatrix.c unpackedMatrix.h \ - Mutils.h Mdefines.h Syms.h Minlines.h -validity.o: validity.c validity.h \ - Mutils.h Mdefines.h Syms.h Minlines.h + CHOLMOD/Include/cholmod_matrixops.h CHOLMOD/Include/cholmod_modify.h \ + dgCMatrix.h +dgeMatrix.o: dgeMatrix.c Lapack-etc.h Mdefines.h version.h \ + Syms.h utils.h dgeMatrix.h +factorizations.o: factorizations.c Lapack-etc.h \ + cs-etc.h \ + cs.h \ + cholmod-etc.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 \ + Mdefines.h version.h Syms.h utils.h factorizations.h +idz.o: idz.c Mdefines.h version.h Syms.h utils.h idz.h +init.o: init.c Mdefines.h version.h Syms.h utils.h Csparse.h abIndex.h \ + attrib.h bind.h chm_common.h cholmod-etc.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 \ + coerce.h dense.h determinant.h dgCMatrix.h dgeMatrix.h \ + factorizations.h kappa.h objects.h perm.h products.h solve.h sparse.h \ + sparseVector.h subscript.h utils-R.h validity.h +kappa.o: kappa.c Lapack-etc.h Mdefines.h version.h \ + Syms.h utils.h kappa.h +objects.o: objects.c Mdefines.h version.h Syms.h utils.h objects.h +perm.o: perm.c Mdefines.h version.h Syms.h utils.h perm.h +products.o: products.c Lapack-etc.h cholmod-etc.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 \ + Mdefines.h version.h Syms.h utils.h idz.h coerce.h \ + dense.h sparse.h products.h +solve.o: solve.c Lapack-etc.h cs-etc.h \ + cs.h \ + cholmod-etc.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 \ + Mdefines.h version.h Syms.h utils.h idz.h solve.h +sparse.o: sparse.c Mdefines.h version.h Syms.h utils.h sparse.h +sparseVector.o: sparseVector.c Mdefines.h version.h \ + Syms.h utils.h sparseVector.h +subscript.o: subscript.c Mdefines.h version.h \ + Syms.h utils.h subscript.h +utils-R.o: utils-R.c Mdefines.h version.h Syms.h utils.h utils-R.h +utils.o: utils.c Mdefines.h version.h Syms.h utils.h +validity.o: validity.c Mdefines.h version.h Syms.h utils.h validity.h diff -Nru rmatrix-1.6-1.1/src/scripts/SOURCES_C.mkf rmatrix-1.6-5/src/scripts/SOURCES_C.mkf --- rmatrix-1.6-1.1/src/scripts/SOURCES_C.mkf 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/scripts/SOURCES_C.mkf 2023-09-26 06:40:29.000000000 +0000 @@ -1,23 +1,28 @@ SOURCES_C = \ - CHMfactor.c \ Csparse.c \ - init.c \ - Mutils.c \ + abIndex.c \ + attrib.c \ bind.c \ chm_common.c \ + cholmod-etc.c \ coerce.c \ cs.c \ - cs_utils.c \ + cs-etc.c \ dense.c \ + determinant.c \ dgCMatrix.c \ dgeMatrix.c \ factorizations.c \ + idz.c \ + init.c \ kappa.c \ - sparseVector.c \ - abIndex.c \ - packedMatrix.c \ + objects.c \ + perm.c \ products.c \ - unpackedMatrix.c \ + solve.c \ sparse.c \ + sparseVector.c \ subscript.c \ + utils-R.c \ + utils.c \ validity.c diff -Nru rmatrix-1.6-1.1/src/solve.c rmatrix-1.6-5/src/solve.c --- rmatrix-1.6-1.1/src/solve.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/solve.c 2023-10-13 20:01:06.000000000 +0000 @@ -0,0 +1,1115 @@ +#include "Lapack-etc.h" +#include "cs-etc.h" +#include "cholmod-etc.h" +#include "Mdefines.h" +#include "idz.h" +#include "solve.h" + +static +void solveDN(SEXP rdn, SEXP adn, SEXP bdn) +{ + SEXP s; + if (!isNull(s = VECTOR_ELT(adn, 1))) + SET_VECTOR_ELT(rdn, 0, s); + if (!isNull(s = VECTOR_ELT(bdn, 1))) + SET_VECTOR_ELT(rdn, 1, s); + PROTECT(adn = getAttrib(adn, R_NamesSymbol)); + PROTECT(bdn = getAttrib(bdn, R_NamesSymbol)); + if(!isNull(adn) || !isNull(bdn)) { + PROTECT(s = allocVector(STRSXP, 2)); + if (!isNull(adn)) + SET_STRING_ELT(s, 0, STRING_ELT(adn, 1)); + if (!isNull(bdn)) + SET_STRING_ELT(s, 1, STRING_ELT(bdn, 1)); + setAttrib(rdn, R_NamesSymbol, s); + UNPROTECT(1); + } + UNPROTECT(2); + return; +} + +SEXP denseLU_solve(SEXP a, SEXP b) +{ + +#define SOLVE_START \ + SEXP adim = GET_SLOT(a, Matrix_DimSym); \ + int *padim = INTEGER(adim), m = padim[0], n = padim[1]; \ + if (m != n) \ + error(_("'%s' is not square"), "a"); \ + if (!isNull(b)) { \ + SEXP bdim = GET_SLOT(b, Matrix_DimSym); \ + int *pbdim = INTEGER(bdim); \ + if (pbdim[0] != m) \ + error(_("dimensions of '%s' and '%s' are inconsistent"), \ + "a", "b"); \ + n = pbdim[1]; \ + } + +#define SOLVE_FINISH \ + SEXP rdimnames = PROTECT(GET_SLOT(r, Matrix_DimNamesSym)), \ + adimnames = PROTECT(GET_SLOT(a, Matrix_DimNamesSym)); \ + if (isNull(b)) \ + revDN(rdimnames, adimnames); \ + else { \ + SEXP bdimnames = PROTECT(GET_SLOT(b, Matrix_DimNamesSym)); \ + solveDN(rdimnames, adimnames, bdimnames); \ + UNPROTECT(1); /* bdimnames */ \ + } \ + UNPROTECT(2); /* adimnames, rdimnames */ + + SOLVE_START; + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + + char rcl[] = ".geMatrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + + if (m > 0) { + SEXP apivot = PROTECT(GET_SLOT(a, Matrix_permSym)), rx; + int info; + if (isNull(b)) { + rx = duplicate(ax); + PROTECT(rx); + int lwork = -1; +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex work0, *work = &work0; + F77_CALL(zgetri)(&m, COMPLEX(rx), &m, INTEGER(apivot), + work, &lwork, &info); + ERROR_LAPACK_1(zgetri, info); + lwork = (int) work0.r; + work = (Rcomplex *) R_alloc((size_t) lwork, sizeof(Rcomplex)); + F77_CALL(zgetri)(&m, COMPLEX(rx), &m, INTEGER(apivot), + work, &lwork, &info); + ERROR_LAPACK_2(zgetri, info, 2, U); + } else { +#endif + double work0, *work = &work0; + F77_CALL(dgetri)(&m, REAL(rx), &m, INTEGER(apivot), + work, &lwork, &info); + ERROR_LAPACK_1(dgetri, info); + lwork = (int) work0; + work = (double *) R_alloc((size_t) lwork, sizeof(double )); + F77_CALL(dgetri)(&m, REAL(rx), &m, INTEGER(apivot), + work, &lwork, &info); + ERROR_LAPACK_2(dgetri, info, 2, U); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + rx = duplicate(bx); + UNPROTECT(1); /* bx */ + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + F77_CALL(zgetrs)("N", &m, &n, COMPLEX(ax), &m, INTEGER(apivot), + COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_1(zgetrs, info); + } else { +#endif + F77_CALL(dgetrs)("N", &m, &n, REAL(ax), &m, INTEGER(apivot), + REAL(rx), &m, &info FCONE); + ERROR_LAPACK_1(dgetrs, info); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(2); /* rx, apivot */ + } + + SOLVE_FINISH; + + UNPROTECT(2); /* r, ax */ + return r; +} + +SEXP BunchKaufman_solve(SEXP a, SEXP b) +{ + SOLVE_START; + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + int unpacked = (Matrix_int_fast64_t) m * m <= R_XLEN_T_MAX && + XLENGTH(ax) == (R_xlen_t) m * m; + + char rcl[] = "...Matrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + if (!isNull(b)) { + rcl[1] = 'g'; + rcl[2] = 'e'; + } else { + rcl[1] = 's'; + rcl[2] = (unpacked) ? 'y' : 'p'; + } + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + + SEXP auplo = GET_SLOT(a, Matrix_uploSym); + char aul = CHAR(STRING_ELT(auplo, 0))[0]; + if (isNull(b) && aul != 'U') { + PROTECT(auplo); + SET_SLOT(r, Matrix_uploSym, auplo); + UNPROTECT(1); /* auplo */ + } + + if (m > 0) { + SEXP apivot = PROTECT(GET_SLOT(a, Matrix_permSym)), rx; + int info; + if (isNull(b)) { + rx = duplicate(ax); + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + Rcomplex *work = (Rcomplex *) R_alloc((size_t) m, sizeof(Rcomplex)); + if (unpacked) { + F77_CALL(zsytri)(&aul, &m, COMPLEX(rx), &m, INTEGER(apivot), + work, &info FCONE); + ERROR_LAPACK_2(zsytri, info, 2, D); + } else { + F77_CALL(zsptri)(&aul, &m, COMPLEX(rx), INTEGER(apivot), + work, &info FCONE); + ERROR_LAPACK_2(zsptri, info, 2, D); + } + } else { +#endif + double *work = (double *) R_alloc((size_t) m, sizeof(double )); + if (unpacked) { + F77_CALL(dsytri)(&aul, &m, REAL(rx), &m, INTEGER(apivot), + work, &info FCONE); + ERROR_LAPACK_2(dsytri, info, 2, D); + } else { + F77_CALL(dsptri)(&aul, &m, REAL(rx), INTEGER(apivot), + work, &info FCONE); + ERROR_LAPACK_2(dsptri, info, 2, D); + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + rx = duplicate(bx); + UNPROTECT(1); /* bx */ + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + if (unpacked) { + F77_CALL(zsytrs)(&aul, &m, &n, COMPLEX(ax), &m, INTEGER(apivot), + COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_1(zsytrs, info); + } else { + F77_CALL(zsptrs)(&aul, &m, &n, COMPLEX(ax), INTEGER(apivot), + COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_1(zsptrs, info); + } + } else { +#endif + if (unpacked) { + F77_CALL(dsytrs)(&aul, &m, &n, REAL(ax), &m, INTEGER(apivot), + REAL(rx), &m, &info FCONE); + ERROR_LAPACK_1(dsytrs, info); + } else { + F77_CALL(dsptrs)(&aul, &m, &n, REAL(ax), INTEGER(apivot), + REAL(rx), &m, &info FCONE); + ERROR_LAPACK_1(dsptrs, info); + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(2); /* rx, apivot */ + } + + SOLVE_FINISH; + + UNPROTECT(2); /* r, ax */ + return r; +} + +SEXP Cholesky_solve(SEXP a, SEXP b) +{ + SOLVE_START; + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + int unpacked = (Matrix_int_fast64_t) m * m <= R_XLEN_T_MAX && + XLENGTH(ax) == (R_xlen_t) m * m; + + char rcl[] = "...Matrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + if (!isNull(b)) { + rcl[1] = 'g'; + rcl[2] = 'e'; + } else { + rcl[1] = 'p'; + rcl[2] = (unpacked) ? 'o' : 'p'; + } + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + + SEXP auplo = GET_SLOT(a, Matrix_uploSym); + char aul = CHAR(STRING_ELT(auplo, 0))[0]; + if (isNull(b) && aul != 'U') { + PROTECT(auplo); + SET_SLOT(r, Matrix_uploSym, auplo); + UNPROTECT(1); /* auplo */ + } + + if (m > 0) { + SEXP rx, aperm = PROTECT(getAttrib(a, Matrix_permSym)); + int info, pivoted = TYPEOF(aperm) == INTSXP && LENGTH(aperm) > 0; + if (isNull(b)) { + rx = duplicate(ax); + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + if (unpacked) { + F77_CALL(zpotri)(&aul, &m, COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_2(zpotri, info, 2, L); + if (pivoted) + zsymperm2(COMPLEX(rx), n, aul, INTEGER(aperm), 1, 1); + } else { + F77_CALL(zpptri)(&aul, &m, COMPLEX(rx), &info FCONE); + ERROR_LAPACK_2(zpptri, info, 2, L); + if (pivoted) { + /* FIXME: zsymperm2 supporting packed matrices */ + double *work; + size_t lwork = (size_t) n * n; + Matrix_Calloc(work, lwork, Rcomplex); + zunpack1 (work, COMPLEX(rx), n, aul, 'N'); + zsymperm2(work, n, aul, INTEGER(aperm), 1, 1); + zpack2 (COMPLEX(rx), work, n, aul, 'N'); + Matrix_Free(work, lwork); + } + } + } else { +#endif + if (unpacked) { + F77_CALL(dpotri)(&aul, &m, REAL(rx), &m, &info FCONE); + ERROR_LAPACK_2(dpotri, info, 2, L); + if (pivoted) + dsymperm2( REAL(rx), n, aul, INTEGER(aperm), 1, 1); + } else { + F77_CALL(dpptri)(&aul, &m, REAL(rx), &info FCONE); + ERROR_LAPACK_2(dpptri, info, 2, L); + if (pivoted) { + /* FIXME: dsymperm2 supporting packed matrices */ + double *work; + size_t lwork = (size_t) n * n; + Matrix_Calloc(work, lwork, double); + dunpack1 (work, REAL(rx), n, aul, 'N'); + dsymperm2(work, n, aul, INTEGER(aperm), 1, 1); + dpack2 ( REAL(rx), work, n, aul, 'N'); + Matrix_Free(work, lwork); + } + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + rx = duplicate(bx); + UNPROTECT(1); /* bx */ + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + if (pivoted) + zrowperm2(COMPLEX(rx), m, n, INTEGER(aperm), 1, 0); + if (unpacked) { + F77_CALL(zpotrs)(&aul, &m, &n, COMPLEX(ax), &m, + COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_1(zpotrs, info); + } else { + F77_CALL(zpptrs)(&aul, &m, &n, COMPLEX(ax), + COMPLEX(rx), &m, &info FCONE); + ERROR_LAPACK_1(zpptrs, info); + } + if (pivoted) + zrowperm2(COMPLEX(rx), m, n, INTEGER(aperm), 1, 1); + } else { +#endif + if (pivoted) + drowperm2( REAL(rx), m, n, INTEGER(aperm), 1, 0); + if (unpacked) { + F77_CALL(dpotrs)(&aul, &m, &n, REAL(ax), &m, + REAL(rx), &m, &info FCONE); + ERROR_LAPACK_1(dpotrs, info); + } else { + F77_CALL(dpptrs)(&aul, &m, &n, REAL(ax), + REAL(rx), &m, &info FCONE); + ERROR_LAPACK_1(dpptrs, info); + } + if (pivoted) + drowperm2( REAL(rx), m, n, INTEGER(aperm), 1, 1); +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(2); /* rx, aperm */ + } + + SOLVE_FINISH; + + UNPROTECT(2); /* r, ax */ + return r; +} + +SEXP dtrMatrix_solve(SEXP a, SEXP b) +{ + SOLVE_START; + + SEXP ax = PROTECT(GET_SLOT(a, Matrix_xSym)); + int unpacked = (Matrix_int_fast64_t) m * m <= R_XLEN_T_MAX && + XLENGTH(ax) == (R_xlen_t) m * m; + + char rcl[] = "...Matrix"; + rcl[0] = (TYPEOF(ax) == CPLXSXP) ? 'z' : 'd'; + if (!isNull(b)) { + rcl[1] = 'g'; + rcl[2] = 'e'; + } else { + rcl[1] = 't'; + rcl[2] = (unpacked) ? 'r' : 'p'; + } + SEXP r = PROTECT(newObject(rcl)); + + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + + SEXP auplo = GET_SLOT(a, Matrix_uploSym); + char aul = CHAR(STRING_ELT(auplo, 0))[0]; + if (isNull(b) && aul != 'U') { + PROTECT(auplo); + SET_SLOT(r, Matrix_uploSym, auplo); + UNPROTECT(1); /* auplo */ + } + + SEXP adiag = GET_SLOT(a, Matrix_diagSym); + char adi = CHAR(STRING_ELT(adiag, 0))[0]; + if (isNull(b) && adi != 'N') { + PROTECT(adiag); + SET_SLOT(r, Matrix_diagSym, adiag); + UNPROTECT(1); /* adiag */ + } + + if (m > 0) { + SEXP rx; + int info; + if (isNull(b)) { + rx = duplicate(ax); + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + if (unpacked) { + F77_CALL(ztrtri)(&aul, &adi, &m, COMPLEX(rx), &m, + &info FCONE FCONE); + ERROR_LAPACK_2(ztrtri, info, 2, A); + } else { + F77_CALL(ztptri)(&aul, &adi, &m, COMPLEX(rx), + &info FCONE FCONE); + ERROR_LAPACK_2(ztptri, info, 2, A); + } + } else { +#endif + if (unpacked) { + F77_CALL(dtrtri)(&aul, &adi, &m, REAL(rx), &m, + &info FCONE FCONE); + ERROR_LAPACK_2(dtrtri, info, 2, A); + } else { + F77_CALL(dtptri)(&aul, &adi, &m, REAL(rx), + &info FCONE FCONE); + ERROR_LAPACK_2(dtptri, info, 2, A); + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + rx = duplicate(bx); + UNPROTECT(1); /* bx */ + PROTECT(rx); +#ifdef MATRIX_ENABLE_ZMATRIX + if (TYPEOF(ax) == CPLXSXP) { + if (unpacked) { + F77_CALL(ztrtrs)(&aul, "N", &adi, &m, &n, COMPLEX(ax), &m, + COMPLEX(rx), &m, &info FCONE FCONE FCONE); + ERROR_LAPACK_1(ztrtrs, info); + } else { + F77_CALL(ztptrs)(&aul, "N", &adi, &m, &n, COMPLEX(ax), + COMPLEX(rx), &m, &info FCONE FCONE FCONE); + ERROR_LAPACK_1(ztptrs, info); + } + } else { +#endif + if (unpacked) { + F77_CALL(dtrtrs)(&aul, "N", &adi, &m, &n, REAL(ax), &m, + REAL(rx), &m, &info FCONE FCONE FCONE); + ERROR_LAPACK_1(dtrtrs, info); + } else { + // https://bugs.r-project.org/show_bug.cgi?id=18534 + F77_CALL(dtptrs)(&aul, "N", &adi, &m, &n, REAL(ax), + REAL(rx), &m, &info +# ifdef usePR18534fix + FCONE FCONE FCONE); +# else + FCONE FCONE); +# endif + ERROR_LAPACK_1(dtptrs, info); + } +#ifdef MATRIX_ENABLE_ZMATRIX + } +#endif + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(1); /* rx */ + } + + SOLVE_FINISH; + + UNPROTECT(2); /* r, ax */ + return r; +} + +#define IF_COMPLEX(_IF_, _ELSE_) \ + ((MCS_XTYPE_GET() == MCS_COMPLEX) ? (_IF_) : (_ELSE_)) + +SEXP sparseLU_solve(SEXP a, SEXP b, SEXP sparse) +{ + +#define ERROR_SOLVE_OOM(_ACL_, _BCL_) \ + error(_("%s(<%s>, <%s>) failed: out of memory"), "solve", _ACL_, _BCL_) + + SOLVE_START; + + SEXP r, + aL = PROTECT(GET_SLOT(a, Matrix_LSym)), + aU = PROTECT(GET_SLOT(a, Matrix_USym)), + ap = PROTECT(GET_SLOT(a, Matrix_pSym)), + aq = PROTECT(GET_SLOT(a, Matrix_qSym)); + int i, j, + *pap = (LENGTH(ap)) ? INTEGER(ap) : NULL, + *paq = (LENGTH(aq)) ? INTEGER(aq) : NULL; + Matrix_cs *L = M2CXS(aL, 1), *U = M2CXS(aU, 1); + MCS_XTYPE_SET(L->xtype); + if (!asLogical(sparse)) { + char rcl[] = ".geMatrix"; + rcl[0] = IF_COMPLEX('z', 'd'); + PROTECT(r = newObject(rcl)); + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + R_xlen_t mn = (R_xlen_t) m * n; + SEXP rx = PROTECT(allocVector(IF_COMPLEX(CPLXSXP, REALSXP), mn)); + if (isNull(b)) { + +#define SOLVE_DENSE_1(_CTYPE_, _PTR_, _ONE_) \ + do { \ + _CTYPE_ *prx = _PTR_(rx), \ + *work = (_CTYPE_ *) R_alloc((size_t) m, sizeof(_CTYPE_)); \ + Matrix_memset(prx, 0, mn, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + prx[j] = _ONE_; \ + Matrix_cs_pvec(pap, prx, work, m); \ + Matrix_cs_lsolve(L, work); \ + Matrix_cs_usolve(U, work); \ + Matrix_cs_ipvec(paq, work, prx, m); \ + prx += m; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_DENSE_1(Rcomplex, COMPLEX, Matrix_zone); + else +#endif + SOLVE_DENSE_1(double, REAL, 1.0); + +#undef SOLVE_DENSE_1 + + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + +#define SOLVE_DENSE_2(_CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *prx = _PTR_(rx), *pbx = _PTR_(bx), \ + *work = (_CTYPE_ *) R_alloc((size_t) m, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + Matrix_cs_pvec(pap, pbx, work, m); \ + Matrix_cs_lsolve(L, work); \ + Matrix_cs_usolve(U, work); \ + Matrix_cs_ipvec(paq, work, prx, m); \ + prx += m; \ + pbx += m; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_DENSE_2(Rcomplex, COMPLEX); + else +#endif + SOLVE_DENSE_2(double, REAL); + +#undef SOLVE_DENSE_2 + + UNPROTECT(1); /* bx */ + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(1); /* rx */ + } else { + Matrix_cs *B = NULL, *X = NULL; + if (isNull(b)) { + B = Matrix_cs_speye(m, m, 1, 0); + if (B && pap) + for (i = 0; i < m; ++i) + B->i[pap[i]] = i; + } else { + B = M2CXS(b, 1); + if (B && pap) { + int *papinv = Matrix_cs_pinv(pap, m); + if (!papinv) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + B = Matrix_cs_permute(B, papinv, NULL, 1); + papinv = Matrix_cs_free(papinv); + } + } + if (!B) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + int Bfr = isNull(b) || pap; + + int k, top, nz, nzmax, + *iwork = (int *) R_alloc((size_t) 2 * m, sizeof(int)); + +#define SOLVE_SPARSE_TRIANGULAR(_CTYPE_, _A_, _ALO_, _BFR_, _ACL_, _BCL_) \ + do { \ + X = Matrix_cs_spalloc(m, n, B->nzmax, 1, 0); \ + if (!X) { \ + if (_BFR_) \ + B = Matrix_cs_spfree(B); \ + ERROR_SOLVE_OOM(_ACL_, _BCL_); \ + } \ + _CTYPE_ *X__x = (_CTYPE_ *) X->x; \ + X->p[0] = nz = 0; \ + nzmax = X->nzmax; \ + for (j = 0, k = 0; j < n; ++j) { \ + top = Matrix_cs_spsolve(_A_, B, j, iwork, work, NULL, _ALO_); \ + if (m - top > INT_MAX - nz) { \ + if (_BFR_) \ + B = Matrix_cs_spfree(B); \ + X = Matrix_cs_spfree(X); \ + error(_("attempt to construct %s with more than %s nonzero elements"), \ + "sparseMatrix", "2^31-1"); \ + } \ + nz += m - top; \ + if (nz > nzmax) { \ + nzmax = (nz <= INT_MAX / 2) ? 2 * nz : INT_MAX; \ + if (!Matrix_cs_sprealloc(X, nzmax)) { \ + if (_BFR_) \ + B = Matrix_cs_spfree(B); \ + X = Matrix_cs_spfree(X); \ + ERROR_SOLVE_OOM(_ACL_, _BCL_); \ + } \ + X__x = (_CTYPE_ *) X->x; \ + } \ + X->p[j + 1] = nz; \ + if (_ALO_) { \ + for (i = top; i < m; ++i) { \ + X->i[k] = iwork[i] ; \ + X__x[k] = work[iwork[i]]; \ + ++k; \ + } \ + } else { \ + for (i = m - 1; i >= top; --i) { \ + X->i[k] = iwork[i] ; \ + X__x[k] = work[iwork[i]]; \ + ++k; \ + } \ + } \ + } \ + if (_BFR_) \ + B = Matrix_cs_spfree(B); \ + B = X; \ + } while (0) + +#define SOLVE_SPARSE(_CTYPE_) \ + do { \ + _CTYPE_ *work = (_CTYPE_ *) R_alloc((size_t) m, sizeof(_CTYPE_)); \ + SOLVE_SPARSE_TRIANGULAR(_CTYPE_, L, 1, Bfr, \ + "sparseLU", ".gCMatrix"); \ + SOLVE_SPARSE_TRIANGULAR(_CTYPE_, U, 0, 1, \ + "sparseLU", ".gCMatrix"); \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_SPARSE(Rcomplex); + else +#endif + SOLVE_SPARSE(double); + +#undef SOLVE_SPARSE + + if (paq) { + X = Matrix_cs_permute(B, paq, NULL, 1); + B = Matrix_cs_spfree(B); + if (!X) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + B = X; + } + + /* Drop zeros from B and sort it : */ + Matrix_cs_dropzeros(B); + X = Matrix_cs_transpose(B, 1); + B = Matrix_cs_spfree(B); + if (!X) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + B = Matrix_cs_transpose(X, 1); + X = Matrix_cs_spfree(X); + if (!B) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + + PROTECT(r = CXS2M(B, 1, 'g')); + B = Matrix_cs_spfree(B); + } + + SOLVE_FINISH; + + UNPROTECT(5); /* r, aq, ap, aU, aL */ + return r; +} + +static +int strmatch(const char *x, const char **valid) +{ + int i = 0; + while (valid[i][0] != '\0') { + if (strcmp(x, valid[i]) == 0) + return i; + ++i; + } + return -1; +} + +SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP sparse, SEXP system) +{ + static const char *valid[] = { + "A", "LDLt", "LD", "DLt", "L", "Lt", "D", "P", "Pt", "" }; + int ivalid = -1; + if (TYPEOF(system) != STRSXP || LENGTH(system) < 1 || + (system = STRING_ELT(system, 0)) == NA_STRING || + (ivalid = strmatch(CHAR(system), valid)) < 0) + error(_("invalid '%s' to '%s'"), "system", __func__); + + SOLVE_START; + + SEXP r; + int j; + cholmod_factor *L = M2CHF(a, 1); + if (!asLogical(sparse)) { + cholmod_dense *B = NULL, *X = NULL; + if (isNull(b)) { + B = cholmod_allocate_dense(m, n, m, L->xtype, &c); + if (!B) + ERROR_SOLVE_OOM("CHMfactor", ".geMatrix"); + R_xlen_t m1a = (R_xlen_t) m + 1; + +#define EYE(_CTYPE_, _ONE_) \ + do { \ + _CTYPE_ *B__x = (_CTYPE_ *) B->x; \ + Matrix_memset(B__x, 0, (R_xlen_t) m * n, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + *B__x = _ONE_; \ + B__x += m1a; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (L->xtype == CHOLMOD_COMPLEX) + EYE(Rcomplex, Matrix_zone); + else +#endif + EYE(double, 1.0); + +#undef EYE + + X = cholmod_solve(ivalid, L, B, &c); + cholmod_free_dense(&B, &c); + if (!X) + ERROR_SOLVE_OOM("CHMfactor", ".geMatrix"); + PROTECT(r = CHD2M(X, 0, + (ivalid < 2) ? 'p' : ((ivalid < 7) ? 't' : 'g'))); + } else { + B = M2CHD(b, 0); + X = cholmod_solve(ivalid, L, B, &c); + if (!X) + ERROR_SOLVE_OOM("CHMfactor", ".geMatrix"); + PROTECT(r = CHD2M(X, 0, 'g')); + } + cholmod_free_dense(&X, &c); + } else { + cholmod_sparse *B = NULL, *X = NULL; + if (isNull(b)) { + B = cholmod_speye(m, n, L->xtype, &c); + if (!B) + ERROR_SOLVE_OOM("CHMfactor", ".gCMatrix"); + X = cholmod_spsolve(ivalid, L, B, &c); + cholmod_free_sparse(&B, &c); + if (X && ivalid < 7) { + X->stype = (ivalid == 2 || ivalid == 4) ? -1 : 1; + cholmod_sort(X, &c); + } + if (!X) + ERROR_SOLVE_OOM("CHMfactor", ".gCMatrix"); + PROTECT(r = CHS2M(X, 1, + (ivalid < 2) ? 's' : ((ivalid < 7) ? 't' : 'g'))); + } else { + B = M2CHS(b, 1); + X = cholmod_spsolve(ivalid, L, B, &c); + if (!X) + ERROR_SOLVE_OOM("CHMfactor", ".gCMatrix"); + PROTECT(r = CHS2M(X, 1, 'g')); + } + cholmod_free_sparse(&X, &c); + } + if (isNull(b) && (ivalid == 2 || ivalid == 4)) { + SEXP uplo = PROTECT(mkString("L")); + SET_SLOT(r, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + + SOLVE_FINISH; + + UNPROTECT(1); /* r */ + return r; +} + +SEXP dtCMatrix_solve(SEXP a, SEXP b, SEXP sparse) +{ + SOLVE_START; + + SEXP r, auplo = PROTECT(GET_SLOT(a, Matrix_uploSym)); + char aul = *CHAR(STRING_ELT(auplo, 0)); + int i, j; + Matrix_cs *A = M2CXS(a, 1); + MCS_XTYPE_SET(A->xtype); + if (!asLogical(sparse)) { + char rcl[] = "...Matrix"; + rcl[0] = IF_COMPLEX('z', 'd'); + rcl[1] = (isNull(b)) ? 't' : 'g'; + rcl[2] = (isNull(b)) ? 'r' : 'e'; + PROTECT(r = newObject(rcl)); + SEXP rdim = GET_SLOT(r, Matrix_DimSym); + int *prdim = INTEGER(rdim); + prdim[0] = m; + prdim[1] = n; + R_xlen_t mn = (R_xlen_t) m * n; + SEXP rx = PROTECT(allocVector(IF_COMPLEX(CPLXSXP, REALSXP), mn)); + if (isNull(b)) { + +#define SOLVE_DENSE_1(_CTYPE_, _PTR_, _ONE_) \ + do { \ + _CTYPE_ *prx = _PTR_(rx); \ + Matrix_memset(prx, 0, mn, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + prx[j] = _ONE_; \ + if (aul == 'U') \ + Matrix_cs_usolve(A, prx); \ + else \ + Matrix_cs_lsolve(A, prx); \ + prx += m; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_DENSE_1(Rcomplex, COMPLEX, Matrix_zone); + else +#endif + SOLVE_DENSE_1(double, REAL, 1.0); + +#undef SOLVE_DENSE_1 + + } else { + SEXP bx = PROTECT(GET_SLOT(b, Matrix_xSym)); + +#define SOLVE_DENSE_2(_CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *prx = _PTR_(rx), *pbx = _PTR_(bx); \ + Matrix_memcpy(prx, pbx, mn, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + if (aul == 'U') \ + Matrix_cs_usolve(A, prx); \ + else \ + Matrix_cs_lsolve(A, prx); \ + prx += m; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_DENSE_2(Rcomplex, COMPLEX); + else +#endif + SOLVE_DENSE_2(double, REAL); + +#undef SOLVE_DENSE_2 + + UNPROTECT(1); /* bx */ + } + SET_SLOT(r, Matrix_xSym, rx); + UNPROTECT(1); /* rx */ + } else { + Matrix_cs *B = NULL, *X = NULL; + if (isNull(b)) + B = Matrix_cs_speye(m, m, 1, 0); + else + B = M2CXS(b, 1); + if (!B) + ERROR_SOLVE_OOM("sparseLU", ".gCMatrix"); + + int k, top, nz, nzmax, + *iwork = (int *) R_alloc((size_t) 2 * m, sizeof(int)); + +#define SOLVE_SPARSE(_CTYPE_) \ + do { \ + _CTYPE_ *work = (_CTYPE_ *) R_alloc((size_t) m, sizeof(_CTYPE_)); \ + SOLVE_SPARSE_TRIANGULAR(_CTYPE_, A, aul != 'U', isNull(b), \ + ".tCMatrix", ".gCMatrix"); \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + SOLVE_SPARSE(Rcomplex); + else +#endif + SOLVE_SPARSE(double); + +#undef SOLVE_SPARSE + + /* Drop zeros from B and sort it : */ + Matrix_cs_dropzeros(B); + X = Matrix_cs_transpose(B, 1); + B = Matrix_cs_spfree(B); + if (!X) + ERROR_SOLVE_OOM(".tCMatrix", ".gCMatrix"); + B = Matrix_cs_transpose(X, 1); + X = Matrix_cs_spfree(X); + if (!B) + ERROR_SOLVE_OOM(".tCMatrix", ".gCMatrix"); + + PROTECT(r = CXS2M(B, 1, (isNull(b)) ? 't' : 'g')); + B = Matrix_cs_spfree(B); + } + if (isNull(b)) + SET_SLOT(r, Matrix_uploSym, auplo); + + SOLVE_FINISH; + + UNPROTECT(2); /* r, auplo */ + return r; +} + +SEXP sparseQR_matmult(SEXP qr, SEXP y, SEXP op, SEXP complete, SEXP yxjj) +{ + SEXP V = PROTECT(GET_SLOT(qr, Matrix_VSym)); + Matrix_cs *V_ = M2CXS(V, 1); + MCS_XTYPE_SET(V_->xtype); + + SEXP beta = PROTECT(GET_SLOT(qr, Matrix_betaSym)); + double *pbeta = REAL(beta); + + SEXP p = PROTECT(GET_SLOT(qr, Matrix_pSym)); + int *pp = (LENGTH(p) > 0) ? INTEGER(p) : NULL; + + int m = V_->m, r = V_->n, n, i, j, op_ = asInteger(op), nprotect = 5; + + SEXP yx; + if (isNull(y)) { + n = (asLogical(complete)) ? m : r; + + R_xlen_t mn = (R_xlen_t) m * n, m1a = (R_xlen_t) m + 1; + PROTECT(yx = allocVector(IF_COMPLEX(CPLXSXP, REALSXP), mn)); + +#define EYE(_CTYPE_, _PTR_, _ONE_) \ + do { \ + _CTYPE_ *pyx = _PTR_(yx); \ + Matrix_memset(pyx, 0, mn, sizeof(_CTYPE_)); \ + if (isNull(yxjj)) { \ + for (j = 0; j < n; ++j) { \ + *pyx = _ONE_; \ + pyx += m1a; \ + } \ + } else if (TYPEOF(yxjj) == TYPEOF(yx) && XLENGTH(yxjj) >= n) { \ + _CTYPE_ *pyxjj = _PTR_(yxjj); \ + for (j = 0; j < n; ++j) { \ + *pyx = *pyxjj; \ + pyx += m1a; \ + pyxjj += 1; \ + } \ + } else \ + error(_("invalid '%s' to '%s'"), "yxjj", __func__); \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + EYE(Rcomplex, COMPLEX, Matrix_zone); + else +#endif + EYE(double, REAL, 1.0); + +#undef EYE + + } else { + SEXP ydim = GET_SLOT(y, Matrix_DimSym); + int *pydim = INTEGER(ydim); + if (pydim[0] != m) + error(_("dimensions of '%s' and '%s' are inconsistent"), + "qr", "y"); + n = pydim[1]; + + PROTECT(yx = GET_SLOT(y, Matrix_xSym)); + } + + char acl[] = ".geMatrix"; + acl[0] = IF_COMPLEX('z', 'd'); + SEXP a = PROTECT(newObject(acl)); + + SEXP adim = GET_SLOT(a, Matrix_DimSym); + int *padim = INTEGER(adim); + padim[0] = (op_ != 0) ? m : r; + padim[1] = n; + + SEXP ax; + if (isNull(y) && padim[0] == m) + ax = yx; + else { + R_xlen_t mn = (R_xlen_t) padim[0] * padim[1]; + PROTECT(ax = allocVector(IF_COMPLEX(CPLXSXP, REALSXP), mn)); + ++nprotect; + } + +#define MATMULT(_CTYPE_, _PTR_) \ + do { \ + _CTYPE_ *pyx = _PTR_(yx), *pax = _PTR_(ax), *work = NULL; \ + if (op_ < 5) \ + work = (_CTYPE_ *) R_alloc((size_t) m, sizeof(_CTYPE_)); \ + switch (op_) { \ + case 0: /* qr.coef : A = P2 R1^{-1} Q1' P1 y */ \ + { \ + SEXP R = PROTECT(GET_SLOT(qr, Matrix_RSym)), \ + q = PROTECT(GET_SLOT(qr, Matrix_qSym)); \ + Matrix_cs *R_ = M2CXS(R, 1); \ + int *pq = (LENGTH(q) > 0) ? INTEGER(q) : NULL; \ + for (j = 0; j < n; ++j) { \ + Matrix_cs_pvec(pp, pyx, work, m); \ + for (i = 0; i < r; ++i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + Matrix_cs_usolve(R_, work); \ + Matrix_cs_ipvec(pq, work, pax, r); \ + pyx += m; \ + pax += r; \ + } \ + UNPROTECT(2); /* q, R */ \ + break; \ + } \ + case 1: /* qr.fitted : A = P1' Q1 Q1' P1 y */ \ + for (j = 0; j < n; ++j) { \ + Matrix_cs_pvec(pp, pyx, work, m); \ + for (i = 0; i < r; ++i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + if (r < m) \ + Matrix_memset(work + r, 0, m - r, sizeof(_CTYPE_)); \ + for (i = r - 1; i >= 0; --i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + Matrix_cs_ipvec(pp, work, pax, m); \ + pyx += m; \ + pax += m; \ + } \ + break; \ + case 2: /* qr.resid : A = P1' Q2 Q2' P1 y */ \ + for (j = 0; j < n; ++j) { \ + Matrix_cs_pvec(pp, pyx, work, m); \ + for (i = 0; i < r; ++i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + if (r > 0) \ + Matrix_memset(work, 0, r, sizeof(_CTYPE_)); \ + for (i = r - 1; i >= 0; --i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + Matrix_cs_ipvec(pp, work, pax, m); \ + pyx += m; \ + pax += m; \ + } \ + break; \ + case 3: /* qr.qty {w/ perm.} : A = Q' P1 y */ \ + for (j = 0; j < n; ++j) { \ + Matrix_cs_pvec(pp, pyx, work, m); \ + Matrix_memcpy(pax, work, m, sizeof(_CTYPE_)); \ + for (i = 0; i < r; ++i) \ + Matrix_cs_happly(V_, i, pbeta[i], pax); \ + pyx += m; \ + pax += m; \ + } \ + break; \ + case 4: /* qr.qy {w/ perm.} : A = P1' Q y */ \ + for (j = 0; j < n; ++j) { \ + Matrix_memcpy(work, pyx, m, sizeof(_CTYPE_)); \ + for (i = r - 1; i >= 0; --i) \ + Matrix_cs_happly(V_, i, pbeta[i], work); \ + Matrix_cs_ipvec(pp, work, pax, m); \ + pyx += m; \ + pax += m; \ + } \ + break; \ + case 5: /* qr.qty {w/o perm.} : A = Q' y */ \ + if (ax != yx) \ + Matrix_memcpy(pax, pyx, (R_xlen_t) m * n, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + for (i = 0; i < r; ++i) \ + Matrix_cs_happly(V_, i, pbeta[i], pax); \ + pax += m; \ + } \ + break; \ + case 6: /* qr.qy {w/o perm.} : A = Q y */ \ + if (ax != yx) \ + Matrix_memcpy(pax, pyx, (R_xlen_t) m * n, sizeof(_CTYPE_)); \ + for (j = 0; j < n; ++j) { \ + for (i = r - 1; i >= 0; --i) \ + Matrix_cs_happly(V_, i, pbeta[i], pax); \ + pax += m; \ + } \ + break; \ + default: \ + error(_("invalid '%s' to '%s'"), "op", __func__); \ + break; \ + } \ + } while (0) + +#ifdef MATRIX_ENABLE_ZMATRIX + if (MCS_XTYPE_GET() == MCS_COMPLEX) + MATMULT(Rcomplex, COMPLEX); + else +#endif + MATMULT(double, REAL); + SET_SLOT(a, Matrix_xSym, ax); + + UNPROTECT(nprotect); /* ax, a, yx, p, beta, V */ + return a; +} diff -Nru rmatrix-1.6-1.1/src/solve.h rmatrix-1.6-5/src/solve.h --- rmatrix-1.6-1.1/src/solve.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/solve.h 2023-09-26 06:40:29.000000000 +0000 @@ -0,0 +1,20 @@ +#ifndef MATRIX_SOLVE_H +#define MATRIX_SOLVE_H + +#include + +SEXP denseLU_solve(SEXP, SEXP); +SEXP BunchKaufman_solve(SEXP, SEXP); +SEXP Cholesky_solve(SEXP, SEXP); +SEXP dtrMatrix_solve(SEXP, SEXP); +SEXP sparseLU_solve(SEXP, SEXP, SEXP); +#if 0 +/* MJ: we use 'sparseQR_matmult' instead */ +SEXP sparseQR_solve(SEXP, SEXP, SEXP); +#endif +SEXP CHMfactor_solve(SEXP, SEXP, SEXP, SEXP); +SEXP dtCMatrix_solve(SEXP, SEXP, SEXP); + +SEXP sparseQR_matmult(SEXP, SEXP, SEXP, SEXP, SEXP); + +#endif /* MATRIX_SOLVE_H */ diff -Nru rmatrix-1.6-1.1/src/sparse.c rmatrix-1.6-5/src/sparse.c --- rmatrix-1.6-1.1/src/sparse.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/sparse.c 2023-12-11 01:57:56.000000000 +0000 @@ -1,4 +1,5 @@ #include /* fabs, hypot */ +#include "Mdefines.h" #include "sparse.h" SEXP sparse_drop0(SEXP from, const char *class, double tol) @@ -47,11 +48,11 @@ nnz0 = pp0[n], nnz1 = 0; #undef DROP0_LOOP1 -#define DROP0_LOOP1(_CTYPE_, _PTR_, _NZ_) \ +#define DROP0_LOOP1(_CTYPE_, _PTR_, _ISNZ_) \ do { \ _CTYPE_ *px0 = _PTR_(x0); \ for (k = 0; k < nnz0; ++k) { \ - if (_NZ_(*px0)) \ + if (_ISNZ_(*px0)) \ ++nnz1; \ ++px0; \ } \ @@ -62,7 +63,7 @@ UNPROTECT(2); /* p0, x0 */ return from; } - PROTECT(to = NEW_OBJECT_OF_CLASS(class)); + PROTECT(to = newObject(class)); SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, i0 = PROTECT(GET_SLOT(from, iSym)), @@ -77,14 +78,14 @@ SET_SLOT(to, Matrix_xSym, x1); #undef DROP0_LOOP2 -#define DROP0_LOOP2(_CTYPE_, _PTR_, _NZ_) \ +#define DROP0_LOOP2(_CTYPE_, _PTR_, _ISNZ_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (j = 0, k = 0; j < n; ++j) { \ pp1[j] = pp1[j - 1]; \ kend = pp0[j]; \ while (k < kend) { \ - if (_NZ_(*px0)) { \ + if (_ISNZ_(*px0)) { \ ++pp1[j]; \ *(pi1++) = *pi0; \ *(px1++) = *px0; \ @@ -106,7 +107,7 @@ UNPROTECT(1); /* x0 */ return from; } - PROTECT(to = NEW_OBJECT_OF_CLASS(class)); + PROTECT(to = newObject(class)); SEXP i0 = PROTECT(GET_SLOT(from, Matrix_iSym)), j0 = PROTECT(GET_SLOT(from, Matrix_jSym)), @@ -120,11 +121,11 @@ SET_SLOT(to, Matrix_xSym, x1); #undef DROP0_LOOP2 -#define DROP0_LOOP2(_CTYPE_, _PTR_, _NZ_) \ +#define DROP0_LOOP2(_CTYPE_, _PTR_, _ISNZ_) \ do { \ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (k = 0; k < nnz0; ++k) { \ - if (_NZ_(*px0)) { \ + if (_ISNZ_(*px0)) { \ *(pi1++) = *pi0; \ *(pj1++) = *pj0; \ *(px1++) = *px0; \ @@ -164,9 +165,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } @@ -197,6 +198,86 @@ return sparse_drop0(from, valid[ivalid], tol_); } +SEXP sparse_diag_U2N(SEXP from, const char *class) +{ + if (class[1] != 't') + return from; + + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + char di = *CHAR(STRING_ELT(diag, 0)); + UNPROTECT(1); /* diag */ + if (di == 'N') + return from; + + SEXP val = PROTECT(ScalarLogical(1)); + from = R_sparse_diag_set(from, val); + UNPROTECT(1); /* val */ + + return from; +} + +/* diagU2N(<[CRT]sparseMatrix>), parallel to R-level ..diagU2N(), + though that is more general, working for _all_ Matrix +*/ +SEXP R_sparse_diag_U2N(SEXP from) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + return sparse_diag_U2N(from, valid[ivalid]); +} + +SEXP sparse_diag_N2U(SEXP from, const char *class) +{ + if (class[1] != 't') + return from; + + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + char di = *CHAR(STRING_ELT(diag, 0)); + UNPROTECT(1); /* diag */ + if (di != 'N') + return from; + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int n = INTEGER(dim)[0]; + UNPROTECT(1); /* dim */ + + if (n == 0) + PROTECT(from = duplicate(from)); + else { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + char ul = *CHAR(STRING_ELT(uplo, 0)); + UNPROTECT(1); /* uplo */ + if (ul == 'U') + PROTECT(from = sparse_band(from, class, 1, n - 1)); + else + PROTECT(from = sparse_band(from, class, 1 - n, -1)); + } + + PROTECT(diag = mkString("U")); + SET_SLOT(from, Matrix_diagSym, diag); + UNPROTECT(2); /* diag, from */ + + return from; +} + +/* diagN2U(<[CRT]sparseMatrix>), parallel to R-level ..diagN2U(), + though that is more general, working for _all_ Matrix +*/ +SEXP R_sparse_diag_N2U(SEXP from) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + + return sparse_diag_N2U(from, valid[ivalid]); +} + SEXP sparse_band(SEXP from, const char *class, int a, int b) { SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); @@ -204,22 +285,23 @@ UNPROTECT(1); /* dim */ /* Need tri[ul](<0-by-0>) and tri[ul](<1-by-1>) to be triangularMatrix */ - if (a <= 1-m && b >= n-1 && (class[1] == 't' || m != n || m > 1 || n > 1)) + if (a <= 1 - m && b >= n - 1 && + (class[1] == 't' || m != n || m > 1 || n > 1)) return from; int ge = 0, sy = 0, tr = 0; ge = m != n || !((tr = a >= 0 || b <= 0 || class[1] == 't') || (sy = a == -b && class[1] == 's')); - char ulf = 'U', ult = 'U', di = 'N'; + char ul0 = 'U', ul1 = 'U', di = 'N'; if (class[1] != 'g') { SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - ulf = *CHAR(STRING_ELT(uplo, 0)); + ul0 = *CHAR(STRING_ELT(uplo, 0)); UNPROTECT(1); /* uplo */ if (class[1] == 't') { /* Be fast if band contains entire triangle */ - if ((ulf == 'U') ? (a <= 0 && b >= n-1) : (b >= 0 && a <= 1-m)) + if ((ul0 == 'U') ? (a <= 0 && b >= n - 1) : (b >= 0 && a <= 1 - m)) return from; else if (a <= 0 && b >= 0) { SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); @@ -235,7 +317,7 @@ int r; r = m; m = n; n = r; r = a; a = -b; b = -r; - ulf = (ulf == 'U') ? 'L' : 'U'; + ul0 = (ul0 == 'U') ? 'L' : 'U'; from = sparse_transpose(from, class, 1); } PROTECT(from); @@ -244,7 +326,7 @@ cl[0] = class[0]; cl[1] = (ge) ? 'g' : ((tr) ? 't' : 's'); cl[2] = (class[2] == 'R') ? 'C' : class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); dim = GET_SLOT(to, Matrix_DimSym); pdim = INTEGER(dim); @@ -259,8 +341,8 @@ UNPROTECT(1); /* dimnames */ if (!ge) { - ult = (tr && class[1] != 't') ? ((a >= 0) ? 'U' : 'L') : ulf; - if (ult != 'U') { + ul1 = (tr && class[1] != 't') ? ((a >= 0) ? 'U' : 'L') : ul0; + if (ul1 != 'U') { SEXP uplo = PROTECT(mkString("L")); SET_SLOT(to, Matrix_uploSym, uplo); UNPROTECT(1); /* uplo */ @@ -502,18 +584,19 @@ UNPROTECT(1); int a, b; - if (k1 == R_NilValue) - a = (m > 0) ? 1-m : 0; + if (k1 == R_NilValue) // tril() + a = -m ; // was (m > 0) ? 1 - m : 0; else if ((a = asInteger(k1)) == NA_INTEGER || a < -m || a > n) - error(_("'%s' must be an integer from %s to %s"), - "k1", "-Dim[1]", "Dim[2]"); - if (k2 == R_NilValue) - b = (n > 0) ? n-1 : 0; + error(_("'%s' (%d) must be an integer from %s (%d) to %s (%d)"), + "k1", a, "-Dim[1]", -m, "Dim[2]", n); + if (k2 == R_NilValue) // triu() + b = n; // was (n > 0) ? n - 1 : 0; else if ((b = asInteger(k2)) == NA_INTEGER || b < -m || b > n) - error(_("'%s' must be an integer from %s to %s"), - "k2", "-Dim[1]", "Dim[2]"); + error(_("'%s' (%d) must be an integer from %s (%d) to %s (%d)"), + "k2", b, "-Dim[1]", -m, "Dim[2]", n); else if (b < a) - error(_("'%s' must be less than or equal to '%s'"), "k1", "k2"); + error(_("'%s' (%d) must be less than or equal to '%s' (%d)"), + "k1", a, "k2", b); return sparse_band(from, valid[ivalid], a, b); } @@ -537,23 +620,23 @@ } } - SEXP res = PROTECT(allocVector(kind2type(class[0]), r)); + SEXP res = PROTECT(allocVector(kindToType(class[0]), r)); -#define SDG_CASES \ +#define DG_CASES \ do { \ switch (class[0]) { \ case 'n': \ case 'l': \ - SDG_LOOP(int, LOGICAL, SHOW, FIRSTOF, INCREMENT_LOGICAL, 0, 1); \ + DG_LOOP(int, LOGICAL, SHOW, FIRSTOF, INCREMENT_LOGICAL, 0, 1); \ break; \ case 'i': \ - SDG_LOOP(int, INTEGER, SHOW, FIRSTOF, INCREMENT_INTEGER, 0, 1); \ + DG_LOOP(int, INTEGER, SHOW, FIRSTOF, INCREMENT_INTEGER, 0, 1); \ break; \ case 'd': \ - SDG_LOOP(double, REAL, SHOW, FIRSTOF, INCREMENT_REAL, 0.0, 1.0); \ + DG_LOOP(double, REAL, SHOW, FIRSTOF, INCREMENT_REAL, 0.0, 1.0); \ break; \ case 'z': \ - SDG_LOOP(Rcomplex, COMPLEX, SHOW, FIRSTOF, INCREMENT_COMPLEX, Matrix_zzero, Matrix_zone); \ + DG_LOOP(Rcomplex, COMPLEX, SHOW, FIRSTOF, INCREMENT_COMPLEX, Matrix_zzero, Matrix_zone); \ break; \ default: \ break; \ @@ -564,103 +647,103 @@ int j; -#undef SDG_LOOP -#define SDG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ +#undef DG_LOOP +#define DG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ do { \ _CTYPE_ *pres = _PTR_(res); \ for (j = 0; j < r; ++j) \ *(pres++) = _ONE_; \ } while (0) - SDG_CASES; + DG_CASES; } else if (class[2] != 'T') { SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, - p = PROTECT(GET_SLOT(obj, Matrix_pSym)), - i = PROTECT(GET_SLOT(obj, iSym)); - int j, k, kend, *pp = INTEGER(p), *pi = INTEGER(i); - pp++; + p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i0 = PROTECT(GET_SLOT(obj, iSym)); + int j, k, kend, *pp0 = INTEGER(p0), *pi0 = INTEGER(i0); + pp0++; -#undef SDG_LOOP -#define SDG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ +#undef DG_LOOP +#define DG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ do { \ - _MASK_(_CTYPE_ *px = _PTR_(x)); \ + _MASK_(_CTYPE_ *px0 = _PTR_(x0)); \ _CTYPE_ *pres = _PTR_(res); \ if (class[1] == 'g') { \ for (j = 0, k = 0; j < r; ++j) { \ pres[j] = _ZERO_; \ - kend = pp[j]; \ + kend = pp0[j]; \ while (k < kend) { \ - if (pi[k] != j) \ + if (pi0[k] != j) \ ++k; \ else { \ - pres[j] = _REPLACE_(px[k], 1); \ + pres[j] = _REPLACE_(px0[k], 1); \ k = kend; \ } \ } \ } \ } else if ((class[2] == 'C') == (ul != 'U')) { \ for (j = 0, k = 0; j < r; ++j) { \ - kend = pp[j]; \ - pres[j] = (k < kend && pi[k] == j) \ - ? _REPLACE_(px[k], 1) : _ZERO_; \ + kend = pp0[j]; \ + pres[j] = (k < kend && pi0[k] == j) \ + ? _REPLACE_(px0[k], 1) : _ZERO_; \ k = kend; \ } \ } else { \ for (j = 0, k = 0; j < r; ++j) { \ - kend = pp[j]; \ - pres[j] = (k < kend && pi[kend - 1] == j) \ - ? _REPLACE_(px[kend - 1], 1) : _ZERO_; \ + kend = pp0[j]; \ + pres[j] = (k < kend && pi0[kend - 1] == j) \ + ? _REPLACE_(px0[kend - 1], 1) : _ZERO_; \ k = kend; \ } \ } \ } while (0) if (class[0] == 'n') { - SDG_LOOP(int, LOGICAL, HIDE, SECONDOF, , 0, 1); + DG_LOOP(int, LOGICAL, HIDE, SECONDOF, , 0, 1); } else { - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - SDG_CASES; - UNPROTECT(1); /* x */ + SEXP x0 = PROTECT(GET_SLOT(obj, Matrix_xSym)); + DG_CASES; + UNPROTECT(1); /* x0 */ } - UNPROTECT(2); /* i, p */ + UNPROTECT(2); /* i0, p0 */ } else { - SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - j = PROTECT(GET_SLOT(obj, Matrix_jSym)); - int *pi = INTEGER(i), *pj = INTEGER(j); - R_xlen_t k, nnz = XLENGTH(i); + SEXP i0 = PROTECT(GET_SLOT(obj, Matrix_iSym)), + j0 = PROTECT(GET_SLOT(obj, Matrix_jSym)); + int *pi0 = INTEGER(i0), *pj0 = INTEGER(j0); + R_xlen_t k, nnz0 = XLENGTH(i0); -#undef SDG_LOOP -#define SDG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ +#undef DG_LOOP +#define DG_LOOP(_CTYPE_, _PTR_, _MASK_, _REPLACE_, _INCREMENT_, _ZERO_, _ONE_) \ do { \ - _MASK_(_CTYPE_ *px = _PTR_(x)); \ + _MASK_(_CTYPE_ *px0 = _PTR_(x0)); \ _CTYPE_ *pres = _PTR_(res); \ Matrix_memset(pres, 0, r, sizeof(_CTYPE_)); \ - for (k = 0; k < nnz; ++k) { \ - if (*pi == *pj) \ - _INCREMENT_(pres[*pi], (*px)); \ - ++pi; ++pj; _MASK_(++px); \ + for (k = 0; k < nnz0; ++k) { \ + if (*pi0 == *pj0) \ + _INCREMENT_(pres[*pi0], (*px0)); \ + ++pi0; ++pj0; _MASK_(++px0); \ } \ } while (0) if (class[0] == 'n') - SDG_LOOP(int, LOGICAL, HIDE, SECONDOF, INCREMENT_PATTERN, 0, 1); + DG_LOOP(int, LOGICAL, HIDE, SECONDOF, INCREMENT_PATTERN, 0, 1); else { - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - SDG_CASES; - UNPROTECT(1); /* x */ + SEXP x0 = PROTECT(GET_SLOT(obj, Matrix_xSym)); + DG_CASES; + UNPROTECT(1); /* x0 */ } - UNPROTECT(2); /* j, i */ + UNPROTECT(2); /* j0, i0 */ } -#undef SDG_CASES -#undef SDG_LOOP +#undef DG_CASES +#undef DG_LOOP if (names) { /* NB: The logic here must be adjusted once the validity method @@ -676,7 +759,7 @@ if (class[1] == 's') setAttrib(res, R_NamesSymbol, cn); else if (rn != R_NilValue && - (rn == cn || equal_string_vectors(rn, cn, r))) + (rn == cn || equal_character_vectors(rn, cn, r))) setAttrib(res, R_NamesSymbol, (r == m) ? rn : cn); } UNPROTECT(1); /* dn */ @@ -705,7 +788,7 @@ SEXP sparse_diag_set(SEXP from, const char *class, SEXP value) { - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(class)); + SEXP to = PROTECT(newObject(class)); int v = LENGTH(value) != 1, full = 0; SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); @@ -733,21 +816,21 @@ } } -#define SDS_CASES \ +#define DS_CASES \ do { \ switch (class[0]) { \ case 'n': \ case 'l': \ - SDS_LOOP(int, LOGICAL, SHOW, ISNZ_LOGICAL); \ + DS_LOOP(int, LOGICAL, SHOW, ISNZ_LOGICAL); \ break; \ case 'i': \ - SDS_LOOP(int, INTEGER, SHOW, ISNZ_INTEGER); \ + DS_LOOP(int, INTEGER, SHOW, ISNZ_INTEGER); \ break; \ case 'd': \ - SDS_LOOP(double, REAL, SHOW, ISNZ_REAL); \ + DS_LOOP(double, REAL, SHOW, ISNZ_REAL); \ break; \ case 'z': \ - SDS_LOOP(Rcomplex, COMPLEX, SHOW, ISNZ_COMPLEX); \ + DS_LOOP(Rcomplex, COMPLEX, SHOW, ISNZ_COMPLEX); \ break; \ default: \ break; \ @@ -803,19 +886,19 @@ } } -#undef SDS_LOOP -#define SDS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_) \ +#undef DS_LOOP +#define DS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_) \ do { \ _CTYPE_ *pvalue = _PTR_(value); \ if (v) { \ for (j = 0; j < r; ++j) { \ - if (_NZ_(pvalue[j])) \ + if (_ISNZ_(pvalue[j])) \ ++nd1; \ pp1[j] += nd1; \ } \ for (j = r; j < n_; ++j) \ pp1[j] += nd1; \ - } else if (_NZ_(pvalue[0])) { \ + } else if (_ISNZ_(pvalue[0])) { \ full = 1; \ for (j = 0; j < r; ++j) \ pp1[j] += ++nd1; \ @@ -824,7 +907,7 @@ } \ } while (0) - SDS_CASES; + DS_CASES; if (nd1 - nd0 > INT_MAX - pp0[n_ - 1]) error(_("%s cannot exceed %s"), "p[length(p)]", "2^31-1"); @@ -833,8 +916,8 @@ SET_SLOT(to, iSym, i1); int *pi1 = INTEGER(i1); -#undef SDS_LOOP -#define SDS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_) \ +#undef DS_LOOP +#define DS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_) \ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1)); \ _CTYPE_ *pvalue = _PTR_(value); \ @@ -847,7 +930,7 @@ } \ if (k < kend && pi0[k] == j) \ ++k; \ - if ((v) ? _NZ_(pvalue[j]) : full) { \ + if ((v) ? _ISNZ_(pvalue[j]) : full) { \ *(pi1++) = j ; \ _MASK_(*(px1++) = (v) ? pvalue[j] : pvalue[0]); \ } \ @@ -868,12 +951,12 @@ } while (0) if (class[0] == 'n') - SDS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL); + DS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL); else { SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), pp1[n_ - 1])); SET_SLOT(to, Matrix_xSym, x1); - SDS_CASES; + DS_CASES; UNPROTECT(2); /* x1, x0 */ } @@ -891,21 +974,21 @@ if (pi0[k] == pj0[k]) ++nd0; -#undef SDS_LOOP -#define SDS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_) \ +#undef DS_LOOP +#define DS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_) \ do { \ _CTYPE_ *pvalue = _PTR_(value); \ if (v) { \ for (j = 0; j < r; ++j) \ - if (_NZ_(pvalue[j])) \ + if (_ISNZ_(pvalue[j])) \ ++nd1; \ - } else if (_NZ_(pvalue[0])) { \ + } else if (_ISNZ_(pvalue[0])) { \ full = 1; \ nd1 = r; \ } \ } while (0) - SDS_CASES; + DS_CASES; if (nd1 - nd0 > R_XLEN_T_MAX - nnz0) error(_("%s cannot exceed %s"), "length(i)", "R_XLEN_T_MAX"); @@ -917,8 +1000,8 @@ SET_SLOT(to, Matrix_jSym, j1); int *pi1 = INTEGER(i1), *pj1 = INTEGER(j1); -#undef SDS_LOOP -#define SDS_LOOP(_CTYPE_, _PTR_, _MASK_, _NZ_) \ +#undef DS_LOOP +#define DS_LOOP(_CTYPE_, _PTR_, _MASK_, _ISNZ_) \ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1)); \ _CTYPE_ *pvalue = _PTR_(value); \ @@ -931,26 +1014,26 @@ } \ if (v) { \ for (j = 0; j < r; ++j) { \ - if (_NZ_(pvalue[j])) { \ + if (_ISNZ_(pvalue[j])) { \ *(pi1++) = *(pj1++) = j; \ - _MASK_((*px1++) = pvalue[j]); \ + _MASK_(*(px1++) = pvalue[j]); \ } \ } \ } else if (full) { \ for (j = 0; j < r; ++j) { \ *(pi1++) = *(pj1++) = j; \ - _MASK_((*px1++) = pvalue[0]); \ + _MASK_(*(px1++) = pvalue[0]); \ } \ } \ } while (0) if (class[0] == 'n') - SDS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL); + DS_LOOP(int, LOGICAL, HIDE, ISNZ_LOGICAL); else { SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), nnz1)); SET_SLOT(to, Matrix_xSym, x1); - SDS_CASES; + DS_CASES; UNPROTECT(2); /* x1, x0 */ } @@ -958,8 +1041,8 @@ } -#undef SDS_CASES -#undef SDS_LOOP +#undef DS_CASES +#undef DS_LOOP UNPROTECT(1); /* to */ return to; @@ -975,15 +1058,13 @@ ERROR_INVALID_CLASS(from, __func__); const char *class = valid[ivalid]; - SEXPTYPE tx = kind2type(class[0]), tv = TYPEOF(value); + SEXPTYPE tx = kindToType(class[0]), tv = TYPEOF(value); switch (tv) { case LGLSXP: case INTSXP: case REALSXP: -#ifdef MATRIX_ENABLE_ZMATRIX case CPLXSXP: -#endif break; default: error(_("replacement diagonal has incompatible type \"%s\""), @@ -1003,12 +1084,17 @@ } else { /* defined in ./coerce.c : */ SEXP sparse_as_kind(SEXP, const char *, char); - PROTECT(from = sparse_as_kind(from, class, type2kind(tv))); #ifndef MATRIX_ENABLE_IMATRIX - if (tv == INTSXP) - value = coerceVector(value, REALSXP); + if (tv == INTSXP) { + PROTECT(from = sparse_as_kind(from, class, 'd')); + PROTECT(value = coerceVector(value, REALSXP)); + } else { #endif + PROTECT(from = sparse_as_kind(from, class, typeToKind(tv))); PROTECT(value); +#ifndef MATRIX_ENABLE_IMATRIX + } +#endif class = valid[R_check_class_etc(from, valid)]; } @@ -1017,95 +1103,17 @@ return from; } -SEXP sparse_diag_U2N(SEXP from, const char *class) -{ - if (class[1] != 't') - return from; - - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - if (di == 'N') - return from; - - SEXP val = PROTECT(ScalarLogical(1)); - from = R_sparse_diag_set(from, val); - UNPROTECT(1); /* val */ - - return from; -} - -/* diagU2N(<[CRT]sparseMatrix>), parallel to R-level ..diagU2N(), - though that is more general, working for _all_ Matrix */ -SEXP R_sparse_diag_U2N(SEXP from) -{ - static const char *valid[] = { - VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - - return sparse_diag_U2N(from, valid[ivalid]); -} - -SEXP sparse_diag_N2U(SEXP from, const char *class) -{ - if (class[1] != 't') - return from; - - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - if (di != 'N') - return from; - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int n = INTEGER(dim)[0]; - UNPROTECT(1); /* dim */ - - if (n == 0) - PROTECT(from = duplicate(from)); - else { - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - if (ul == 'U') - PROTECT(from = sparse_band(from, class, 1, n - 1)); - else - PROTECT(from = sparse_band(from, class, 1 - n, -1)); - } - - PROTECT(diag = mkString("U")); - SET_SLOT(from, Matrix_diagSym, diag); - UNPROTECT(2); /* diag, from */ - - return from; -} - -/* diagN2U(<[CRT]sparseMatrix>), parallel to R-level ..diagN2U(), - though that is more general, working for _all_ Matrix */ -SEXP R_sparse_diag_N2U(SEXP from) -{ - static const char *valid[] = { - VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - - return sparse_diag_N2U(from, valid[ivalid]); -} - SEXP sparse_transpose(SEXP from, const char *class, int lazy) { SEXP to; if (class[2] == 'T' || !lazy) - PROTECT(to = NEW_OBJECT_OF_CLASS(class)); + PROTECT(to = newObject(class)); else { char cl[] = "...Matrix"; cl[0] = class[0]; cl[1] = class[1]; cl[2] = (class[2] == 'C') ? 'R' : 'C'; - PROTECT(to = NEW_OBJECT_OF_CLASS(cl)); + PROTECT(to = newObject(cl)); } SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); @@ -1143,9 +1151,9 @@ SET_SLOT(to, Matrix_diagSym, diag); UNPROTECT(1); /* diag */ } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); + SET_SLOT(to, Matrix_factorsSym, factors); UNPROTECT(1); /* factors */ } } @@ -1223,32 +1231,32 @@ int lazy_; if (TYPEOF(lazy) != LGLSXP || LENGTH(lazy) < 1 || (lazy_ = LOGICAL(lazy)[0]) == NA_LOGICAL) - error(_("invalid '%s' to %s()"), "lazy", __func__); + error(_("invalid '%s' to '%s'"), "lazy", __func__); return sparse_transpose(from, valid[ivalid], lazy_); } SEXP sparse_force_symmetric(SEXP from, const char *class, char ul) { - char ulf = 'U', ult = 'U'; + char ul0 = 'U', ul1 = 'U'; if (class[1] != 'g') { SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - ulf = ult = *CHAR(STRING_ELT(uplo, 0)); + ul0 = ul1 = *CHAR(STRING_ELT(uplo, 0)); UNPROTECT(1); /* uplo */ } if (ul != '\0') - ult = ul; + ul1 = ul; if (class[1] == 's') { /* .s[CRT]Matrix */ - if (ulf == ult) + if (ul0 == ul1) return from; SEXP to = PROTECT(sparse_transpose(from, class, 0)); if (class[0] == 'z') { /* Need _conjugate_ transpose */ - SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); - conjugate(x); - UNPROTECT(1); /* x */ + SEXP x1 = PROTECT(GET_SLOT(to, Matrix_xSym)); + conjugate(x1); + UNPROTECT(1); /* x1 */ } UNPROTECT(1) /* to */; return to; @@ -1259,7 +1267,7 @@ char cl[] = ".s.Matrix"; cl[0] = class[0]; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), n = pdim[0]; @@ -1273,7 +1281,7 @@ set_symmetrized_DimNames(to, dimnames, -1); UNPROTECT(1); /* dimnames */ - if (ult != 'U') { + if (ul1 != 'U') { SEXP uplo = PROTECT(mkString("L")); SET_SLOT(to, Matrix_uploSym, uplo); UNPROTECT(1); /* uplo */ @@ -1308,28 +1316,28 @@ } \ } while (0) - if (class[1] == 't' && di == 'N' && ulf == ult) { + if (class[1] == 't' && di == 'N' && ul0 == ul1) { /* No need to allocate in this case: we have the triangle we want */ if (class[2] != 'T') { - SEXP p = PROTECT(GET_SLOT(from, Matrix_pSym)); - SET_SLOT(to, Matrix_pSym, p); - UNPROTECT(1); /* p */ + SEXP p0 = PROTECT(GET_SLOT(from, Matrix_pSym)); + SET_SLOT(to, Matrix_pSym, p0); + UNPROTECT(1); /* p0 */ } if (class[2] != 'R') { - SEXP i = PROTECT(GET_SLOT(from, Matrix_iSym)); - SET_SLOT(to, Matrix_iSym, i); - UNPROTECT(1); /* i */ + SEXP i0 = PROTECT(GET_SLOT(from, Matrix_iSym)); + SET_SLOT(to, Matrix_iSym, i0); + UNPROTECT(1); /* i0 */ } if (class[2] != 'C') { - SEXP j = PROTECT(GET_SLOT(from, Matrix_jSym)); - SET_SLOT(to, Matrix_jSym, j); - UNPROTECT(1); /* j */ + SEXP j0 = PROTECT(GET_SLOT(from, Matrix_jSym)); + SET_SLOT(to, Matrix_jSym, j0); + UNPROTECT(1); /* j0 */ } if (class[0] != 'n') { - SEXP x = PROTECT(GET_SLOT(from, Matrix_xSym)); - SET_SLOT(to, Matrix_xSym, x); - UNPROTECT(1); /* x */ + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)); + SET_SLOT(to, Matrix_xSym, x0); + UNPROTECT(1); /* x0 */ } UNPROTECT(1); /* to */ return to; @@ -1356,7 +1364,7 @@ if (class[1] == 't') { if (di != 'N') { /* Have triangular matrix with unit diagonal */ - if (ulf != ult) { + if (ul0 != ul1) { /* Returning identity matrix */ for (j = 0; j < n; ++j) pp1[j] = ++nnz1; @@ -1366,7 +1374,7 @@ pp1[j] = ++nnz1 + pp0[j]; nnz1 += nnz0; } - } else if (ulf == ((class[2] == 'C') ? 'U' : 'L')) { + } else if (ul0 == ((class[2] == 'C') ? 'U' : 'L')) { /* Have triangular matrix with non-unit "trailing" diagonal and returning diagonal part */ for (j = 0; j < n; ++j) { @@ -1383,7 +1391,7 @@ pp1[j] = nnz1; } } - } else if (ult == ((class[2] == 'C') ? 'U' : 'L')) { + } else if (ul1 == ((class[2] == 'C') ? 'U' : 'L')) { /* Have general matrix and returning upper triangle */ for (j = 0, k = 0; j < n; ++j) { kend = pp0[j]; @@ -1420,13 +1428,13 @@ if (class[1] == 't') { \ if (di != 'N') { \ /* Have triangular matrix with unit diagonal */ \ - if (ulf != ult) { \ + if (ul0 != ul1) { \ /* Returning identity matrix */ \ for (j = 0; j < n; ++j) { \ *(pi1++) = j; \ _MASK_(*(px1++) = _ONE_); \ } \ - } else if (ulf == ((class[2] == 'C') ? 'U' : 'L')) { \ + } else if (ul0 == ((class[2] == 'C') ? 'U' : 'L')) { \ /* Returning symmetric matrix */ \ /* with unit "trailing" diagonal */ \ for (j = 0, k = 0; j < n; ++j) { \ @@ -1453,7 +1461,7 @@ } \ } \ } \ - } else if (ulf == ((class[2] == 'C') ? 'U' : 'L')) { \ + } else if (ul0 == ((class[2] == 'C') ? 'U' : 'L')) { \ /* Have triangular matrix with non-unit "trailing" */ \ /* diagonal and returning diagonal part */ \ for (j = 0; j < n; ++j) { \ @@ -1472,7 +1480,7 @@ } \ } \ } \ - } else if (ult == ((class[2] == 'C') ? 'U' : 'L')) { \ + } else if (ul1 == ((class[2] == 'C') ? 'U' : 'L')) { \ /* Have general matrix and returning upper triangle */ \ for (j = 0, k = 0; j < n; ++j) { \ kend = pp0[j]; \ @@ -1522,9 +1530,9 @@ /* Counting number of nonzero elements in triangle ... */ if (class[1] == 't' && di != 'N') - nnz1 = (ulf == ult) ? n + nnz0 : n; + nnz1 = (ul0 == ul1) ? n + nnz0 : n; else { - if (ult == 'U') { + if (ul1 == 'U') { for (k = 0; k < nnz0; ++k) if (pi0[k] <= pj0[k]) ++nnz1; @@ -1549,7 +1557,7 @@ do { \ _MASK_(_CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1)); \ if (class[1] == 't' && di != 'N') { \ - if (ulf == ult) { \ + if (ul0 == ul1) { \ Matrix_memcpy(pi1, pi0, nnz0, sizeof(int)); \ Matrix_memcpy(pj1, pj0, nnz0, sizeof(int)); \ _MASK_(Matrix_memcpy(px1, px0, nnz0, sizeof(_CTYPE_))); \ @@ -1562,7 +1570,7 @@ _MASK_(*(px1++) = _ONE_); \ } \ } else { \ - if (ult == 'U') { \ + if (ul1 == 'U') { \ for (k = 0; k < nnz0; ++k) { \ if (pi0[k] <= pj0[k]) { \ *(pi1++) = pi0[k]; \ @@ -1615,7 +1623,7 @@ if (TYPEOF(uplo) != STRSXP || LENGTH(uplo) < 1 || (uplo = STRING_ELT(uplo, 0)) == NA_STRING || ((ul = *CHAR(uplo)) != 'U' && ul != 'L')) - error(_("invalid '%s' to %s()"), "uplo", __func__); + error(_("invalid '%s' to '%s'"), "uplo", __func__); } return sparse_force_symmetric(from, valid[ivalid], ul); @@ -1637,7 +1645,7 @@ char cl[] = ".s.Matrix"; cl[0] = (class[0] != 'z') ? 'd' : 'z'; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), n = pdim[0]; @@ -1673,11 +1681,6 @@ UNPROTECT(1); /* uplo */ } -#define ASSIGN_REAL(_X_, _Y_) \ - do { _X_ = _Y_ ; } while (0) -#define ASSIGN_COMPLEX(_X_, _Y_) \ - do { _X_.r = _Y_.r; _X_.i = _Y_.i; } while (0) - if (class[2] != 'T') { SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, @@ -1729,12 +1732,14 @@ } SEXP i1 = PROTECT(allocVector(INTSXP, pp1[n - 1])), - x1 = PROTECT(allocVector(kind2type(cl[0]), pp1[n - 1])); + x1 = PROTECT(allocVector(kindToType(cl[0]), pp1[n - 1])); int *pi1 = INTEGER(i1); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_, _INCREMENT_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_, _INCREMENT_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1), \ + *px0_ = _PTR_(x0_); \ for (j = 0, k = 0, k_ = 0; j < n; ++j) { \ kend = pp0[j]; \ kend_ = pp0_[j]; \ @@ -1768,16 +1773,10 @@ } \ } while (0) - - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1), - *px0_ = REAL(x0_); - SP_LOOP(ASSIGN_REAL, INCREMENT_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1), - *px0_ = COMPLEX(x0_); - SP_LOOP(ASSIGN_COMPLEX, INCREMENT_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL, INCREMENT_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX, INCREMENT_COMPLEX); SET_SLOT(to, Matrix_pSym, p1); SET_SLOT(to, iSym, i1); @@ -1790,11 +1789,12 @@ if (di == 'N') { - SEXP x1 = PROTECT(allocVector(kind2type(cl[0]), nnz)); + SEXP x1 = PROTECT(allocVector(kindToType(cl[0]), nnz)); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ if (leading) { \ for (j = 0, k = 0; j < n; ++j) { \ kend = pp0[j]; \ @@ -1828,13 +1828,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX); SET_SLOT(to, Matrix_pSym, p0); SET_SLOT(to, iSym, i0); @@ -1846,13 +1843,14 @@ nnz += n; SEXP p1 = PROTECT(allocVector(INTSXP, (R_xlen_t) n + 1)), i1 = PROTECT(allocVector(INTSXP, nnz)), - x1 = PROTECT(allocVector(kind2type(cl[0]), nnz)); + x1 = PROTECT(allocVector(kindToType(cl[0]), nnz)); int *pp1 = INTEGER(p1), *pi1 = INTEGER(i1); *(pp1++) = 0; #undef SP_LOOP -#define SP_LOOP(_ASSIGN_, _ONE_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_, _ONE_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ if (leading) { \ for (j = 0, k = 0; j < n; ++j) { \ kend = pp0[j]; \ @@ -1882,13 +1880,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL, 1.0); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX, Matrix_zone); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL, 1.0); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX, Matrix_zone); SET_SLOT(to, Matrix_pSym, p1); SET_SLOT(to, iSym, i1); @@ -1905,6 +1900,7 @@ if (cl[0] == 'd') SET_SLOT(to, Matrix_xSym, x0); else { + /* Symmetric part of Hermitian matrix is real part */ SEXP x1 = PROTECT(duplicate(x0)); zeroIm(x1); SET_SLOT(to, Matrix_xSym, x1); @@ -1927,12 +1923,13 @@ SEXP i1 = PROTECT(allocVector(INTSXP, nnz)), j1 = PROTECT(allocVector(INTSXP, nnz)), - x1 = PROTECT(allocVector(kind2type(cl[0]), nnz)); + x1 = PROTECT(allocVector(kindToType(cl[0]), nnz)); int *pi1 = INTEGER(i1), *pj1 = INTEGER(j1); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (k = 0; k < nnz; ++k) { \ if (*pi0 == *pj0) { \ *pi1 = *pi0; \ @@ -1951,13 +1948,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX); SET_SLOT(to, Matrix_iSym, i1); SET_SLOT(to, Matrix_jSym, j1); @@ -1968,11 +1962,12 @@ if (di == 'N') { - SEXP x1 = PROTECT(allocVector(kind2type(cl[0]), nnz)); + SEXP x1 = PROTECT(allocVector(kindToType(cl[0]), nnz)); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (k = 0; k < nnz; ++k) { \ if (*pi0 == *pj0) \ *px1 = *px0; \ @@ -1982,13 +1977,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX); SET_SLOT(to, Matrix_iSym, i0); SET_SLOT(to, Matrix_jSym, j0); @@ -1999,12 +1991,13 @@ SEXP i1 = PROTECT(allocVector(INTSXP, nnz + n)), j1 = PROTECT(allocVector(INTSXP, nnz + n)), - x1 = PROTECT(allocVector(kind2type(cl[0]), nnz + n)); + x1 = PROTECT(allocVector(kindToType(cl[0]), nnz + n)); int j, *pi1 = INTEGER(i1), *pj1 = INTEGER(j1); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_, _ONE_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_, _ONE_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (k = 0; k < nnz; ++k) { \ *pi1 = *pi0; \ *pj1 = *pj0; \ @@ -2018,13 +2011,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL, 1.0); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX, Matrix_zone); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL, 1.0); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX, Matrix_zone); SET_SLOT(to, Matrix_iSym, i1); SET_SLOT(to, Matrix_jSym, j1); @@ -2041,6 +2031,7 @@ if (cl[0] == 'd') SET_SLOT(to, Matrix_xSym, x0); else { + /* Symmetric part of Hermitian matrix is real part */ SEXP x1 = PROTECT(duplicate(x0)); zeroIm(x1); SET_SLOT(to, Matrix_xSym, x1); @@ -2084,7 +2075,7 @@ cl[0] = (class[0] != 'z') ? 'd' : 'z'; cl[1] = (class[1] != 's') ? 'g' : 's'; cl[2] = class[2]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); + SEXP to = PROTECT(newObject(cl)); SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); int *pdim = INTEGER(dim), n = pdim[0]; @@ -2198,12 +2189,14 @@ } SEXP i1 = PROTECT(allocVector(INTSXP, pp1[n - 1])), - x1 = PROTECT(allocVector(kind2type(cl[0]), pp1[n - 1])); + x1 = PROTECT(allocVector(kindToType(cl[0]), pp1[n - 1])); int *pi1 = INTEGER(i1); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_, _INCREMENT_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_, _INCREMENT_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1), \ + *px0_ = _PTR_(x0_); \ for (j = 0, k = 0, k_ = 0; j < n; ++j) { \ kend = pp0[j]; \ kend_ = pp0_[j]; \ @@ -2249,15 +2242,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1), - *px0_ = REAL(x0_); - SP_LOOP(ASSIGN_REAL, INCREMENT_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1), - *px0_ = COMPLEX(x0_); - SP_LOOP(ASSIGN_COMPLEX, INCREMENT_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL, INCREMENT_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX, INCREMENT_COMPLEX); Matrix_Free(pp1_, n); SET_SLOT(to, Matrix_pSym, p1); @@ -2280,12 +2268,13 @@ SEXP i1 = PROTECT(allocVector(INTSXP, nnz1)), j1 = PROTECT(allocVector(INTSXP, nnz1)), - x1 = PROTECT(allocVector(kind2type(cl[0]), nnz1)); + x1 = PROTECT(allocVector(kindToType(cl[0]), nnz1)); int *pi1 = INTEGER(i1), *pj1 = INTEGER(j1); #undef SP_LOOP -#define SP_LOOP(_ASSIGN_) \ +#define SP_LOOP(_CTYPE_, _PTR_, _ASSIGN_) \ do { \ + _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (k = 0; k < nnz0; ++k) { \ if (*pi0 != *pj0) { \ *pi1 = *pi0; \ @@ -2301,13 +2290,10 @@ } \ } while (0) - if (cl[0] == 'd') { - double *px0 = REAL(x0), *px1 = REAL(x1); - SP_LOOP(ASSIGN_REAL); - } else { - Rcomplex *px0 = COMPLEX(x0), *px1 = COMPLEX(x1); - SP_LOOP(ASSIGN_COMPLEX); - } + if (cl[0] == 'd') + SP_LOOP(double, REAL, ASSIGN_REAL); + else + SP_LOOP(Rcomplex, COMPLEX, ASSIGN_COMPLEX); SET_SLOT(to, Matrix_iSym, i1); SET_SLOT(to, Matrix_jSym, j1); @@ -2316,10 +2302,6 @@ } -#undef ASSIGN_REAL -#undef ASSIGN_COMPLEX -#undef INCREMENT_REAL -#undef INCREMENT_COMPLEX #undef SP_LOOP UNPROTECT(2); /* to, from */ @@ -2338,961 +2320,1439 @@ return sparse_skewpart(from, valid[ivalid]); } -SEXP Tsparse_aggregate(SEXP from) +int sparse_is_symmetric(SEXP obj, const char *class, int checkDN) { - static const char *valid[] = { VALID_TSPARSE, "" }; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *cl = valid[ivalid]; + if (class[1] == 's') + return 1; - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ + if (checkDN) { + SEXP dimnames = GET_SLOT(obj, Matrix_DimNamesSym); + if (!DimNames_is_symmetric(dimnames)) + return 0; + } - SEXP to, - i0 = PROTECT(GET_SLOT(from, Matrix_iSym)), - j0 = PROTECT(GET_SLOT(from, Matrix_jSym)), - i1 = NULL, j1 = NULL; + if (class[1] == 't') + return sparse_is_diagonal(obj, class); - /* defined in ./coerce.c : */ - void taggr(SEXP, SEXP, SEXP, SEXP *, SEXP *, SEXP *, int, int); + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return 1; - if (cl[0] == 'n') { - taggr(j0, i0, NULL, &j1, &i1, NULL, n, m); - if (!i1) { - UNPROTECT(2); /* j0, i0 */ - return from; - } - PROTECT(i1); - PROTECT(j1); - PROTECT(to = NEW_OBJECT_OF_CLASS(cl)); - SET_SLOT(to, Matrix_iSym, i1); - SET_SLOT(to, Matrix_jSym, j1); - UNPROTECT(5); /* to, j1, i1, j0, i0 */ - } else { - SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), - x1 = NULL; - taggr(j0, i0, x0, &j1, &i1, &x1, n, m); - if (!i1) { - UNPROTECT(3); /* x0, j0, i0 */ - return from; - } - PROTECT(i1); - PROTECT(j1); - PROTECT(x1); - PROTECT(to = NEW_OBJECT_OF_CLASS(cl)); - SET_SLOT(to, Matrix_iSym, i1); - SET_SLOT(to, Matrix_jSym, j1); - SET_SLOT(to, Matrix_xSym, x1); - UNPROTECT(7); /* to, x1, j1, i1, x0, j0, i0 */ + if (class[2] == 'T') { + /* defined in ./coerce.c : */ + SEXP sparse_as_Csparse(SEXP, const char *); + obj = sparse_as_Csparse(obj, class); } + PROTECT(obj); - PROTECT(to); + SEXP iSym = (class[2] != 'R') ? Matrix_iSym : Matrix_jSym, + p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i0 = PROTECT(GET_SLOT(obj, iSym)); + int i, j, k, kend, *pp_, *pp0 = INTEGER(p0) + 1, *pi0 = INTEGER(i0); + Matrix_Calloc(pp_, n, int); + Matrix_memcpy(pp_, pp0 - 1, n, sizeof(int)); - if (m != n || n > 0) { - PROTECT(dim = GET_SLOT(to, Matrix_DimSym)); - pdim = INTEGER(dim); - pdim[0] = m; - pdim[1] = n; - UNPROTECT(1); /* dim */ + int ans = 0; + +#define IS_LOOP(_CTYPE_, _PTR_, _MASK_, _NOTREAL_, _NOTCONJ_) \ + do { \ + _MASK_(_CTYPE_ *px0 = _PTR_(x0)); \ + for (j = 0, k = 0; j < n; ++j) { \ + kend = pp0[j]; \ + while (k < kend) { \ + i = pi0[k]; \ + if (i >= j) { \ + if (i == j) { \ + if (_NOTREAL_(px0[k])) \ + goto finish; \ + ++pp_[j]; \ + } \ + k = kend; \ + } else { \ + if (pp_[i] == pp0[i] || pi0[pp_[i]] != j || \ + _NOTCONJ_(px0[k], px0[pp_[i]])) \ + goto finish; \ + ++pp_[i]; \ + ++pp_[j]; \ + ++k; \ + } \ + } \ + } \ + } while (0) + +#undef NOTCONJ_PATTERN +#define NOTCONJ_PATTERN(_X_, _Y_) 0 + + /* For all X[i,j], i >= j, we require: + o that X[j,i] exists + o that X[j,i] == Conj(X[i,j]) + o that Im(X[j,i]) == 0 if i == j + */ + if (class[0] == 'n') + IS_LOOP(int, LOGICAL, HIDE, NOTREAL_PATTERN, NOTCONJ_PATTERN); + else { + SEXP x0 = GET_SLOT(obj, Matrix_xSym); + switch (class[0]) { + case 'l': + IS_LOOP(int, LOGICAL, SHOW, NOTREAL_LOGICAL, NOTCONJ_LOGICAL); + break; + case 'i': + IS_LOOP(int, INTEGER, SHOW, NOTREAL_INTEGER, NOTCONJ_INTEGER); + break; + case 'd': + IS_LOOP(double, REAL, SHOW, NOTREAL_REAL, NOTCONJ_REAL); + break; + case 'z': + IS_LOOP(Rcomplex, COMPLEX, SHOW, NOTREAL_COMPLEX, NOTCONJ_COMPLEX); + break; + default: + break; + } } - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ + /* We further require that the upper and lower triangles + have the same number of entries ... + */ + for (j = 0; j < n; ++j) + if (pp_[j] != pp0[j]) + goto finish; - if (cl[1] != 'g') { - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + ans = 1; + +finish: + Matrix_Free(pp_, n); + UNPROTECT(3); /* i0, p0, obj */ + +#undef IS_LOOP + + return ans; +} + +/* isSymmetric(<[CRT]sparseMatrix>, checkDN, tol = 0) + NB: requires symmetric nonzero pattern + TODO: support 'tol', 'scale' arguments and bypass all.equal ?? +*/ +SEXP R_sparse_is_symmetric(SEXP obj, SEXP checkDN) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); + + int checkDN_; + if (TYPEOF(checkDN) != LGLSXP || LENGTH(checkDN) < 1 || + (checkDN_ = LOGICAL(checkDN)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "checkDN", "TRUE", "FALSE"); + + return ScalarLogical(sparse_is_symmetric(obj, valid[ivalid], checkDN_)); +} + +int sparse_is_triangular(SEXP obj, const char *class, int upper) +{ + if (class[1] == 't') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); char ul = *CHAR(STRING_ELT(uplo, 0)); - if (ul != 'U') - SET_SLOT(to, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ + if (upper == NA_LOGICAL || (upper != 0) == (ul == 'U')) + return (ul == 'U') ? 1 : -1; + else if (sparse_is_diagonal(obj, class)) + return (ul == 'U') ? -1 : 1; + else + return 0; } - if (cl[1] == 't') { - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - if (di != 'N') - SET_SLOT(to, Matrix_diagSym, diag); - UNPROTECT(1); /* diag */ - } else { - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); - if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); - UNPROTECT(1); /* factors */ + + if (class[1] == 's') { + if (!sparse_is_diagonal(obj, class)) + return 0; + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + if (upper == NA_LOGICAL) + return (ul == 'U') ? 1 : -1; + else + return (upper != 0) ? 1 : -1; } - UNPROTECT(1); /* to */ - return to; -} + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return (upper != 0) ? 1 : -1; -/* isDiagonal(<[CR]sparseMatrix>) */ -#define CR_IS_DIAGONAL(_C_, _I_) \ -SEXP _C_ ## sparse_is_diagonal(SEXP obj) \ -{ \ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; \ - UNPROTECT(1); /* dim */ \ - if (m != n) \ - return ScalarLogical(0); \ - SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)); \ - int *pp = INTEGER(p); \ - if (pp[n] > n) { \ - UNPROTECT(1); /* p */ \ - return ScalarLogical(0); \ - } \ - SEXP i = PROTECT(GET_SLOT(obj, Matrix_ ## _I_ ## Sym)); \ - int d, j, *pi = INTEGER(i); \ - Rboolean res = TRUE; \ - for (j = 0; j < n; ++j) { \ - if ((d = pp[j+1] - pp[j]) > 1 || (d == 1 && *(pi++) != j)) { \ - res = FALSE; \ - break; \ - } \ - } \ - UNPROTECT(2); /* i, p */ \ - return ScalarLogical(res); \ -} + if (class[2] != 'T') { -/* Csparse_is_diagonal() */ -CR_IS_DIAGONAL(C, i) -/* Rsparse_is_diagonal() */ -CR_IS_DIAGONAL(R, j) + SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, + p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i0 = PROTECT(GET_SLOT(obj, iSym)); + UNPROTECT(2); /* i0, p0 */ + int j, k, kend, *pp0 = INTEGER(p0) + 1, *pi0 = INTEGER(i0); -/* isDiagonal() */ -SEXP Tsparse_is_diagonal(SEXP obj) -{ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ - if (m != n) - return ScalarLogical(0); - SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - j = PROTECT(GET_SLOT(obj, Matrix_jSym)); - int *pi = INTEGER(i), *pj = INTEGER(j); - R_xlen_t k, nnz = XLENGTH(i); - Rboolean res = TRUE; - for (k = 0; k < nnz; ++k) { - if (*(pi++) != *(pj++)) { - res = FALSE; - break; + if (upper == NA_LOGICAL) { + /* Examine last entry in each "column" */ + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + if (k < kend && pi0[kend - 1] > j) + break; + k = kend; + } + if (j == n) + return (class[2] == 'C') ? 1 : -1; + /* Examine first entry in each "column" */ + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + if (k < kend && pi0[k] < j) + break; + k = kend; + } + if (j == n) + return (class[2] == 'C') ? -1 : 1; + return 0; + } else if ((class[2] == 'C') == (upper != 0)) { + /* Examine last entry in each "column" */ + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + if (k < kend && pi0[kend - 1] > j) + return 0; + k = kend; + } + return (class[2] == 'C') ? 1 : -1; + } else { + /* Examine first entry in each "column" */ + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + if (k < kend && pi0[k] < j) + return 0; + k = kend; + } + return (class[2] == 'C') ? -1 : 1; } + + } else { + + SEXP i0 = PROTECT(GET_SLOT(obj, Matrix_iSym)), + j0 = PROTECT(GET_SLOT(obj, Matrix_jSym)); + UNPROTECT(2); /* i0, j0 */ + int *pi0 = INTEGER(i0), *pj0 = INTEGER(j0); + R_xlen_t k, nnz0 = XLENGTH(i0); + + if (upper == NA_LOGICAL) { + for (k = 0; k < nnz0; ++k) + if (pi0[k] > pj0[k]) + break; + if (k == nnz0) + return 1; + for (k = 0; k < nnz0; ++k) + if (pi0[k] < pj0[k]) + break; + if (k == nnz0) + return -1; + return 0; + } else if (upper != 0) { + for (k = 0; k < nnz0; ++k) + if (pi0[k] > pj0[k]) + return 0; + return 1; + } else { + for (k = 0; k < nnz0; ++k) + if (pi0[k] < pj0[k]) + return 0; + return -1; + } + } - UNPROTECT(2); /* j, i */ - return ScalarLogical(res); } -/* isTriangular(<.g[CR]Matrix>, upper) */ -#define CR_IS_TRIANGULAR(_C_, _I_, _UPPER_, _LOWER_) \ -SEXP _C_ ## sparse_is_triangular(SEXP obj, SEXP upper) \ -{ \ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; \ - UNPROTECT(1); /* dim */ \ - if (m != n) \ - return ScalarLogical(0); \ - SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)), \ - i = PROTECT(GET_SLOT(obj, Matrix_ ## _I_ ## Sym)); \ - int j, k, kend, *pp = INTEGER(p), *pi = INTEGER(i), \ - need_upper = asLogical(upper); \ - Rboolean res = TRUE; \ - ++pp; \ - if (need_upper == NA_LOGICAL) { \ - for (j = 0, k = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { \ - if (_LOWER_) \ - goto opposite; \ - ++k; \ - } \ - } \ - UNPROTECT(2); /* i, p */ \ - RETURN_TRUE_OF_KIND("U"); \ - opposite: \ - for (j = 0, k = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { \ - if (_UPPER_) { \ - res = FALSE; \ - goto nokind; \ - } \ - ++k; \ - } \ - } \ - UNPROTECT(2); /* i, p */ \ - RETURN_TRUE_OF_KIND("L"); \ - } else if (need_upper != 0) { \ - for (j = 0, k = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { \ - if (_LOWER_) { \ - res = FALSE; \ - goto nokind; \ - } \ - ++k; \ - } \ - } \ - } else { \ - for (j = 0, k = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { \ - if (_UPPER_) { \ - res = FALSE; \ - goto nokind; \ - } \ - ++k; \ - } \ - } \ - } \ -nokind: \ - UNPROTECT(2); /* i, p */ \ - return ScalarLogical(res); \ -} +/* isTriangular(<[CRT]sparseMatrix>, upper) + NB: requires triangular nonzero pattern +*/ +SEXP R_sparse_is_triangular(SEXP obj, SEXP upper) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); -/* Csparse_is_triangular() */ -CR_IS_TRIANGULAR(C, i, pi[k] < j, pi[k] > j) -/* Rsparse_is_triangular() */ -CR_IS_TRIANGULAR(R, j, pi[k] > j, pi[k] < j) + if (TYPEOF(upper) != LGLSXP || LENGTH(upper) < 1) + error(_("'%s' must be %s or %s or %s"), "upper", "TRUE", "FALSE", "NA"); + int upper_ = LOGICAL(upper)[0]; + + int ans_ = sparse_is_triangular(obj, valid[ivalid], upper_); + SEXP ans = allocVector(LGLSXP, 1); + LOGICAL(ans)[0] = ans_ != 0; + if (upper_ == NA_LOGICAL && ans_ != 0) { + PROTECT(ans); + static + SEXP kindSym = NULL; + SEXP kindVal = PROTECT(mkString((ans_ > 0) ? "U" : "L")); + if (!kindSym) kindSym = install("kind"); + setAttrib(ans, kindSym, kindVal); + UNPROTECT(2); + } + return ans; +} -/* isTriangular(<.gTMatrix>, upper) */ -SEXP Tsparse_is_triangular(SEXP obj, SEXP upper) +int sparse_is_diagonal(SEXP obj, const char *class) { - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - UNPROTECT(1); /* dim */ - if (m != n) - return ScalarLogical(0); - SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)), - j = PROTECT(GET_SLOT(obj, Matrix_jSym)); - int *pi = INTEGER(i), *pj = INTEGER(j), need_upper = asLogical(upper); - R_xlen_t k, nnz = XLENGTH(i); - Rboolean res = TRUE; - if (need_upper == NA_LOGICAL) { - for (k = 0; k < nnz; ++k) - if (pi[k] > pj[k]) - goto opposite; - UNPROTECT(2); /* j, i */ - RETURN_TRUE_OF_KIND("U"); - opposite: - for (k = 0; k < nnz; ++k) - if (pi[k] < pj[k]) { - res = FALSE; - goto nokind; - } - UNPROTECT(2); /* j, i */ - RETURN_TRUE_OF_KIND("L"); - } else if (need_upper != 0) { - for (k = 0; k < nnz; ++k) - if (pi[k] > pj[k]) { - res = FALSE; - goto nokind; - } + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), n = pdim[0]; + if (pdim[1] != n) + return 0; + if (n <= 1) + return 1; + + if (class[2] != 'T') { + + SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, + p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i0 = PROTECT(GET_SLOT(obj, iSym)); + UNPROTECT(2); /* i0, p0 */ + int j, k, kend, *pp0 = INTEGER(p0) + 1, *pi0 = INTEGER(i0); + + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + if (kend - k > 1 || (kend - k == 1 && pi0[k] != j)) + return 0; + k = kend; + } + return 1; + } else { - for (k = 0; k < nnz; ++k) - if (pi[k] < pj[k]) { - res = FALSE; - goto nokind; - } + + SEXP i0 = PROTECT(GET_SLOT(obj, Matrix_iSym)), + j0 = PROTECT(GET_SLOT(obj, Matrix_jSym)); + UNPROTECT(2); /* i0, j0 */ + int *pi0 = INTEGER(i0), *pj0 = INTEGER(j0); + R_xlen_t k, nnz0 = XLENGTH(i0); + + for (k = 0; k < nnz0; ++k) + if (*(pi0++) != *(pj0++)) + return 0; + return 1; + } -nokind: - UNPROTECT(2); /* j, i */ - return ScalarLogical(res); } -#define CR_IS_SYMMETRIC_LOOP(_XCOND_) \ - do { \ - for (j = 0, k = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { \ - if ((i = pi[k]) >= j) { \ - if (i == j) \ - ++pp_[j]; \ - k = kend; \ - break; \ - } \ - if (pp_[i] == pp[i] || pi[pp_[i]] != j || (_XCOND_)) { \ - res = FALSE; \ - goto finish; \ - } \ - ++pp_[i]; \ - ++pp_[j]; \ - ++k; \ - } \ - } \ - } while (0) +/* isDiagonal(<[CRT]sparseMatrix>) + NB: requires diagonal nonzero pattern +*/ +SEXP R_sparse_is_diagonal(SEXP obj) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); -/* isSymmetric(<.g[CR]Matrix>, tol = 0, checkDN) */ -#define CR_IS_SYMMETRIC(_C_, _I_) \ -SEXP _C_ ## sparse_is_symmetric(SEXP obj, SEXP checkDN) \ -{ \ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; \ - UNPROTECT(1); /* dim */ \ - if (!s) \ - return ScalarLogical(0); \ - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); \ - s = asLogical(checkDN) == 0 || DimNames_is_symmetric(dimnames); \ - UNPROTECT(1); /* dimnames */ \ - if (!s) \ - return ScalarLogical(0); \ - SEXP p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), \ - i0 = PROTECT(GET_SLOT(obj, Matrix_ ## _I_ ## Sym)); \ - int i, j, k, kend, *pp_, *pp = INTEGER(p0), *pi = INTEGER(i0), \ - nprotect = 2; \ - Rboolean res = TRUE; \ - Matrix_Calloc(pp_, n, int); \ - Matrix_memcpy(pp_, pp, n, sizeof(int)); \ - ++pp; \ - /* For all X[i,j] in "leading" triangle, */ \ - /* need that X[j,i] exists and X[j,i] == X[i,j] */ \ - if (!HAS_SLOT(obj, Matrix_xSym)) \ - CR_IS_SYMMETRIC_LOOP(0); \ - else { \ + return ScalarLogical(sparse_is_diagonal(obj, valid[ivalid])); +} + +#define MAP(_I_) work[_I_] +#define NOMAP(_I_) _I_ + +#define CAST_PATTERN(_X_) 1 +#define CAST_LOGICAL(_X_) (_X_ != 0) +#define CAST_INTEGER(_X_) _X_ +#define CAST_REAL(_X_) _X_ +#define CAST_COMPLEX(_X_) _X_ + +#define SUM_CASES(_MAP_) \ +do { \ + if (class[0] == 'n') { \ + if (mean) \ + SUM_LOOP(int, LOGICAL, double, REAL, HIDE, \ + 0.0, 1.0, NA_REAL, ISNA_PATTERN, \ + _MAP_, CAST_PATTERN, INCREMENT_REAL, SCALE2_REAL); \ + else \ + SUM_LOOP(int, LOGICAL, int, INTEGER, HIDE, \ + 0, 1, NA_INTEGER, ISNA_PATTERN, \ + _MAP_, CAST_PATTERN, INCREMENT_INTEGER, SCALE2_REAL); \ + } else { \ SEXP x0 = PROTECT(GET_SLOT(obj, Matrix_xSym)); \ - ++nprotect; \ - switch (TYPEOF(x0)) { \ - case LGLSXP: \ - { \ - int *px = LOGICAL(x0); \ - CR_IS_SYMMETRIC_LOOP( \ - px[pp_[i]] == NA_LOGICAL \ - ? (px[k] != NA_LOGICAL) \ - : (px[k] == NA_LOGICAL || px[pp_[i]] != px[k])); \ + switch (class[0]) { \ + case 'l': \ + if (mean) \ + SUM_LOOP(int, LOGICAL, double, REAL, SHOW, \ + 0.0, 1.0, NA_REAL, ISNA_LOGICAL, \ + _MAP_, CAST_LOGICAL, INCREMENT_REAL, SCALE2_REAL); \ + else \ + SUM_LOOP(int, LOGICAL, int, INTEGER, SHOW, \ + 0, 1, NA_INTEGER, ISNA_LOGICAL, \ + _MAP_, CAST_LOGICAL, INCREMENT_INTEGER, SCALE2_REAL); \ break; \ - } \ - case INTSXP: \ - { \ - int *px = INTEGER(x0); \ - CR_IS_SYMMETRIC_LOOP( \ - px[pp_[i]] == NA_INTEGER \ - ? (px[k] != NA_INTEGER) \ - : (px[k] == NA_INTEGER || px[pp_[i]] != px[k])); \ + case 'i': \ + SUM_LOOP(int, INTEGER, double, REAL, SHOW, \ + 0.0, 1.0, NA_REAL, ISNA_INTEGER, \ + _MAP_, CAST_INTEGER, INCREMENT_REAL, SCALE2_REAL); \ break; \ - } \ - case REALSXP: \ - { \ - double *px = REAL(x0); \ - CR_IS_SYMMETRIC_LOOP( \ - ISNAN(px[pp_[i]]) \ - ? !ISNAN(px[k]) \ - : (ISNAN(px[k]) || px[pp_[i]] != px[k])); \ + case 'd': \ + SUM_LOOP(double, REAL, double, REAL, SHOW, \ + 0.0, 1.0, NA_REAL, ISNA_REAL, \ + _MAP_, CAST_REAL, INCREMENT_REAL, SCALE2_REAL); \ break; \ - } \ - case CPLXSXP: \ - { \ - Rcomplex *px = COMPLEX(x0); \ - CR_IS_SYMMETRIC_LOOP( \ - ISNAN(px[pp_[i]].r) || ISNAN(px[pp_[i]].i) \ - ? !(ISNAN(px[k].r) || ISNAN(px[k].i)) \ - : (ISNAN(px[k].r) || ISNAN(px[k].i) || \ - px[pp_[i]].r != px[k].r || px[pp_[i]].i != px[k].i)); \ + case 'z': \ + SUM_LOOP(Rcomplex, COMPLEX, Rcomplex, COMPLEX, SHOW, \ + Matrix_zzero, Matrix_zone, Matrix_zna, ISNA_COMPLEX, \ + _MAP_, CAST_COMPLEX, INCREMENT_COMPLEX, SCALE2_COMPLEX); \ break; \ - } \ default: \ - ERROR_INVALID_TYPE(x0, __func__); \ break; \ } \ + UNPROTECT(1); /* x0 */ \ } \ - /* Need upper, lower triangles to have same number of nonzero elements */ \ - for (j = 0; j < n; ++j) { \ - if (pp_[j] != pp[j]) { \ - res = FALSE; \ - goto finish; \ - } \ - } \ -finish: \ - Matrix_Free(pp_, n); \ - UNPROTECT(nprotect); /* x0, i0, p0 */ \ - return ScalarLogical(res); \ -} - -/* Csparse_is_symmetric() */ -/* FIXME: not checking for real diagonal in complex case */ -CR_IS_SYMMETRIC(C, i) -/* Rsparse_is_symmetric() */ -/* FIXME: not checking for real diagonal in complex case */ -CR_IS_SYMMETRIC(R, j) +} while (0) -/* colSums(), rowSums() */ -SEXP CRsparse_colSums(SEXP obj, SEXP narm, SEXP mean, SEXP sparse) +#define SUM_TYPEOF(c) (c == 'z') ? CPLXSXP : ((mean || c == 'd' || c == 'i') ? REALSXP : INTSXP) + +static +void Csparse_colsum(SEXP obj, const char *class, + int m, int n, char di, int narm, int mean, + SEXP res) { - static const char *valid[] = { VALID_CSPARSE, VALID_RSPARSE, "" }; - int ivalid = R_check_class_etc(obj, valid), nprotect = 0; - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - const char *cl = valid[ivalid]; - if (cl[1] == 's') - return CRsparse_rowSums(obj, narm, mean, sparse); + int narm_ = narm && mean && class[0] != 'n'; - int doSparse = asLogical(sparse) != 0, - doNaRm = asLogical(narm) != 0, - doMean = asLogical(mean) != 0, - doCount = doNaRm && doMean; + SEXP p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)); + int *pp0 = INTEGER(p0) + 1, j, k, kend, nnz1 = n, count = -1; - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int margin = (cl[2] == 'C') ? 1 : 0, - *pdim = INTEGER(dim), m = pdim[!margin], n = pdim[margin]; - UNPROTECT(1); /* dim */ + if (IS_S4_OBJECT(res)) { - char di = 'N'; - if (cl[1] == 't') { - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - if (doSparse && di != 'N') - warning(_("sparseResult=TRUE inefficient for unit triangular 'x'")); - } + if (di == 'N') { + nnz1 = 0; + for (j = 0; j < n; ++j) + if (pp0[j - 1] < pp0[j]) + ++nnz1; + } - SEXP p = PROTECT(GET_SLOT(obj, Matrix_pSym)); - ++nprotect; - int *pp = INTEGER(p) + 1, j, k, kend, count = m; + SEXP + j1 = PROTECT(allocVector(INTSXP, nnz1)), + x1 = PROTECT(allocVector(SUM_TYPEOF(class[0]), nnz1)); + SET_SLOT(res, Matrix_iSym, j1); + SET_SLOT(res, Matrix_xSym, x1); - PROTECT_INDEX pid; - SEXP res, vl = NULL, vi = NULL, vx = NULL; - int *pvi = NULL; + int *pj1 = INTEGER(j1); + if (di != 'N') + for (j = 0; j < n; ++j) + *(pj1++) = j + 1; + else + for (j = 0; j < n; ++j) + if (pp0[j - 1] < pp0[j]) + *(pj1++) = j + 1; + +#define SUM_LOOP(_CTYPE0_, _PTR0_, _CTYPE1_, _PTR1_, _MASK_, \ + _ZERO_, _ONE_, _NA_, _ISNA_, \ + _MAP_, _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + _MASK_(_CTYPE0_ *px0 = _PTR0_(x0)); \ + _CTYPE1_ *px1 = _PTR1_(x1) , tmp; \ + for (j = 0, k = 0; j < n; ++j) { \ + kend = pp0[j]; \ + if (k < kend || nnz1 == n) { \ + *px1 = (di != 'N') ? _ONE_ : _ZERO_; \ + if (mean) \ + count = m; \ + while (k < kend) { \ + if (_ISNA_(*px0)) { \ + if (!narm) \ + *px1 = _NA_; \ + else if (narm_) \ + --count; \ + } else { \ + tmp = _CAST_(*px0); \ + _INCREMENT_((*px1), tmp); \ + } \ + _MASK_(++px0); \ + ++k; \ + } \ + if (mean) \ + _SCALE2_((*px1), count); \ + ++px1; \ + } \ + } \ + } while (0) + + SUM_CASES(MAP); + UNPROTECT(2); /* x1, j1 */ - if (!doSparse) { - PROTECT_WITH_INDEX( - res = allocVector((cl[0] != 'z') ? REALSXP : CPLXSXP, n), &pid); - ++nprotect; } else { - int nnz = n; - if (di == 'N') { - nnz = 0; - for (j = 0; j < n; ++j) - if (pp[j-1] < pp[j]) - ++nnz; - } - char cl_[] = ".sparseVector"; - cl_[0] = (((cl[0] == 'n' || cl[0] == 'l') && !doMean) - ? 'i' : ((cl[0] != 'z') ? 'd' : 'z')); - PROTECT(res = NEW_OBJECT_OF_CLASS(cl_)); - PROTECT(vl = ScalarInteger(n)); - PROTECT(vi = allocVector(INTSXP, nnz)); - PROTECT_WITH_INDEX( - vx = allocVector((cl[0] != 'z') ? REALSXP : CPLXSXP, nnz), &pid); - nprotect += 4; - pvi = INTEGER(vi); + SEXP x1 = res; + SUM_CASES(NOMAP); + } - if (cl[0] == 'n') { - double *pres = (doSparse) ? REAL(vx) : REAL(res); - if (!doSparse) { - int u = (di == 'N') ? 0 : 1; - for (j = 0; j < n; ++j) { - *pres = pp[j] - pp[j-1] + u; - if (doMean) - *pres /= count; - ++pres; - } - } else if (di == 'N') { - for (j = 0; j < n; ++j) { - if (pp[j-1] < pp[j]) { - *pvi = j + 1; - *pres = pp[j] - pp[j-1]; - if (doMean) - *pres /= count; - ++pvi; - ++pres; +#undef SUM_LOOP + + UNPROTECT(1); /* p0 */ + return; +} + +static +void Csparse_rowsum(SEXP obj, const char *class, + int m, int n, char di, int narm, int mean, + SEXP res, SEXP iSym) +{ + int narm_ = narm && mean && class[0] != 'n'; + + SEXP p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i0 = PROTECT(GET_SLOT(obj, iSym)); + int *pp0 = INTEGER(p0) + 1, *pi0 = INTEGER(i0), i, j, k, kend, + nnz0 = pp0[n - 1], nnz1 = m; + + if (IS_S4_OBJECT(res)) { + + int *work; + Matrix_Calloc(work, m, int); + if (di != 'N') + for (i = 0; i < m; ++i) + work[i] = i; + else { + if (class[1] != 's') { + for (k = 0; k < nnz0; ++k) + ++work[pi0[k]]; + } else { + for (j = 0, k = 0; j < n; ++j) { + kend = pp0[j]; + while (k < kend) { + ++work[pi0[k]]; + if (pi0[k] != j) + ++work[ j]; + ++k; + } } } - } else { - for (j = 0; j < n; ++j) { - *pvi = j + 1; - *pres = pp[j] - pp[j-1] + 1; - if (doMean) - *pres /= count; - ++pvi; - ++pres; - } + nnz1 = 0; + for (i = 0; i < m; ++i) + work[i] = (work[i]) ? nnz1++ : -1; } - } else { - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); -#define CR_COLSUMS_LOOP \ - do { \ - k = 0; \ - if (!doSparse) { \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - DO_INIT(ZERO); \ - while (k < kend) { DO_INCR; ++k; } \ - DO_SCALE; \ - ++pres; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - DO_INIT(ONE); \ - while (k < kend) { DO_INCR; ++k; } \ - DO_SCALE; \ - ++pres; \ + SEXP + i1 = PROTECT(allocVector(INTSXP, nnz1)), + x1 = PROTECT(allocVector(SUM_TYPEOF(class[0]), nnz1)); + SET_SLOT(res, Matrix_iSym, i1); + SET_SLOT(res, Matrix_xSym, x1); + int *pi1 = INTEGER(i1); + if (narm_) + for (i = 0; i < nnz1; ++i) + pi1[i] = n; + +#define SUM_LOOP(_CTYPE0_, _PTR0_, _CTYPE1_, _PTR1_, _MASK_, \ + _ZERO_, _ONE_, _NA_, _ISNA_, \ + _MAP_, _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + _MASK_(_CTYPE0_ *px0 = _PTR0_(x0)); \ + _CTYPE1_ *px1 = _PTR1_(x1) ; \ + _CTYPE1_ tmp = (di != 'N') ? _ONE_ : _ZERO_; \ + for (i = 0; i < nnz1; ++i) \ + px1[i] = tmp; \ + if (class[1] != 's') { \ + for (k = 0; k < nnz0; ++k) { \ + if (_ISNA_(px0[k])) { \ + if (!narm) \ + px1[_MAP_(pi0[k])] = _NA_; \ + else if (narm_) \ + --pi1[_MAP_(pi0[k])]; \ + } else { \ + tmp = _CAST_(px0[k]); \ + _INCREMENT_(px1[_MAP_(pi0[k])], tmp); \ } \ } \ } else { \ - if (di == 'N') { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - if (k < kend) { \ - *pvi = j + 1; \ - DO_INIT(ZERO); \ - while (k < kend) { DO_INCR; ++k; } \ - DO_SCALE; \ - ++pvi; \ - ++pres; \ + int off; \ + for (j = 0, k = 0; j < n; ++j) { \ + kend = pp0[j]; \ + while (k < kend) { \ + off = pi0[k] != j; \ + if (_ISNA_(px0[k])) { \ + if (!narm) { \ + px1[_MAP_(pi0[k])] = _NA_; \ + if (off) \ + px1[_MAP_( j)] = _NA_; \ + } else if (narm_) { \ + --pi1[_MAP_(pi0[k])]; \ + if (off) \ + --pi1[_MAP_( j)]; \ + } \ + } else { \ + tmp = _CAST_(px0[k]); \ + _INCREMENT_(px1[_MAP_(pi0[k])], tmp); \ + if (off) \ + _INCREMENT_(px1[_MAP_( j)], tmp); \ } \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - *pvi = j + 1; \ - DO_INIT(ONE); \ - while (k < kend) { DO_INCR; ++k; } \ - DO_SCALE; \ - ++pvi; \ - ++pres; \ + ++k; \ } \ } \ } \ + if (mean) { \ + if (narm_) \ + for (i = 0; i < nnz1; ++i) \ + _SCALE2_(px1[i], pi1[i]); \ + else \ + for (i = 0; i < nnz1; ++i) \ + _SCALE2_(px1[i], n); \ + } \ } while (0) -#define CR_COLSUMS(_CTYPE1_, _PTR1_, _CTYPE2_, _PTR2_) \ - do { \ - _CTYPE1_ *pres = (doSparse) ? _PTR1_(vx) : _PTR1_(res); \ - _CTYPE2_ *px = _PTR2_(x); \ - CR_COLSUMS_LOOP; \ - } while (0) + SUM_CASES(MAP); + for (i = 0; i < m; ++i) + if (work[i] >= 0) + *(pi1++) = i + 1; + Matrix_Free(work, m); + UNPROTECT(2); /* x1, i1 */ - switch (cl[0]) { - case 'l': + } else { -#define ZERO 0.0 -#define ONE 1.0 -#define DO_INIT(_U_) \ - do { \ - *pres = _U_; \ - if (doCount) \ - count = m; \ - } while (0) -#define DO_INCR \ - do { \ - if (px[k] != NA_LOGICAL) { \ - if (px[k]) *pres += 1.0; \ - } else if (!doNaRm) \ - *pres = NA_REAL; \ - else if (doMean) \ - --count; \ - } while (0) -#define DO_SCALE if (doMean) *pres /= count + SEXP x1 = res; + int *pi1 = NULL; + if (narm_) { + Matrix_Calloc(pi1, m, int); + for (i = 0; i < m; ++i) + pi1[i] = n; + } + SUM_CASES(NOMAP); + if (narm_) + Matrix_Free(pi1, m); - CR_COLSUMS(double, REAL, int, LOGICAL); - break; + } -#undef DO_INCR +#undef SUM_LOOP - case 'i': + UNPROTECT(2); /* i0, p0 */ + return; +} -#define DO_INCR \ - do { \ - if (px[k] != NA_INTEGER) \ - *pres += px[k]; \ - else if (!doNaRm) \ - *pres = NA_REAL; \ - else if (doMean) \ - --count; \ - } while (0) +static +void Tsparse_colsum(SEXP obj, const char *class, + int m, int n, char di, int narm, int mean, + SEXP res, SEXP iSym, SEXP jSym) +{ + int narm_ = narm && mean && class[0] != 'n'; + if (narm_) + obj = Tsparse_aggregate(obj); + PROTECT(obj); - CR_COLSUMS(double, REAL, int, INTEGER); - break; + SEXP i0 = PROTECT(GET_SLOT(obj, iSym)), + j0 = PROTECT(GET_SLOT(obj, jSym)); + int *pi0 = INTEGER(i0), *pj0 = INTEGER(j0), j, nnz1 = n; + R_xlen_t k, nnz0 = XLENGTH(i0); -#undef DO_INCR + if (IS_S4_OBJECT(res)) { - case 'd': + int *work; + Matrix_Calloc(work, n, int); + if (di != 'N') + for (j = 0; j < n; ++j) + work[j] = j; + else { + if (class[1] != 's') { + for (k = 0; k < nnz0; ++k) + ++work[pj0[k]]; + } else { + for (k = 0; k < nnz0; ++k) { + ++work[pj0[k]]; + if (pi0[k] != pj0[k]) + ++work[pi0[k]]; + } + } + nnz1 = 0; + for (j = 0; j < n; ++j) + work[j] = (work[j]) ? nnz1++ : -1; + } -#define DO_INCR \ - do { \ - if (!(doNaRm && ISNAN(px[k]))) \ - *pres += px[k]; \ - else if (doMean) \ - --count; \ - } while (0) + SEXP + j1 = PROTECT(allocVector(INTSXP, nnz1)), + x1 = PROTECT(allocVector(SUM_TYPEOF(class[0]), nnz1)); + SET_SLOT(res, Matrix_iSym, j1); + SET_SLOT(res, Matrix_xSym, x1); + int *pj1 = INTEGER(j1); + if (narm_) + for (j = 0; j < nnz1; ++j) + pj1[j] = m; + +#define SUM_LOOP(_CTYPE0_, _PTR0_, _CTYPE1_, _PTR1_, _MASK_, \ + _ZERO_, _ONE_, _NA_, _ISNA_, \ + _MAP_, _CAST_, _INCREMENT_, _SCALE2_) \ + do { \ + _MASK_(_CTYPE0_ *px0 = _PTR0_(x0)); \ + _CTYPE1_ *px1 = _PTR1_(x1) ; \ + _CTYPE1_ tmp = (di != 'N') ? _ONE_ : _ZERO_; \ + for (j = 0; j < nnz1; ++j) \ + px1[j] = tmp; \ + if (class[1] != 's') { \ + for (k = 0; k < nnz0; ++k) { \ + if (_ISNA_(px0[k])) { \ + if (!narm) \ + px1[_MAP_(pj0[k])] = _NA_; \ + else if (narm_) \ + --pj1[_MAP_(pj0[k])]; \ + } else { \ + tmp = _CAST_(px0[k]); \ + _INCREMENT_(px1[_MAP_(pj0[k])], tmp); \ + } \ + } \ + } else { \ + int off; \ + for (k = 0; k < nnz0; ++k) { \ + off = pi0[k] != pj0[k]; \ + if (_ISNA_(px0[k])) { \ + if (!narm) { \ + px1[_MAP_(pj0[k])] = _NA_; \ + if (off) \ + px1[_MAP_(pi0[k])] = _NA_; \ + } else if (narm_) { \ + --pj1[_MAP_(pj0[k])]; \ + if (off) \ + --pj1[_MAP_(pi0[k])]; \ + } \ + } else { \ + tmp = _CAST_(px0[k]); \ + _INCREMENT_(px1[_MAP_(pj0[k])], tmp); \ + if (off) \ + _INCREMENT_(px1[_MAP_(pi0[k])], tmp); \ + } \ + } \ + } \ + if (mean) { \ + if (narm_) \ + for (j = 0; j < nnz1; ++j) \ + _SCALE2_(px1[j], pj1[j]); \ + else \ + for (j = 0; j < nnz1; ++j) \ + _SCALE2_(px1[j], m); \ + } \ + } while (0) - CR_COLSUMS(double, REAL, double, REAL); - break; + SUM_CASES(MAP); + for (j = 0; j < n; ++j) + if (work[j] >= 0) + *(pj1++) = j + 1; + Matrix_Free(work, n); + UNPROTECT(2); /* x1, j1 */ -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_SCALE + } else { - case 'z': + SEXP x1 = res; + int *pj1 = NULL; + if (narm_) + Matrix_Calloc(pj1, n, int); + SUM_CASES(NOMAP); + if (narm_) + Matrix_Free(pj1, n); -#define ZERO Matrix_zzero -#define ONE Matrix_zone -#define DO_INCR \ - do { \ - if (!(doNaRm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { \ - (*pres).r += px[k].r; \ - (*pres).i += px[k].i; \ - } else if (doMean) \ - --count; \ - } while (0) -#define DO_SCALE \ - do { \ - if (doMean) { \ - (*pres).r /= count; \ - (*pres).i /= count; \ - } \ - } while (0) + } - CR_COLSUMS(Rcomplex, COMPLEX, Rcomplex, COMPLEX); - break; +#undef SUM_LOOP -#undef ZERO -#undef ONE -#undef DO_INIT -#undef DO_INCR -#undef DO_SCALE + UNPROTECT(3); /* j0, i0, obj */ + return; +} - default: - break; - } +SEXP sparse_marginsum(SEXP obj, const char *class, int margin, + int narm, int mean, int sparse) +{ + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1], + r = (margin == 0) ? m : n; -#undef CR_COLSUMS -#undef CR_COLSUMS_LOOP + SEXP res; + SEXPTYPE type = SUM_TYPEOF(class[0]); + if (sparse) { + char cl[] = ".sparseVector"; + cl[0] = (type == CPLXSXP) ? 'z' : ((type == REALSXP) ? 'd' : 'i'); + PROTECT(res = newObject(cl)); + + SEXP length = PROTECT(ScalarInteger(r)); + SET_SLOT(res, Matrix_lengthSym, length); + UNPROTECT(1); /* length */ + } else { + PROTECT(res = allocVector(type, r)); - UNPROTECT(1); /* x */ + SEXP dimnames = (class[1] != 's') + ? GET_SLOT(obj, Matrix_DimNamesSym) + : get_symmetrized_DimNames(obj, -1), + marnames = VECTOR_ELT(dimnames, margin); + if (marnames != R_NilValue) { + PROTECT(marnames); + setAttrib(res, R_NamesSymbol, marnames); + UNPROTECT(1); /* marnames */ + } } - if (doSparse) { - if ((cl[0] == 'n' || cl[0] == 'l') && !doMean) - REPROTECT(vx = coerceVector(vx, INTSXP), pid); + char di = 'N'; + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + di = *CHAR(STRING_ELT(diag, 0)); + } - SET_SLOT(res, Matrix_lengthSym, vl); - SET_SLOT(res, Matrix_iSym, vi); - SET_SLOT(res, Matrix_xSym, vx); + if (margin == 0) { + if (class[2] == 'C') { + Csparse_rowsum(obj, class, m, n, di, narm, mean, res, + Matrix_iSym); + } else if (class[2] == 'R') { + if (class[1] != 's') + Csparse_colsum(obj, class, n, m, di, narm, mean, res); + else + Csparse_rowsum(obj, class, n, m, di, narm, mean, res, + Matrix_jSym); + } else { + Tsparse_colsum(obj, class, n, m, di, narm, mean, res, + Matrix_jSym, Matrix_iSym); + } } else { - if ((cl[0] == 'n' || cl[0] == 'l') && !doMean) - REPROTECT(res = coerceVector(res, INTSXP), pid); - - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), - nms = VECTOR_ELT(dimnames, margin); - if (!isNull(nms)) - setAttrib(res, R_NamesSymbol, nms); - UNPROTECT(1); /* dimnames */ + if (class[2] == 'C') { + if (class[1] != 's') + Csparse_colsum(obj, class, m, n, di, narm, mean, res); + else + Csparse_rowsum(obj, class, m, n, di, narm, mean, res, + Matrix_iSym); + } else if (class[2] == 'R') { + Csparse_rowsum(obj, class, n, m, di, narm, mean, res, + Matrix_jSym); + } else { + Tsparse_colsum(obj, class, m, n, di, narm, mean, res, + Matrix_iSym, Matrix_jSym); + } } - UNPROTECT(nprotect); + UNPROTECT(1); /* res */ return res; } -/* rowSums(), colSums() */ -SEXP CRsparse_rowSums(SEXP obj, SEXP narm, SEXP mean, SEXP sparse) +/* (row|col)(Sums|Means)(<[CRT]sparseMatrix>) */ +SEXP R_sparse_marginsum(SEXP obj, SEXP margin, + SEXP narm, SEXP mean, SEXP sparse) { - static const char *valid[] = { VALID_CSPARSE, VALID_RSPARSE, "" }; - int ivalid = R_check_class_etc(obj, valid), nprotect = 0; + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); if (ivalid < 0) ERROR_INVALID_CLASS(obj, __func__); - const char *cl = valid[ivalid]; - int doSparse = asLogical(sparse) != 0, - doNaRm = asLogical(narm) != 0, - doMean = asLogical(mean) != 0; + int margin_; + if (TYPEOF(margin) != INTSXP || LENGTH(margin) < 1 || + ((margin_ = INTEGER(margin)[0]) != 0 && margin_ != 1)) + error(_("'%s' must be %d or %d"), "margin", 0, 1); + + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); + + int mean_; + if (TYPEOF(mean) != LGLSXP || LENGTH(mean) < 1 || + (mean_ = LOGICAL(mean)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "mean", "TRUE", "FALSE"); + + int sparse_; + if (TYPEOF(sparse) != LGLSXP || LENGTH(sparse) < 1 || + (sparse_ = LOGICAL(sparse)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "sparse", "TRUE", "FALSE"); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int margin = (cl[2] == 'C') ? 0 : 1, - *pdim = INTEGER(dim), m = pdim[margin], n = pdim[!margin]; - UNPROTECT(1); /* dim */ + return sparse_marginsum(obj, valid[ivalid], + margin_, narm_, mean_, sparse_); +} - char ul = 'U', di = 'N'; - if (cl[1] != 'g') { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ +#undef SUM_CASES +#undef SUM_TYPEOF - if (cl[1] == 't') { - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - if (doSparse && di != 'N') - warning(_("sparseResult=TRUE inefficient for unit triangular 'x'")); +#define TRY_INCREMENT(_LABEL_) \ + do { \ + if ((s >= 0) \ + ? ( t <= MATRIX_INT_FAST64_MAX - s) \ + : (-t <= s - MATRIX_INT_FAST64_MIN)) { \ + s += t; \ + t = 0; \ + count = 0; \ + } else { \ + over = 1; \ + goto _LABEL_; \ + } \ + } while (0) + +#define LONGDOUBLE_AS_DOUBLE(v) \ + (v > DBL_MAX) ? R_PosInf : ((v < -DBL_MAX) ? R_NegInf : (double) v); + +SEXP sparse_sum(SEXP obj, const char *class, int narm) +{ + if (class[2] == 'T') + obj = Tsparse_aggregate(obj); + PROTECT(obj); + + SEXP res; + + if (!narm && (class[0] == 'l' || class[0] == 'i')) { + SEXP x = GET_SLOT(obj, Matrix_xSym); + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + R_xlen_t nx = XLENGTH(x); + while (nx--) { + if (*px == NA_INTEGER) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = NA_INTEGER; + UNPROTECT(1); /* obj */ + return res; + } + ++px; } } - SEXP iSym = (cl[2] == 'C') ? Matrix_iSym : Matrix_jSym, - p = PROTECT(GET_SLOT(obj, Matrix_pSym)), - i = PROTECT(GET_SLOT(obj, iSym)); - nprotect += 2; - int *pp = INTEGER(p) + 1, *pi = INTEGER(i), j, k, kend, *pcount = NULL; + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - SEXP x = NULL; - if (cl[0] != 'n') { - PROTECT(x = GET_SLOT(obj, Matrix_xSym)); - ++nprotect; + char di = 'N'; + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + di = *CHAR(STRING_ELT(diag, 0)); } - PROTECT_INDEX pid; - SEXP res; - PROTECT_WITH_INDEX( - res = allocVector((cl[0] != 'z') ? REALSXP : CPLXSXP, m), &pid); - ++nprotect; + int symmetric = class[1] == 's'; -#define CR_ROWSUMS_LOOP \ - do { \ - k = 0; \ - if (cl[1] != 's') { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - while (k < kend) { DO_INCR; ++k; } \ - } \ - } else if (ul == ((cl[2] == 'C') ? 'U' : 'L')) { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - if (k < kend) { \ - while (kend - k > 1) { DO_INCR_SYMM; ++k; } \ - if (pi[k] == j) \ - DO_INCR; \ - else \ - DO_INCR_SYMM; \ - ++k; \ - } \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - kend = pp[j]; \ - if (k < kend) { \ - if (pi[k] == j) \ - DO_INCR; \ - else \ - DO_INCR_SYMM; \ - ++k; \ - while (k < kend) { DO_INCR_SYMM; ++k; } \ - } \ - } \ - } \ - } while (0) + if (class[2] != 'T') { -#define CR_ROWSUMS_X(_CTYPE1_, _PTR1_, _CTYPE2_, _PTR2_) \ - do { \ - _CTYPE2_ *px = _PTR2_(x); \ - CR_ROWSUMS_N(_CTYPE1_, _PTR1_); \ - } while (0) + SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, + p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, iSym)); + int *pp = INTEGER(p) + 1, *pi = INTEGER(i), j_, k = 0, kend, + n_ = (class[2] == 'C') ? n : m; -#define CR_ROWSUMS_N(_CTYPE1_, _PTR1_) \ - do { \ - _CTYPE1_ *pres = _PTR1_(res), u = (di == 'N') ? ZERO : ONE; \ - if (doNaRm && doMean && cl[0] != 'n') { \ - Matrix_Calloc(pcount, m, int); \ - for (k = 0; k < m; ++k) { \ - pres[k] = u; \ - pcount[k] = n; \ - } \ - } else { \ - for (k = 0; k < m; ++k) \ - pres[k] = u; \ - } \ - CR_ROWSUMS_LOOP; \ - } while (0) + if (class[0] == 'n') { + Matrix_int_fast64_t nnz = pp[n_ - 1]; + if (di != 'N') + nnz += n; + if (symmetric) { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + char ul = *CHAR(STRING_ELT(uplo, 0)); + + nnz *= 2; + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + if (k < kend && pi[(ul == 'U') ? kend - 1 : k] == j_) + --nnz; + k = kend; + } + } + if (nnz <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) nnz; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) nnz; + } + UNPROTECT(3); /* i, p, obj */ + return res; + } - switch (cl[0]) { - case 'n': + SEXP x = GET_SLOT(obj, Matrix_xSym); + UNPROTECT(2); /* i, p */ -#define ZERO 0.0 -#define ONE 1.0 -#define DO_INCR pres[pi[k]] += 1.0 -#define DO_INCR_SYMM \ - do { \ - pres[pi[k]] += 1.0; \ - pres[j] += 1.0; \ - } while (0) + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr = (di == 'N') ? 0.0L : n, zi = 0.0L; + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + while (k < kend) { + if (!(narm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { + zr += (symmetric && pi[k] != j_) + ? 2.0L * px[k].r : px[k].r; + zi += (symmetric && pi[k] != j_) + ? 2.0L * px[k].i : px[k].i; + } + ++k; + } + } + res = allocVector(CPLXSXP, 1); + COMPLEX(res)[0].r = LONGDOUBLE_AS_DOUBLE(zr); + COMPLEX(res)[0].i = LONGDOUBLE_AS_DOUBLE(zi); + } else if (class[0] == 'd') { + double *px = REAL(x); + long double zr = (di == 'N') ? 0.0L : n; + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + while (k < kend) { + if (!(narm && ISNAN(px[k]))) + zr += (symmetric && pi[k] != j_) + ? 2.0L * px[k] : px[k]; + ++k; + } + } + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else { + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + Matrix_int_fast64_t s = (di == 'N') ? 0LL : n, t = 0LL; + unsigned int count = 0; + int over = 0; + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + while (k < kend) { + if (!narm || px[k] != NA_INTEGER) { + int d = (symmetric && pi[k] != j_) ? 2 : 1; + if (count > UINT_MAX - d) + TRY_INCREMENT(ifoverC); + t += (d == 2) ? 2LL * px[k] : px[k]; + count += d; + } + ++k; + } + } + TRY_INCREMENT(ifoverC); + ifoverC: + if (over) { + long double zr = (long double) s + (long double) t; + for (; j_ < n_; ++j_) { + kend = pp[j_]; + while (k < kend) { + if (!narm || px[k] != NA_INTEGER) + zr += (symmetric && pi[k] != j_) + ? 2.0L * px[k] : px[k]; + ++k; + } + } + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else if (s > INT_MIN && s <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) s; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) s; + } + } - CR_ROWSUMS_N(double, REAL); - break; + } else { -#undef DO_INCR -#undef DO_INCR_SYMM + SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)), + j = PROTECT(GET_SLOT(obj, Matrix_jSym)); + int *pi = INTEGER(i), *pj = INTEGER(j); + R_xlen_t k, kend = XLENGTH(i); - case 'l': + if (class[0] == 'n') { + Matrix_int_fast64_t nnz = (Matrix_int_fast64_t) kend; + if (di != 'N') + nnz += n; + if (symmetric) { + nnz *= 2; + for (k = 0; k < kend; ++k) + if (pi[k] == pj[k]) + --nnz; + } + if (nnz <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) nnz; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) nnz; + } + UNPROTECT(3); /* j, i, obj */ + return res; + } -#define DO_INCR \ - do { \ - if (px[k] != NA_LOGICAL) { \ - if (px[k]) \ - pres[pi[k]] += 1.0; \ - } else if (!doNaRm) \ - pres[pi[k]] = NA_REAL; \ - else if (doMean) \ - --pcount[pi[k]]; \ - } while (0) -#define DO_INCR_SYMM \ - do { \ - if (px[k] != NA_LOGICAL) { \ - if (px[k]) { \ - pres[pi[k]] += 1.0; \ - pres[j] += 1.0; \ - } \ - } else if (!doNaRm) { \ - pres[pi[k]] = NA_REAL; \ - pres[j] = NA_REAL; \ - } else if (doMean) { \ - --pcount[pi[k]]; \ - --pcount[j]; \ - } \ - } while (0) + SEXP x = GET_SLOT(obj, Matrix_xSym); + UNPROTECT(2); /* j, i */ - CR_ROWSUMS_X(double, REAL, int, LOGICAL); - break; + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr = (di == 'N') ? 0.0L : n, zi = 0.0L; + for (k = 0; k < kend; ++k) + if (!(narm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { + zr += (symmetric && pi[k] != pj[k]) + ? 2.0L * px[k].r : px[k].r; + zi += (symmetric && pi[k] != pj[k]) + ? 2.0L * px[k].i : px[k].i; + } + res = allocVector(CPLXSXP, 1); + COMPLEX(res)[0].r = LONGDOUBLE_AS_DOUBLE(zr); + COMPLEX(res)[0].i = LONGDOUBLE_AS_DOUBLE(zi); + } else if (class[0] == 'd') { + double *px = REAL(x); + long double zr = (di == 'N') ? 0.0L : n; + for (k = 0; k < kend; ++k) + if (!(narm && ISNAN(px[k]))) + zr += (symmetric && pi[k] != pj[k]) + ? 2.0L * px[k] : px[k]; + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else { + int *px = (class[0] == 'i') ? INTEGER(x) : LOGICAL(x); + Matrix_int_fast64_t s = (di == 'N') ? 0LL : n, t = 0LL; + unsigned int count = 0; + int over = 0; + for (k = 0; k < kend; ++k) { + if (!narm || px[k] != NA_INTEGER) { + int d = (symmetric && pi[k] != pj[k]) ? 2 : 1; + if (count > UINT_MAX - d) + TRY_INCREMENT(ifoverT); + t += (d == 2) ? 2LL * px[k] : px[k]; + count += d; + } + } + TRY_INCREMENT(ifoverT); + ifoverT: + if (over) { + long double zr = (long double) s + (long double) t; + for (; k < kend; ++k) + if (!(narm && px[k] == NA_INTEGER)) + zr += (symmetric && pi[k] != pj[k]) + ? 2.0L * px[k] : px[k]; + res = allocVector(REALSXP, 1); + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + } else if (s > INT_MIN && s <= INT_MAX) { + res = allocVector(INTSXP, 1); + INTEGER(res)[0] = (int) s; + } else { + res = allocVector(REALSXP, 1); + REAL(res)[0] = (double) s; + } + } -#undef DO_INCR -#undef DO_INCR_SYMM + } - case 'i': + UNPROTECT(1); /* obj */ + return res; +} -#define DO_INCR \ - do { \ - if (px[k] != NA_INTEGER) \ - pres[pi[k]] += px[k]; \ - else if (!doNaRm) \ - pres[pi[k]] = NA_REAL; \ - else if (doMean) \ - --pcount[pi[k]]; \ - } while (0) -#define DO_INCR_SYMM \ - do { \ - if (px[k] != NA_INTEGER) { \ - pres[pi[k]] += px[k]; \ - pres[j] += px[k]; \ - } else if (!doNaRm) { \ - pres[pi[k]] = NA_REAL; \ - pres[j] = NA_REAL; \ - } else if (doMean) { \ - --pcount[pi[k]]; \ - --pcount[j]; \ - } \ - } while (0) +/* sum(<[CRT]sparseMatrix>) */ +SEXP R_sparse_sum(SEXP obj, SEXP narm) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); - CR_ROWSUMS_X(double, REAL, int, INTEGER); - break; + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); -#undef DO_INCR -#undef DO_INCR_SYMM + return sparse_sum(obj, valid[ivalid], narm_); +} - case 'd': +SEXP sparse_prod(SEXP obj, const char *class, int narm) +{ + if (class[2] == 'T') + obj = Tsparse_aggregate(obj); + PROTECT(obj); -#define DO_INCR \ - do { \ - if (!(doNaRm && ISNAN(px[k]))) \ - pres[pi[k]] += px[k]; \ - else if (doMean) \ - --pcount[pi[k]]; \ - } while (0) -#define DO_INCR_SYMM \ - do { \ - if (!(doNaRm && ISNAN(px[k]))) { \ - pres[pi[k]] += px[k]; \ - pres[j] += px[k]; \ - } else if (doMean) { \ - --pcount[pi[k]]; \ - --pcount[j]; \ - } \ - } while (0) + SEXP res = PROTECT(allocVector((class[0] == 'z') ? CPLXSXP : REALSXP, 1)); - CR_ROWSUMS_X(double, REAL, double, REAL); - break; + SEXP dim = GET_SLOT(obj, Matrix_DimSym); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_INCR_SYMM - - case 'z': - -#define ZERO Matrix_zzero -#define ONE Matrix_zone -#define DO_INCR \ - do { \ - if (!(doNaRm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { \ - pres[pi[k]].r += px[k].r; \ - pres[pi[k]].i += px[k].i; \ - } else if (doMean) \ - --pcount[pi[k]]; \ - } while (0) -#define DO_INCR_SYMM \ - do { \ - if (!(doNaRm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { \ - pres[pi[k]].r += px[k].r; \ - pres[pi[k]].i += px[k].i; \ - pres[j].r += px[k].r; \ - pres[j].i += px[k].i; \ - } else if (doMean) { \ - --pcount[pi[k]]; \ - --pcount[j]; \ - } \ - } while (0) + char ul = 'U', di = 'N'; + if (class[1] != 'g') { + SEXP uplo = GET_SLOT(obj, Matrix_uploSym); + ul = *CHAR(STRING_ELT(uplo, 0)); + if (class[1] == 't') { + SEXP diag = GET_SLOT(obj, Matrix_diagSym); + di = *CHAR(STRING_ELT(diag, 0)); + } + } - CR_ROWSUMS_X(Rcomplex, COMPLEX, Rcomplex, COMPLEX); - break; + int symmetric = (class[1] != 's') + ? 0 : (((class[2] == 'C') == (ul == 'U')) ? 1 : -1); + long double zr = 1.0L, zi = 0.0L; -#undef ZERO -#undef ONE -#undef DO_INCR -#undef DO_INCR_SYMM + Matrix_int_fast64_t mn = (Matrix_int_fast64_t) m * n, + nnz, nnzmax = (symmetric) ? (mn + n) / 2 : mn; - default: - break; - } + if (class[2] != 'T') { + + SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym, + p = PROTECT(GET_SLOT(obj, Matrix_pSym)), + i = PROTECT(GET_SLOT(obj, iSym)); + int *pp = INTEGER(p) + 1, *pi = INTEGER(i), i_, j_, k = 0, kend, + m_ = (class[2] == 'C') ? m : n, n_ = (class[2] == 'C') ? n : m, + seen0 = 0; -#undef CR_ROWSUMS -#undef CR_ROWSUMS_LOOP + nnz = pp[n_ - 1]; + if (di != 'N') + nnz += n; + if (class[0] == 'n') { + REAL(res)[0] = (nnz == nnzmax) ? 1.0 : 0.0; + UNPROTECT(4); /* i, p, res, obj */ + return res; + } - if (doMean) { - if (cl[0] != 'z') { - double *pres = REAL(res); - if (doNaRm && cl[0] != 'n') { - for (k = 0; k < m; ++k) - pres[k] /= pcount[k]; - Matrix_Free(pcount, m); - } else { - for (k = 0; k < m; ++k) - pres[k] /= n; + SEXP x = GET_SLOT(obj, Matrix_xSym); + UNPROTECT(2); /* i, p */ + + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr0, zi0; + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + if (seen0 || kend - k == m_) { + while (k < kend) { + if (!(narm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + if (symmetric && pi[k] != j_) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + } + } + ++k; + } + } else { + int i0 = (symmetric >= 0) ? 0 : j_, + i1 = (symmetric <= 0) ? m_ : j_ + 1; + for (i_ = i0; i_ < i1; ++i_) { + if (seen0 || (k < kend && pi[k] == i_)) { + if (k >= kend) + break; + if (!(narm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + if (symmetric && pi[k] != j_) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + } + } + ++k; + } else if (di == 'N' || i_ != j_) { + zr *= 0.0L; + zi *= 0.0L; + seen0 = 1; + } + } + } } - } else { - Rcomplex *pres = COMPLEX(res); - if (doNaRm) { - for (k = 0; k < m; ++k) { - pres[k].r /= pcount[k]; - pres[k].i /= pcount[k]; + } else if (class[0] == 'd') { + double *px = REAL(x); + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + if (seen0 || kend - k == m_) { + while (k < kend) { + if (!(narm && ISNAN(px[k]))) + zr *= (symmetric && pi[k] != j_) + ? (long double) px[k] * px[k] : px[k]; + ++k; + } + } else { + int i0 = (symmetric >= 0) ? 0 : j_, + i1 = (symmetric <= 0) ? m_ : j_ + 1; + for (i_ = i0; i_ < i1; ++i_) { + if (seen0 || (k < kend && pi[k] == i_)) { + if (k >= kend) + break; + if (!(narm && ISNAN(px[k]))) + zr *= (symmetric && pi[k] != j_) + ? (long double) px[k] * px[k] : px[k]; + ++k; + } else if (di == 'N' || i_ != j_) { + zr *= 0.0L; + seen0 = 1; + } + } } - Matrix_Free(pcount, m); - } else { - for (k = 0; k < m; ++k) { - pres[k].r /= n; - pres[k].i /= n; + } + } else { + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + for (j_ = 0; j_ < n_; ++j_) { + kend = pp[j_]; + if (seen0 || kend - k == m_) { + while (k < kend) { + if (px[k] != NA_INTEGER) + zr *= (symmetric && pi[k] != j_) + ? (long double) px[k] * px[k] : px[k]; + else if (!narm) + zr *= NA_REAL; + ++k; + } + } else { + int i0 = (symmetric >= 0) ? 0 : j_, + i1 = (symmetric <= 0) ? m_ : j_ + 1; + for (i_ = i0; i_ < i1; ++i_) { + if (seen0 || (k < kend && pi[k] == i_)) { + if (k >= kend) + break; + if (px[k] != NA_INTEGER) + zr *= (symmetric && pi[k] != j_) + ? (long double) px[k] * px[k] : px[k]; + else if (!narm) + zr *= NA_REAL; + ++k; + } else if (di == 'N' || i_ != j_) { + zr *= 0.0L; + seen0 = 1; + } + } } } } - } - if ((cl[0] == 'n' || cl[0] == 'l') && !doMean) - REPROTECT(res = coerceVector(res, INTSXP), pid); - if (doSparse) { - /* defined in ./sparseVector.c : */ - SEXP v2spV(SEXP); - REPROTECT(res = v2spV(res), pid); } else { - SEXP dimnames; - if (cl[1] != 's') - PROTECT(dimnames = GET_SLOT(obj, Matrix_DimNamesSym)); - else - PROTECT(dimnames = get_symmetrized_DimNames(obj, -1)); - SEXP nms = VECTOR_ELT(dimnames, margin); - if (!isNull(nms)) - setAttrib(res, R_NamesSymbol, nms); - UNPROTECT(1); /* dimnames */ + + SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)), + j = PROTECT(GET_SLOT(obj, Matrix_jSym)); + int *pi = INTEGER(i), *pj = INTEGER(j); + R_xlen_t k, kend = XLENGTH(i); + + nnz = (Matrix_int_fast64_t) kend; + if (di != 'N') + nnz += n; + if (class[0] == 'n') { + REAL(res)[0] = (nnz == nnzmax) ? 1.0 : 0.0; + UNPROTECT(4); /* j, i, res, obj */ + return res; + } + if (nnz < nnzmax) + zr = 0.0; + + SEXP x = GET_SLOT(obj, Matrix_xSym); + UNPROTECT(2); /* j, i */ + + if (class[0] == 'z') { + Rcomplex *px = COMPLEX(x); + long double zr0, zi0; + for (k = 0; k < kend; ++k) + if (!(narm && (ISNAN(px[k].r) || ISNAN(px[k].i)))) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + if (symmetric && pi[k] != pj[k]) { + zr0 = zr; zi0 = zi; + zr = zr0 * px[k].r - zi0 * px[k].i; + zi = zr0 * px[k].i + zi0 * px[k].r; + } + } + } else if (class[0] == 'd') { + double *px = REAL(x); + for (k = 0; k < kend; ++k) + if (!(narm && ISNAN(px[k]))) + zr *= (symmetric && pi[k] != pj[k]) + ? (long double) px[k] * px[k] : px[k]; + } else { + int *px = (class[0] == 'l') ? LOGICAL(x) : INTEGER(x); + for (k = 0; k < kend; ++k) + if (px[k] != NA_INTEGER) + zr *= (symmetric && pi[k] != pj[k]) + ? (long double) px[k] * px[k] : px[k]; + else if (!narm) + zr *= NA_REAL; + } + } - UNPROTECT(nprotect); + if (class[0] == 'z') { + COMPLEX(res)[0].r = LONGDOUBLE_AS_DOUBLE(zr); + COMPLEX(res)[0].i = LONGDOUBLE_AS_DOUBLE(zi); + } else + REAL(res)[0] = LONGDOUBLE_AS_DOUBLE(zr); + UNPROTECT(2); /* res, obj */ return res; } + +/* prod(<[CRT]sparseMatrix>) */ +SEXP R_sparse_prod(SEXP obj, SEXP narm) +{ + static const char *valid[] = { + VALID_CSPARSE, VALID_RSPARSE, VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(obj, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(obj, __func__); + + int narm_; + if (TYPEOF(narm) != LGLSXP || LENGTH(narm) < 1 || + (narm_ = LOGICAL(narm)[0]) == NA_LOGICAL) + error(_("'%s' must be %s or %s"), "narm", "TRUE", "FALSE"); + + return sparse_prod(obj, valid[ivalid], narm_); +} + +#undef TRY_INCREMENT +#undef LONGDOUBLE_AS_DOUBLE + +SEXP Tsparse_aggregate(SEXP from) +{ + static const char *valid[] = { VALID_TSPARSE, "" }; + int ivalid = R_check_class_etc(from, valid); + if (ivalid < 0) + ERROR_INVALID_CLASS(from, __func__); + const char *cl = valid[ivalid]; + + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + UNPROTECT(1); /* dim */ + + SEXP to, + i0 = PROTECT(GET_SLOT(from, Matrix_iSym)), + j0 = PROTECT(GET_SLOT(from, Matrix_jSym)), + i1 = NULL, j1 = NULL; + + /* defined in ./coerce.c : */ + void taggr(SEXP, SEXP, SEXP, SEXP *, SEXP *, SEXP *, int, int); + + if (cl[0] == 'n') { + taggr(j0, i0, NULL, &j1, &i1, NULL, n, m); + if (!i1) { + UNPROTECT(2); /* j0, i0 */ + return from; + } + PROTECT(i1); + PROTECT(j1); + PROTECT(to = newObject(cl)); + SET_SLOT(to, Matrix_iSym, i1); + SET_SLOT(to, Matrix_jSym, j1); + UNPROTECT(5); /* to, j1, i1, j0, i0 */ + } else { + SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), + x1 = NULL; + taggr(j0, i0, x0, &j1, &i1, &x1, n, m); + if (!i1) { + UNPROTECT(3); /* x0, j0, i0 */ + return from; + } + PROTECT(i1); + PROTECT(j1); + PROTECT(x1); + PROTECT(to = newObject(cl)); + SET_SLOT(to, Matrix_iSym, i1); + SET_SLOT(to, Matrix_jSym, j1); + SET_SLOT(to, Matrix_xSym, x1); + UNPROTECT(7); /* to, x1, j1, i1, x0, j0, i0 */ + } + + PROTECT(to); + + if (m != n || n > 0) { + PROTECT(dim = GET_SLOT(to, Matrix_DimSym)); + pdim = INTEGER(dim); + pdim[0] = m; + pdim[1] = n; + UNPROTECT(1); /* dim */ + } + + SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); + SET_SLOT(to, Matrix_DimNamesSym, dimnames); + UNPROTECT(1); /* dimnames */ + + if (cl[1] != 'g') { + SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); + char ul = *CHAR(STRING_ELT(uplo, 0)); + if (ul != 'U') + SET_SLOT(to, Matrix_uploSym, uplo); + UNPROTECT(1); /* uplo */ + } + if (cl[1] == 't') { + SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); + char di = *CHAR(STRING_ELT(diag, 0)); + if (di != 'N') + SET_SLOT(to, Matrix_diagSym, diag); + UNPROTECT(1); /* diag */ + } else { + SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorsSym)); + if (LENGTH(factors) > 0) + SET_SLOT(to, Matrix_factorsSym, factors); + UNPROTECT(1); /* factors */ + } + + UNPROTECT(1); /* to */ + return to; +} diff -Nru rmatrix-1.6-1.1/src/sparse.h rmatrix-1.6-5/src/sparse.h --- rmatrix-1.6-1.1/src/sparse.h 2023-08-03 02:38:42.000000000 +0000 +++ rmatrix-1.6-5/src/sparse.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,53 +1,56 @@ #ifndef MATRIX_SPARSE_H #define MATRIX_SPARSE_H -#include "Mutils.h" +#include -SEXP sparse_drop0(SEXP from, const char *class, double tol); -SEXP R_sparse_drop0(SEXP from, SEXP tol); +SEXP sparse_drop0(SEXP, const char *, double); +SEXP R_sparse_drop0(SEXP, SEXP); -SEXP sparse_band(SEXP from, const char *class, int a, int b); -SEXP R_sparse_band(SEXP from, SEXP k1, SEXP k2); +SEXP sparse_diag_U2N(SEXP, const char *); +SEXP R_sparse_diag_U2N(SEXP); -SEXP sparse_diag_get(SEXP obj, const char *class, int names); -SEXP R_sparse_diag_get(SEXP obj, SEXP names); +SEXP sparse_diag_N2U(SEXP, const char *); +SEXP R_sparse_diag_N2U(SEXP); -SEXP sparse_diag_set(SEXP from, const char *class, SEXP value); -SEXP R_sparse_diag_set(SEXP from, SEXP value); +SEXP sparse_band(SEXP, const char *, int, int); +SEXP R_sparse_band(SEXP, SEXP, SEXP); -SEXP sparse_diag_U2N(SEXP from, const char *class); -SEXP R_sparse_diag_U2N(SEXP from); +SEXP sparse_diag_get(SEXP, const char *, int); +SEXP R_sparse_diag_get(SEXP, SEXP); -SEXP sparse_diag_N2U(SEXP from, const char *class); -SEXP R_sparse_diag_N2U(SEXP from); +SEXP sparse_diag_set(SEXP, const char *, SEXP); +SEXP R_sparse_diag_set(SEXP, SEXP); -SEXP sparse_transpose(SEXP from, const char *class, int lazy); -SEXP R_sparse_transpose(SEXP from, SEXP lazy); +SEXP sparse_transpose(SEXP, const char *, int); +SEXP R_sparse_transpose(SEXP, SEXP); -SEXP sparse_force_symmetric(SEXP from, const char *class, char ul); -SEXP R_sparse_force_symmetric(SEXP from, SEXP uplo); +SEXP sparse_force_symmetric(SEXP, const char *, char); +SEXP R_sparse_force_symmetric(SEXP, SEXP); -SEXP sparse_symmpart(SEXP from, const char *class); -SEXP R_sparse_symmpart(SEXP from); +SEXP sparse_symmpart(SEXP, const char *); +SEXP R_sparse_symmpart(SEXP); -SEXP sparse_skewpart(SEXP from, const char *class); -SEXP R_sparse_skewpart(SEXP from); +SEXP sparse_skewpart(SEXP, const char *); +SEXP R_sparse_skewpart(SEXP); -SEXP Tsparse_aggregate(SEXP from); +int sparse_is_symmetric(SEXP, const char *, int); +SEXP R_sparse_is_symmetric(SEXP, SEXP); -SEXP Csparse_is_diagonal(SEXP obj); -SEXP Rsparse_is_diagonal(SEXP obj); -SEXP Tsparse_is_diagonal(SEXP obj); -SEXP Csparse_is_triangular(SEXP obj, SEXP upper); -SEXP Rsparse_is_triangular(SEXP obj, SEXP upper); -SEXP Tsparse_is_triangular(SEXP obj, SEXP upper); -SEXP Csparse_is_symmetric(SEXP obj, SEXP checkDN); -SEXP Rsparse_is_symmetric(SEXP obj, SEXP checkDN); -#if 0 /* unimplemented ... currently going via CsparseMatrix */ -SEXP Tsparse_is_symmetric(SEXP obj, SEXP checkDN); -#endif +int sparse_is_triangular(SEXP, const char *, int); +SEXP R_sparse_is_triangular(SEXP, SEXP); -SEXP CRsparse_colSums(SEXP obj, SEXP narm, SEXP mean, SEXP sparse); -SEXP CRsparse_rowSums(SEXP obj, SEXP narm, SEXP mean, SEXP sparse); +int sparse_is_diagonal(SEXP, const char *); +SEXP R_sparse_is_diagonal(SEXP); -#endif +SEXP sparse_marginsum(SEXP, const char *, int, int, int, int); +SEXP R_sparse_marginsum(SEXP, SEXP, SEXP, SEXP, SEXP); + +SEXP sparse_sum(SEXP, const char *, int); +SEXP R_sparse_sum(SEXP, SEXP); + +SEXP sparse_prod(SEXP, const char *, int); +SEXP R_sparse_prod(SEXP, SEXP); + +SEXP Tsparse_aggregate(SEXP); + +#endif /* MATRIX_SPARSE_H */ diff -Nru rmatrix-1.6-1.1/src/sparseVector.c rmatrix-1.6-5/src/sparseVector.c --- rmatrix-1.6-1.1/src/sparseVector.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/sparseVector.c 2023-09-22 05:53:14.000000000 +0000 @@ -1,3 +1,4 @@ +#include "Mdefines.h" #include "sparseVector.h" SEXP v2spV(SEXP from) @@ -9,7 +10,7 @@ _CTYPE1_, _SEXPTYPE1_, _PTR1_, \ _CTYPE2_, _SEXPTYPE2_, _PTR2_) \ do { \ - PROTECT(to = NEW_OBJECT_OF_CLASS(#_KIND_ "sparseVector")); \ + PROTECT(to = newObject(#_KIND_ "sparseVector")); \ _CTYPE1_ *py = _PTR1_(from); \ for (k = 0; k < n; ++k) \ if (_NZ_(py[k])) \ @@ -80,18 +81,21 @@ ERROR_INVALID_CLASS(from, __func__); const char *cl = valid[ivalid]; + SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); + int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; + Matrix_int_fast64_t mn = (Matrix_int_fast64_t) m * n; + UNPROTECT(1); /* dim */ + + if (mn > 0x1.0p+53) + error(_("%s length cannot exceed %s"), "sparseVector", "2^53"); + /* defined in ./coerce.c : */ SEXP sparse_as_general(SEXP, const char *); PROTECT(from = sparse_as_general(from, cl)); char vcl[] = ".sparseVector"; vcl[0] = cl[0]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(vcl)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - Matrix_int_fast64_t mn = (Matrix_int_fast64_t) m * n; - UNPROTECT(1); /* dim */ + SEXP to = PROTECT(newObject(vcl)); SEXP p = PROTECT(GET_SLOT(from, Matrix_pSym)); int *pp = INTEGER(p), nnz = (cl[2] == 'C') ? pp[n] : pp[m]; diff -Nru rmatrix-1.6-1.1/src/sparseVector.h rmatrix-1.6-5/src/sparseVector.h --- rmatrix-1.6-1.1/src/sparseVector.h 2023-07-29 15:44:26.000000000 +0000 +++ rmatrix-1.6-5/src/sparseVector.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,9 +1,9 @@ #ifndef MATRIX_SPARSEVECTOR_H #define MATRIX_SPARSEVECTOR_H -#include "Mutils.h" +#include -SEXP v2spV(SEXP from); -SEXP CR2spV(SEXP from); +SEXP v2spV(SEXP); +SEXP CR2spV(SEXP); #endif /* MATRIX_SPARSEVECTOR_H */ diff -Nru rmatrix-1.6-1.1/src/subscript.c rmatrix-1.6-5/src/subscript.c --- rmatrix-1.6-1.1/src/subscript.c 2023-08-08 12:58:01.000000000 +0000 +++ rmatrix-1.6-5/src/subscript.c 2023-09-22 05:53:14.000000000 +0000 @@ -1,3 +1,4 @@ +#include "Mdefines.h" #include "subscript.h" #define F_X( _X_) (_X_) @@ -7,7 +8,8 @@ #define AR21_UP(i, j, m) i + j + ( j * ( j - 1)) / 2 #define AR21_LO(i, j, m) i + (j * m + j * (m - j - 1)) / 2 -static SEXP unpackedMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) +static +SEXP unpackedMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) { #define SUB1_START(_SEXPTYPE_) \ @@ -38,7 +40,7 @@ } \ } - SUB1_START_EXTRA(kind2type(cl[0])); + SUB1_START_EXTRA(kindToType(cl[0])); #define SUB1_CASES(_SUB1_N_, _SUB1_X_, _F_N_, _F_X_) \ do { \ @@ -141,9 +143,10 @@ return res; } -static SEXP packedMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) +static +SEXP packedMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) { - SUB1_START_EXTRA(kind2type(cl[0])); + SUB1_START_EXTRA(kindToType(cl[0])); #define SUB1_LOOP(_NA_SUBSCRIPT_, _NA_, _ZERO_, _ONE_, _F_, _INT_) \ do { \ @@ -196,9 +199,10 @@ return res; } -static SEXP CsparseMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) +static +SEXP CsparseMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP p = PROTECT(GET_SLOT(x, Matrix_pSym)), i = PROTECT(GET_SLOT(x, Matrix_iSym)); @@ -262,9 +266,10 @@ return res; } -static SEXP RsparseMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) +static +SEXP RsparseMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP p = PROTECT(GET_SLOT(x, Matrix_pSym)), j = PROTECT(GET_SLOT(x, Matrix_jSym)); @@ -328,9 +333,10 @@ return res; } -static SEXP diagonalMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) +static +SEXP diagonalMatrix_subscript_1ary(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP diag = PROTECT(GET_SLOT(x, Matrix_diagSym)); int nonunit = *CHAR(STRING_ELT(diag, 0)) == 'N'; @@ -360,7 +366,8 @@ return res; } -static SEXP indMatrix_subscript_1ary(SEXP x, SEXP w) +static +SEXP indMatrix_subscript_1ary(SEXP x, SEXP w) { SUB1_START(LGLSXP); @@ -451,7 +458,8 @@ } } -static SEXP unpackedMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) +static +SEXP unpackedMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) { #define SUB1_START(_SEXPTYPE_) \ @@ -482,7 +490,7 @@ } \ } - SUB1_START_EXTRA(kind2type(cl[0])); + SUB1_START_EXTRA(kindToType(cl[0])); Matrix_int_fast64_t i_, j_; @@ -528,9 +536,10 @@ return res; } -static SEXP packedMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) +static +SEXP packedMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) { - SUB1_START_EXTRA(kind2type(cl[0])); + SUB1_START_EXTRA(kindToType(cl[0])); Matrix_int_fast64_t i_, j_; @@ -583,9 +592,10 @@ return res; } -static SEXP CsparseMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) +static +SEXP CsparseMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP p = PROTECT(GET_SLOT(x, Matrix_pSym)), i = PROTECT(GET_SLOT(x, Matrix_iSym)); @@ -645,9 +655,10 @@ return res; } -static SEXP RsparseMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) +static +SEXP RsparseMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP p = PROTECT(GET_SLOT(x, Matrix_pSym)), j = PROTECT(GET_SLOT(x, Matrix_jSym)); @@ -707,9 +718,10 @@ return res; } -static SEXP diagonalMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) +static +SEXP diagonalMatrix_subscript_1ary_mat(SEXP x, SEXP w, const char *cl) { - SUB1_START(kind2type(cl[0])); + SUB1_START(kindToType(cl[0])); SEXP diag = PROTECT(GET_SLOT(x, Matrix_diagSym)); int nonunit = *CHAR(STRING_ELT(diag, 0)) == 'N'; @@ -737,7 +749,8 @@ return res; } -static SEXP indMatrix_subscript_1ary_mat(SEXP x, SEXP w) +static +SEXP indMatrix_subscript_1ary_mat(SEXP x, SEXP w) { SUB1_START(LGLSXP); @@ -826,7 +839,8 @@ } } -static int keep_tr(int *pi, int *pj, int n, int upper, int nonunit, int checkNA) +static +int keep_tr(int *pi, int *pj, int n, int upper, int nonunit, int checkNA) { int k, ident = memcmp(pi, pj, n * sizeof(int)) == 0; if (checkNA) { @@ -897,7 +911,8 @@ } } -static int keep_sy(int *pi, int *pj, int n, int upper, int checkNA) +static +int keep_sy(int *pi, int *pj, int n, int upper, int checkNA) { if (memcmp(pi, pj, n * sizeof(int)) != 0) return 0; @@ -927,7 +942,8 @@ return 2 * r; } -static int keep_di(int *pi, int *pj, int n, int nonunit, int checkNA, int lwork) +static +int keep_di(int *pi, int *pj, int n, int nonunit, int checkNA, int lwork) { int k, ident = memcmp(pi, pj, n * sizeof(int)) == 0; if (checkNA) { @@ -970,7 +986,8 @@ } } -static void sort_cr(SEXP obj, const char *cl) +static +void sort_cr(SEXP obj, const char *cl) { SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); int *pdim = INTEGER(dim), @@ -1135,8 +1152,8 @@ ? *(_X_ + AR21_LO(_I_, _J_, _M_)) \ : *(_X_ + AR21_LO(_J_, _I_, _M_))) -static SEXP unpackedMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP unpackedMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { #define SUB2_START \ @@ -1187,7 +1204,7 @@ } \ } \ } \ - SEXP res = PROTECT(NEW_OBJECT_OF_CLASS(cl_)); \ + SEXP res = PROTECT(newObject(cl_)); \ \ PROTECT(dim = GET_SLOT(res, Matrix_DimSym)); \ pdim = INTEGER(dim); \ @@ -1389,8 +1406,8 @@ return res; } -static SEXP packedMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP packedMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { SUB2_START_EXTRA('e', 'p', 'p', 1); @@ -1498,8 +1515,8 @@ return res; } -static SEXP CsparseMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP CsparseMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { SUB2_START_EXTRA('C', 'C', 'C', 0); @@ -1651,8 +1668,8 @@ return res; } -static SEXP RsparseMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP RsparseMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { SUB2_START_EXTRA('R', 'R', 'R', 0); @@ -1799,8 +1816,8 @@ return res; } -static SEXP diagonalMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP diagonalMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { SUB2_START; @@ -1813,12 +1830,13 @@ cl_[0] = cl[0]; if (!(mi || mj) && ni == nj) { keep = keep_di(pi, pj, ni, nonunit, 0, m); - if (keep) { + if (keep > 0) { cl_[1] = 'd'; cl_[2] = 'i'; } } - SEXP res = PROTECT(NEW_OBJECT_OF_CLASS(cl_)); + + SEXP res = PROTECT(newObject(cl_)); PROTECT(dim = GET_SLOT(res, Matrix_DimSym)); pdim = INTEGER(dim); @@ -1833,7 +1851,7 @@ SET_STRING_ELT(diag, 0, diag_); UNPROTECT(2); /* diag_, diag */ - } else if (keep) { + } else if (keep > 0) { SEXP x0 = PROTECT(GET_SLOT(x, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), ni)); @@ -1858,31 +1876,73 @@ } else { + SEXP x0 = PROTECT(GET_SLOT(x, Matrix_xSym)); + char *work = NULL; + int j_; + + if (nonunit) { + + Matrix_Calloc(work, n, char); + +#define SUB2_WORK(_CTYPE_, _PTR_, _ISNZ_) \ + do { \ + _CTYPE_ *px0 = _PTR_(x0); \ + for (j_ = 0; j_ < n; ++j_) \ + work[j_] = _ISNZ_(px0[j_]); \ + } while (0) + + switch (cl[0]) { + case 'n': + SUB2_WORK(int, LOGICAL, ISNZ_PATTERN); + break; + case 'l': + SUB2_WORK(int, LOGICAL, ISNZ_LOGICAL); + break; + case 'i': + SUB2_WORK(int, INTEGER, ISNZ_INTEGER); + break; + case 'd': + SUB2_WORK(double, REAL, ISNZ_REAL); + break; + case 'z': + SUB2_WORK(Rcomplex, COMPLEX, ISNZ_COMPLEX); + break; + default: + break; + } + +#undef SUB2_WORK + + } + SEXP p1 = PROTECT(allocVector(INTSXP, (R_xlen_t) nj + 1)); - int *pp1 = INTEGER(p1), j_; + int *pp1 = INTEGER(p1); *(pp1++) = 0; for (kj = 0; kj < nj; ++kj) { pp1[kj] = 0; j_ = (mj) ? kj : pj[kj] - 1; - if (mi) { - for (ki = 0; ki < ni; ++ki) - if (ki == j_) - ++pp1[kj]; - } else { - for (ki = 0; ki < ni; ++ki) - if (pi[ki] - 1 == j_) - ++pp1[kj]; + if (!nonunit || work[j_]) { + if (mi) { + for (ki = 0; ki < ni; ++ki) + if (ki == j_) + ++pp1[kj]; + } else { + for (ki = 0; ki < ni; ++ki) + if (pi[ki] - 1 == j_) + ++pp1[kj]; + } + if (pp1[kj] > INT_MAX - pp1[kj - 1]) { + if (nonunit) + Matrix_Free(work, n); + error(_("%s too dense for %s; would have more than %s nonzero entries"), + "x[i,j]", "[CR]sparseMatrix", "2^31-1"); + } } - if (pp1[kj] > INT_MAX - pp1[kj - 1]) - error(_("%s too dense for %s; would have more than %s nonzero entries"), \ - "x[i,j]", "[CR]sparseMatrix", "2^31-1"); \ - pp1[kj] += pp1[kj-1]; } SEXP i1 = PROTECT(allocVector(INTSXP, pp1[nj - 1])), - x0 = PROTECT(GET_SLOT(x, Matrix_xSym)), x1 = PROTECT(allocVector(TYPEOF(x0), pp1[nj - 1])); int *pi1 = INTEGER(i1); @@ -1891,10 +1951,12 @@ _CTYPE_ *px0 = _PTR_(x0), *px1 = _PTR_(x1); \ for (kj = 0; kj < nj; ++kj) { \ j_ = (mj) ? kj : pj[kj] - 1; \ - for (ki = 0; ki < ni; ++ki) { \ - if (((mi) ? ki : pi[ki] - 1) == j_) { \ - *(pi1++) = ki; \ - *(px1++) = (nonunit) ? px0[j_] : _ONE_; \ + if (!nonunit || work[j_]) { \ + for (ki = 0; ki < ni; ++ki) { \ + if (((mi) ? ki : pi[ki] - 1) == j_) { \ + *(pi1++) = ki; \ + *(px1++) = (nonunit) ? px0[j_] : _ONE_; \ + } \ } \ } \ } \ @@ -1909,14 +1971,17 @@ SET_SLOT(res, Matrix_xSym, x1); UNPROTECT(4); /* x1, x0, i1, p1 */ + if (nonunit) + Matrix_Free(work, n); + } UNPROTECT(1); /* res */ return res; } -static SEXP indMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, - const char *cl) +static +SEXP indMatrix_subscript_2ary(SEXP x, SEXP i, SEXP j, const char *cl) { PROTECT_INDEX pidA; PROTECT_WITH_INDEX(x, &pidA); @@ -1965,7 +2030,7 @@ Matrix_Free(work, m); } - x = NEW_OBJECT_OF_CLASS((isP) ? "pMatrix" : "indMatrix"); + x = newObject((isP) ? "pMatrix" : "indMatrix"); REPROTECT(x, pidA); PROTECT(dim = GET_SLOT(x, Matrix_DimSym)); @@ -2009,7 +2074,7 @@ Matrix_Free(work, nj); } - x = NEW_OBJECT_OF_CLASS((isP) + x = newObject((isP) ? "pMatrix" : ((!mg) ? "ngCMatrix" : "ngRMatrix")); REPROTECT(x, pidA); diff -Nru rmatrix-1.6-1.1/src/subscript.h rmatrix-1.6-5/src/subscript.h --- rmatrix-1.6-1.1/src/subscript.h 2023-07-29 15:44:26.000000000 +0000 +++ rmatrix-1.6-5/src/subscript.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,10 +1,10 @@ #ifndef MATRIX_SUBSCRIPT_H #define MATRIX_SUBSCRIPT_H -#include "Mutils.h" +#include -SEXP R_subscript_1ary (SEXP x, SEXP i); -SEXP R_subscript_1ary_mat(SEXP x, SEXP i); -SEXP R_subscript_2ary (SEXP x, SEXP i, SEXP j); +SEXP R_subscript_1ary (SEXP, SEXP); +SEXP R_subscript_1ary_mat(SEXP, SEXP); +SEXP R_subscript_2ary (SEXP, SEXP, SEXP); -#endif +#endif /* MATRIX_SUBSCRIPT_H */ diff -Nru rmatrix-1.6-1.1/src/t_Csparse_subassign.c rmatrix-1.6-5/src/t_Csparse_subassign.c --- rmatrix-1.6-1.1/src/t_Csparse_subassign.c 2022-11-05 20:57:05.000000000 +0000 +++ rmatrix-1.6-5/src/t_Csparse_subassign.c 2023-11-28 11:50:51.000000000 +0000 @@ -2,9 +2,7 @@ * -------- ~~~~~~~~~~~~~~~~~~~~~~ * i.e., included several times from ./Csparse.c * ~~~~~~~~~~~ - * - _slot_kind : use the integer codes matching x_slot_kind in ./Mdefines.h - * ~~~~~~~~ + * _slot_kind : use the integer codes matching x_slot_kind in ./Csparse.c */ #ifdef _d_Csp_ @@ -213,10 +211,10 @@ 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])); + ans = PROTECT(newObject(valid_cM[ctype_x])); SET_SLOT(ans, Matrix_DimSym, duplicate(dimslot)); - slot_dup(ans, x, Matrix_DimNamesSym); - slot_dup(ans, x, Matrix_pSym); + SET_SLOT(ans, Matrix_DimNamesSym, duplicate(GET_SLOT(x, Matrix_DimNamesSym))); + SET_SLOT(ans, Matrix_pSym, duplicate(GET_SLOT(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* @@ -269,8 +267,8 @@ 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]); + REprintf("programming thinko in Csparse_subassign(*, i=%d,j=%d): ii_v=%lld, v@i[j_val=%d]=%g\n", + i__,j__, (long long)ii_v1, j_val, val_i[j_val]); j_val++;// from now on, look at the next non-zero entry } } @@ -419,13 +417,19 @@ }// 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); + SET_SLOT(ans, Matrix_uploSym, duplicate(GET_SLOT(x, Matrix_uploSym))); + SET_SLOT(ans, Matrix_diagSym, duplicate(GET_SLOT(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); + PROTECT(islot = allocVector(INTSXP, nnz)); + Memcpy(INTEGER(islot), ri, nnz); + SET_SLOT(ans, Matrix_iSym, islot); + UNPROTECT(1); #ifdef _has_x_slot_ - Memcpy( STYP_x(ALLOC_SLOT(ans, Matrix_xSym, SXP_x, nnz)), rx, nnz); + PROTECT(islot = allocVector(SXP_x, nnz)); + Memcpy(STYP_x(islot), rx, nnz); + SET_SLOT(ans, Matrix_xSym, islot); + UNPROTECT(1); R_Free(rx); #endif R_Free(ri); diff -Nru rmatrix-1.6-1.1/src/t_Csparse_validate.c rmatrix-1.6-5/src/t_Csparse_validate.c --- rmatrix-1.6-1.1/src/t_Csparse_validate.c 2013-08-08 21:06:22.000000000 +0000 +++ rmatrix-1.6-5/src/t_Csparse_validate.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,88 +0,0 @@ -/* 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 diff -Nru rmatrix-1.6-1.1/src/unpackedMatrix.c rmatrix-1.6-5/src/unpackedMatrix.c --- rmatrix-1.6-1.1/src/unpackedMatrix.c 2023-08-03 04:25:06.000000000 +0000 +++ rmatrix-1.6-5/src/unpackedMatrix.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1573 +0,0 @@ -#include "unpackedMatrix.h" - -#define PACK(_PREFIX_, _CTYPE_, _ONE_) \ -void _PREFIX_ ## dense_pack(_CTYPE_ *dest, const _CTYPE_ *src, int n, \ - char uplo, char diag) \ -{ \ - int i, j; \ - R_xlen_t dpos = 0, spos = 0; \ - if (uplo == 'U') { \ - for (j = 0; j < n; spos += n-(++j)) \ - for (i = 0; i <= j; ++i) \ - dest[dpos++] = src[spos++]; \ - if (diag != 'N') { \ - dpos = 0; \ - for (j = 0; j < n; dpos += (++j)+1) \ - dest[dpos] = _ONE_; \ - } \ - } else { \ - for (j = 0; j < n; spos += (++j)) \ - for (i = j; i < n; ++i) \ - dest[dpos++] = src[spos++]; \ - if (diag != 'N') { \ - dpos = 0; \ - for (j = 0; j < n; dpos += n-(j++)) \ - dest[dpos] = _ONE_; \ - } \ - } \ - return; \ -} - -/** - * @brief Pack a square `unpackedMatrix`. - * - * Copies the upper or lower triangular part of `src` to `dest`, - * where it is stored contiguously ("packed"). Optionally resets - * the diagonal elements to 1. - * - * @param dest,src Pointers to the first elements of length-`(n*(n+1))/2` - * and length-`n*n` (resp.) arrays, usually the "data" of the `x` - * slot of an `n`-by-`n` `packedMatrix` and `unpackedMatrix` (resp.). - * @param n Size of matrix being packed. - * @param uplo,diag `char` specifying whether the "nontrivial part" - * is upper (`'U'`) or lower (`'L'`) and whether to "force" a - * unit diagonal (`'U'`) or not (`'N'`). - */ -/* ddense_pack() */ -PACK(d, double, 1.0) -/* idense_pack() */ -PACK(i, int, 1) -/* zdense_pack() */ -PACK(z, Rcomplex, Matrix_zone) - -#undef PACK - -#define MAKE_TRIANGULAR(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ -void _PREFIX_ ## dense_unpacked_make_triangular(_CTYPE_ *x, int m, int n, \ - char uplo, char diag) \ -{ \ - int i, j, r = (m < n) ? m : n; \ - R_xlen_t pos = 0; \ - if (uplo == 'U') { \ - for (j = 0; j < r; pos += (++j)+1) \ - for (i = j+1; i < m; ++i) \ - x[++pos] = _ZERO_; \ - } else { \ - for (j = 0; j < r; pos += m-(j++)) \ - for (i = 0; i < j; ++i) \ - x[pos++] = _ZERO_; \ - for (j = r; j < n; ++j) \ - for (i = 0; i < m; ++i) \ - x[pos++] = _ZERO_; \ - } \ - if (diag != 'N') { \ - pos = 0; \ - R_xlen_t m1a = (R_xlen_t) m + 1; \ - for (j = 0; j < r; ++j, pos += m1a) \ - x[pos] = _ONE_; \ - } \ - return; \ -} - -/** - * @brief Make triangular an `unpackedMatrix`. - * - * "Triangularizes" the elements of an `m`-by-`n` `unpackedMatrix`, - * which need not be square (though all `triangularMatrix` _are_). - * - * @param x A pointer to the first element of a length-`m*n` array, - * usually the "data" of the `x` slot of an `m`-by-`n` `unpackedMatrix`. - * @param m,n Dimensions of matrix being triangularized. - * @param uplo,diag `char` constants specifying whether the matrix - * should be upper (`'U'`) or lower (`'L'`) triangular and - * whether it should have a unit diagonal (`'U'`) or not (`'N'`). - */ -/* ddense_unpacked_make_triangular() */ -MAKE_TRIANGULAR(d, double, 0.0, 1.0) -/* idense_unpacked_make_triangular() */ -MAKE_TRIANGULAR(i, int, 0, 1) -/* zdense_unpacked_make_triangular() */ -MAKE_TRIANGULAR(z, Rcomplex, Matrix_zzero, Matrix_zone) - -#undef MAKE_TRIANGULAR - -#define MAKE_SYMMETRIC_SET_EQ(_X_, _DEST_, _SRC_) \ - _X_[_DEST_] = _X_[_SRC_] - -#define MAKE_SYMMETRIC_SET_CJ(_X_, _DEST_, _SRC_) \ - do { \ - _X_[_DEST_].r = _X_[_SRC_].r; \ - _X_[_DEST_].i = -_X_[_SRC_].i; \ - } while (0) - -#define MAKE_SYMMETRIC(_PREFIX_, _CTYPE_, _SET_) \ -void _PREFIX_ ## dense_unpacked_make_symmetric(_CTYPE_ *x, int n, \ - char uplo) \ -{ \ - int i, j, n1s = n - 1; \ - R_xlen_t upos = n, lpos = 1; \ - if (uplo == 'U') { \ - for (j = 0; j < n; upos = (lpos += (++j)+1) + n1s) \ - for (i = j+1; i < n; ++i, upos += n, ++lpos) \ - _SET_(x, lpos, upos); \ - } else { \ - for (j = 0; j < n; upos = (lpos += (++j)+1) + n1s) \ - for (i = j+1; i < n; ++i, upos += n, ++lpos) \ - _SET_(x, upos, lpos); \ - } \ - return; \ -} - -/** - * @brief Make symmetric a square `unpackedMatrix`. - * - * "Symmetrizes" the elements of an `n`-by-`n` `unpackedMatrix`. - * - * @param x A pointer to the first element of a length-`n*n` array, - * usually the "data" of the `x` slot of an `n`-by-`n` `unpackedMatrix`. - * @param n Size of matrix being symmetrized. - * @param uplo A `char` specifying whether to copy the upper triangle - * to the lower triangle (`'U'`) or to do the reverse (`'L'`). - */ -/* ddense_unpacked_make_symmetric() */ -MAKE_SYMMETRIC(d, double, MAKE_SYMMETRIC_SET_EQ) -/* idense_unpacked_make_symmetric() */ -MAKE_SYMMETRIC(i, int, MAKE_SYMMETRIC_SET_EQ) -/* zdense_unpacked_make_symmetric() */ -MAKE_SYMMETRIC(z, Rcomplex, MAKE_SYMMETRIC_SET_CJ) - -#undef MAKE_SYMMETRIC -#undef MAKE_SYMMETRIC_SET_CJ -#undef MAKE_SYMMETRIC_SET_EQ - -#define MAKE_BANDED(_PREFIX_, _CTYPE_, _ZERO_, _ONE_) \ -void _PREFIX_ ## dense_unpacked_make_banded(_CTYPE_ *x, int m, int n, \ - int a, int b, char diag) \ -{ \ - if (m == 0 || n == 0) \ - return; \ - if (a > b || a >= n || b <= -m) { \ - Matrix_memset(x, 0, (R_xlen_t) m * n, sizeof(_CTYPE_)); \ - return; \ - } \ - if (a <= -m) a = 1-m; \ - if (b >= n) b = n-1; \ - \ - int i, j, i0, i1, \ - j0 = (a < 0) ? 0 : a, \ - j1 = (b < n-m) ? m+b : n; \ - \ - if (j0 > 0) { \ - R_xlen_t dx; \ - Matrix_memset(x, 0, dx = (R_xlen_t) m * j0, sizeof(_CTYPE_)); \ - x += dx; \ - } \ - for (j = j0; j < j1; ++j, x += m) { \ - i0 = j - b; \ - i1 = j - a + 1; \ - for (i = 0; i < i0; ++i) \ - *(x + i) = _ZERO_; \ - for (i = i1; i < m; ++i) \ - *(x + i) = _ZERO_; \ - } \ - if (j1 < n) \ - Matrix_memset(x, 0, (R_xlen_t) m * (n - j1), sizeof(_CTYPE_)); \ - if (diag != 'N' && a <= 0 && b >= 0) { \ - x -= m * (R_xlen_t) j; \ - R_xlen_t m1a = (R_xlen_t) m + 1; \ - for (j = 0; j < n; ++j, x += m1a) \ - *x = _ONE_; \ - } \ - return; \ -} -MAKE_BANDED(d, double, 0.0, 1.0) -MAKE_BANDED(i, int, 0, 1) -MAKE_BANDED(z, Rcomplex, Matrix_zzero, Matrix_zone) - -#undef MAKE_BANDED - -#define COPY_DIAGONAL(_PREFIX_, _CTYPE_, _ONE_) \ -void _PREFIX_ ## dense_unpacked_copy_diagonal(_CTYPE_ *dest, \ - const _CTYPE_ *src, \ - int n, R_xlen_t len, \ - char uplo, char diag) \ -{ \ - int j; \ - R_xlen_t n1a = (R_xlen_t) n + 1; \ - if (diag != 'N') { \ - for (j = 0; j < n; ++j, dest += n1a) \ - *dest = _ONE_; \ - } else if (len == n) { \ - /* copying from diagonalMatrix */ \ - for (j = 0; j < n; ++j, dest += n1a, ++src) \ - *dest = *src; \ - } else if (len == (n * n1a) / 2) { \ - /* copying from packedMatrix */ \ - if (uplo == 'U') { \ - for (j = 0; j < n; dest += n1a, src += (++j)+1) \ - *dest = *src; \ - } else { \ - for (j = 0; j < n; dest += n1a, src += n-(j++)) \ - *dest = *src; \ - } \ - } else if (len == (R_xlen_t) n * n) { \ - /* copying from square unpackedMatrix */ \ - for (j = 0; j < n; ++j, dest += n1a, src += n1a) \ - *dest = *src; \ - } else { \ - error(_("incompatible '%s' and '%s' in %s()"), "n", "len", __func__); \ - } \ - return; \ -} - -/** - * Copy a length-`n` diagonal to a length-`n*n` array. - * - * @param dest A pointer to the first element of a length-`n*n` array, - * usually the "data" of the `x` slot of an `n`-by-`n` `unpackedMatrix`. - * @param src A pointer to the first element of a length-`n`, - * length-`(n*(n+1))/2`, or length-`n*n` array, usually the "data" - * of the `x` slot of an `n`-by-`n` `diagonalMatrix`, `packedMatrix`, - * or `unpackedMatrix`, respectively. - * @param n Size of matrix being copied from and to. - * @param len Length of `src` array. - * @param uplo,diag `char` constants specifying whether `src` stores an - * upper (`'U'`) or lower (`'L'`) triangle when `len == (n*(n+1))/2` and - * whether the matrix should have a unit diagonal (`'U'`) or not (`'N'`). - */ -/* ddense_unpacked_copy_diagonal() */ -COPY_DIAGONAL(d, double, 1.0) -/* idense_unpacked_copy_diagonal() */ -COPY_DIAGONAL(i, int, 1) -/* zdense_unpacked_copy_diagonal() */ -COPY_DIAGONAL(z, Rcomplex, Matrix_zone) - -#undef COPY_DIAGONAL - -#define IS_TRIANGULAR(_PREFIX_, _CTYPE_, \ - _L_IS_NOT_ZERO_, _U_IS_NOT_ZERO_) \ -static Rboolean _PREFIX_ ## dense_unpacked_is_triangular(const _CTYPE_ *x, \ - int n, \ - char uplo) \ -{ \ - int i, j; \ - if (uplo == 'U') { \ - for (j = 0; j < n; x += (++j)+1) \ - for (i = j+1; i < n; ++i) \ - if (_L_IS_NOT_ZERO_) \ - return FALSE; \ - } else { \ - for (j = 0; j < n; x += n-(j++)) \ - for (i = 0; i < j; ++i) \ - if (_U_IS_NOT_ZERO_) \ - return FALSE; \ - } \ - return TRUE; \ -} - -/* ddense_unpacked_is_triangular() */ -IS_TRIANGULAR(d, double, - ISNAN(*(++x)) || *x != 0.0, - ISNAN(*x) || *(x++) != 0.0) -/* idense_unpacked_is_triangular() */ -IS_TRIANGULAR(i, int, - *(++x) != 0, - *(x++) != 0) -/* zdense_unpacked_is_triangular() */ -IS_TRIANGULAR(z, Rcomplex, - ISNAN((*(++x)).r) || (*x).r != 0.0 || - ISNAN((*x).i) || (*x).i != 0.0, - ISNAN((*x).r) || (*x).r != 0.0 || - ISNAN((*x).i) || (*(x++)).i != 0.0) - -#undef IS_TRIANGULAR - -#define IS_SYMMETRIC(_PREFIX_, _CTYPE_, \ - _U_IS_NA_, _L_IS_NOT_NA_, _L_IS_NOT_EQUAL_) \ -static Rboolean _PREFIX_ ## dense_unpacked_is_symmetric(const _CTYPE_ *x, \ - int n) \ -{ \ - int i, j; \ - R_xlen_t upos = 0, lpos = 0; \ - for (j = 0; j < n; upos = (lpos += (++j)+1)) { \ - for (i = j+1; i < n; ++i) { \ - upos += n; ++lpos; \ - if (_U_IS_NA_) { \ - if (_L_IS_NOT_NA_) \ - return FALSE; \ - } else { \ - if (_L_IS_NOT_EQUAL_) \ - return FALSE; \ - } \ - } \ - } \ - return TRUE; \ -} - -/* ddense_unpacked_is_symmetric() */ -IS_SYMMETRIC(d, double, - ISNAN(x[upos]), - !ISNAN(x[lpos]), - ISNAN(x[lpos]) || x[lpos] != x[upos]) -/* ldense_unpacked_is_symmetric() */ -IS_SYMMETRIC(l, int, - x[upos] == NA_LOGICAL, - x[lpos] != NA_LOGICAL, - (x[upos] == 0) ? (x[lpos] != 0) : (x[lpos] == 0)) -/* ndense_unpacked_is_symmetric() ... macro still works, if we cheat */ -IS_SYMMETRIC(n, int, - x[upos] == 0, - x[lpos] != 0, - x[lpos] == 0) -/* idense_unpacked_is_symmetric() */ -IS_SYMMETRIC(i, int, - x[upos] == NA_INTEGER, - x[lpos] != NA_INTEGER, - x[lpos] != x[upos]) -/* zdense_unpacked_is_symmetric() */ -IS_SYMMETRIC(z, Rcomplex, - ISNAN(x[upos].r) || ISNAN(x[upos].i) , - !(ISNAN(x[lpos].r) || ISNAN(x[lpos].i)), - ISNAN(x[lpos].r) || ISNAN(x[lpos].i) || - x[upos].r != x[lpos].r || x[upos].i != -x[lpos].i) - -#undef IS_SYMMETRIC - -#define IS_DIAGONAL(_PREFIX_, _CTYPE_, _OD_IS_NOT_ZERO_) \ -static Rboolean _PREFIX_ ## dense_unpacked_is_diagonal(const _CTYPE_ *x, \ - int n) \ -{ \ - int i, j; \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i) \ - if (_OD_IS_NOT_ZERO_) \ - return FALSE; \ - ++x; /* skip over diagonal */ \ - for (i = j+1; i < n; ++i) \ - if (_OD_IS_NOT_ZERO_) \ - return FALSE; \ - } \ - return TRUE; \ -} - -/* ddense_unpacked_is_diagonal() */ -IS_DIAGONAL(d, double, ISNAN(*x) || *(x++) != 0.0) -/* idense_unpacked_is_diagonal() */ -IS_DIAGONAL(i, int, *(x++) != 0) -/* zdense_unpacked_is_diagonal() */ -IS_DIAGONAL(z, Rcomplex, - ISNAN((*x).r) || (*(x)).r != 0.0 || - ISNAN((*x).i) || (*(x++)).i != 0.0) - -#undef IS_DIAGONAL - -SEXP unpacked_force(SEXP x, int n, char uplo, char diag) -{ - SEXPTYPE tx = TYPEOF(x); - if (tx < LGLSXP || tx > CPLXSXP) - ERROR_INVALID_TYPE(x, __func__); - R_xlen_t nx = XLENGTH(x); - SEXP y = PROTECT(allocVector(tx, nx)); - - if (diag == '\0') { - -#define FORCE_SYMMETRIC(_PREFIX_, _CTYPE_, _PTR_) \ - do { \ - _CTYPE_ *px = _PTR_(x), *py = _PTR_(y); \ - Matrix_memcpy(py, px, nx, sizeof(_CTYPE_)); \ - _PREFIX_ ## dense_unpacked_make_symmetric(py, n, uplo); \ - } while (0) - - switch (tx) { - case LGLSXP: - FORCE_SYMMETRIC(i, int, LOGICAL); - break; - case INTSXP: - FORCE_SYMMETRIC(i, int, INTEGER); - break; - case REALSXP: - FORCE_SYMMETRIC(d, double, REAL); - break; - case CPLXSXP: - FORCE_SYMMETRIC(z, Rcomplex, COMPLEX); - break; - default: - break; - } - -#undef FORCE_SYMMETRIC - - } else { - -#define FORCE_TRIANGULAR(_PREFIX_, _CTYPE_, _PTR_, _ONE_) \ - do { \ - _CTYPE_ *px = _PTR_(x), *py = _PTR_(y); \ - Matrix_memcpy(py, px, nx, sizeof(_CTYPE_)); \ - _PREFIX_ ## dense_unpacked_make_triangular( \ - py, n, n, uplo, diag); \ - if (diag != 'N') { \ - R_xlen_t n1a = (R_xlen_t) n + 1; \ - for (int j = 0; j < n; ++j, py += n1a) \ - *py = _ONE_; \ - } \ - } while (0) - - switch (tx) { - case LGLSXP: - FORCE_TRIANGULAR(i, int, LOGICAL, 1); - break; - case INTSXP: - FORCE_TRIANGULAR(i, int, INTEGER, 1); - break; - case REALSXP: - FORCE_TRIANGULAR(d, double, REAL, 1.0); - break; - case CPLXSXP: - FORCE_TRIANGULAR(z, Rcomplex, COMPLEX, Matrix_zone); - break; - default: - break; - } - -#undef FORCE_TRIANGULAR - - } - - UNPROTECT(1); - return y; -} - -/* forceSymmetric(x, uplo), returning .syMatrix */ -SEXP unpackedMatrix_force_symmetric(SEXP from, SEXP uplo_to) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *clf = valid[ivalid]; - - char ulf = 'U', ult = 'U'; - if (clf[1] != 'g') { - /* .(tr|sy)Matrix */ - SEXP uplo_from = PROTECT(GET_SLOT(from, Matrix_uploSym)); - ulf = ult = *CHAR(STRING_ELT(uplo_from, 0)); - UNPROTECT(1); /* uplo_from */ - } - - if (!isNull(uplo_to) && - (TYPEOF(uplo_to) != STRSXP || LENGTH(uplo_to) < 1 || - (uplo_to = STRING_ELT(uplo_to, 0)) == NA_STRING || - ((ult = *CHAR(uplo_to)) != 'U' && ult != 'L'))) - error(_("invalid '%s' to %s()"), "uplo", __func__); - - if (clf[1] == 's') { - /* .syMatrix */ - if (ulf == ult) - return from; - SEXP to = PROTECT(unpackedMatrix_transpose(from)); - if (clf[0] == 'z') { - /* Need _conjugate_ transpose */ - SEXP x_to = PROTECT(GET_SLOT(to, Matrix_xSym)); - conjugate(x_to); - UNPROTECT(1); /* x_to */ - } - UNPROTECT(1); /* to */ - return to; - } - - /* Now handling just .(ge|tr)Matrix ... */ - - char clt[] = ".syMatrix"; - clt[0] = clf[0]; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)), - x_from = PROTECT(GET_SLOT(from, Matrix_xSym)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0]; - if (pdim[1] != n) - error(_("attempt to symmetrize a non-square matrix")); - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - set_symmetrized_DimNames(to, dimnames, -1); - UNPROTECT(1); /* dimnames */ - - if (ult != 'U') { - PROTECT(uplo_to = mkString("L")); - SET_SLOT(to, Matrix_uploSym, uplo_to); - UNPROTECT(1); /* uplo_to */ - } - - if (clf[1] == 'g' || ulf == ult) { - /* .geMatrix or .trMatrix with correct uplo */ - SET_SLOT(to, Matrix_xSym, x_from); - } else { - /* .trMatrix with incorrect uplo */ - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - - SEXPTYPE tx = TYPEOF(x_from); - R_xlen_t nx = XLENGTH(x_from); - SEXP x_to = PROTECT(allocVector(tx, nx)); - -#define COPY_DIAGONAL(_PREFIX_, _CTYPE_, _PTR_) \ - do { \ - Matrix_memset(_PTR_(x_to), 0, nx, sizeof(_CTYPE_)); \ - _PREFIX_ ## dense_unpacked_copy_diagonal( \ - _PTR_(x_to), _PTR_(x_from), n, nx, 'U' /* unused */, di); \ - } while (0) - - switch (tx) { - case LGLSXP: /* [nl]..Matrix */ - COPY_DIAGONAL(i, int, LOGICAL); - break; - case INTSXP: /* i..Matrix */ - COPY_DIAGONAL(i, int, INTEGER); - break; - case REALSXP: /* d..Matrix */ - COPY_DIAGONAL(d, double, REAL); - break; - case CPLXSXP: /* z..Matrix */ - COPY_DIAGONAL(z, Rcomplex, COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x_from, __func__); - break; - } - -#undef COPY_DIAGONAL - - SET_SLOT(to, Matrix_xSym, x_to); - UNPROTECT(1); /* x_to */ - } - - UNPROTECT(2); /* x_from, to */ - return to; -} - -#define UPM_IS_TR(_RES_, _X_, _N_, _UPLO_) \ -do { \ - switch (TYPEOF(_X_)) { \ - case LGLSXP: \ - _RES_ = idense_unpacked_is_triangular(LOGICAL(_X_), _N_, _UPLO_); \ - break; \ - case INTSXP: \ - _RES_ = idense_unpacked_is_triangular(INTEGER(_X_), _N_, _UPLO_); \ - break; \ - case REALSXP: \ - _RES_ = ddense_unpacked_is_triangular(REAL(_X_), _N_, _UPLO_); \ - break; \ - case CPLXSXP: \ - _RES_ = zdense_unpacked_is_triangular(COMPLEX(_X_), _N_, _UPLO_); \ - break; \ - default: \ - ERROR_INVALID_TYPE(_X_, __func__); \ - _RES_ = FALSE; \ - break; \ - } \ -} while (0) - -#define UPM_IS_SY(_RES_, _X_, _N_, _LDENSE_) \ -do { \ - switch (TYPEOF(_X_)) { \ - case LGLSXP: \ - _RES_ = (_LDENSE_ \ - ? ldense_unpacked_is_symmetric(LOGICAL(_X_), _N_) \ - : ndense_unpacked_is_symmetric(LOGICAL(_X_), _N_)); \ - break; \ - case INTSXP: \ - _RES_ = idense_unpacked_is_symmetric(INTEGER(_X_), _N_); \ - break; \ - case REALSXP: \ - _RES_ = ddense_unpacked_is_symmetric(REAL(_X_), _N_); \ - break; \ - case CPLXSXP: \ - _RES_ = zdense_unpacked_is_symmetric(COMPLEX(_X_), _N_); \ - break; \ - default: \ - ERROR_INVALID_TYPE(_X_, __func__); \ - _RES_ = FALSE; \ - break; \ - } \ -} while (0) - -#define UPM_IS_DI(_RES_, _X_, _N_) \ -do { \ - switch (TYPEOF(_X_)) { \ - case LGLSXP: \ - _RES_ = idense_unpacked_is_diagonal(LOGICAL(_X_), _N_); \ - break; \ - case INTSXP: \ - _RES_ = idense_unpacked_is_diagonal(INTEGER(_X_), _N_); \ - break; \ - case REALSXP: \ - _RES_ = ddense_unpacked_is_diagonal(REAL(_X_), _N_); \ - break; \ - case CPLXSXP: \ - _RES_ = zdense_unpacked_is_diagonal(COMPLEX(_X_), _N_); \ - break; \ - default: \ - ERROR_INVALID_TYPE(_X_, __func__); \ - _RES_ = FALSE; \ - break; \ - } \ -} while (0) - -#define RETURN_GE_IS_TR(_X_, _N_, _UPPER_, _NPROT_) \ -do { \ - Rboolean res = FALSE; \ - if (_UPPER_ == NA_LOGICAL) { \ - UPM_IS_TR(res, _X_, _N_, 'U'); \ - if (res) { \ - UNPROTECT(_NPROT_); \ - RETURN_TRUE_OF_KIND("U"); \ - } \ - UPM_IS_TR(res, _X_, _N_, 'L'); \ - if (res) { \ - UNPROTECT(_NPROT_); \ - RETURN_TRUE_OF_KIND("L"); \ - } \ - } else { \ - UPM_IS_TR(res, _X_, _N_, (_UPPER_ != 0) ? 'U' : 'L'); \ - } \ - UNPROTECT(_NPROT_); \ - return ScalarLogical(res); \ -} while (0) - -/* isTriangular(x, upper) */ -SEXP unpackedMatrix_is_triangular(SEXP obj, SEXP upper) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - - int need_upper = asLogical(upper); - - if (ivalid < 3) { - /* .geMatrix: need to do a complete triangularity check */ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (!s) - return ScalarLogical(0); - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - RETURN_GE_IS_TR(x, n, need_upper, /* unprotect this many: */ 1); - } else { - /* .(tr|sy)Matrix */ - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - -#define IF_DIAGONAL \ - Rboolean res = FALSE; \ - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), \ - dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); \ - int n = INTEGER(dim)[0]; \ - UPM_IS_TR(res, x, n, (ul == 'U') ? 'L' : 'U'); \ - UNPROTECT(2); /* dim, x */ \ - if (res) - - if (ivalid < 6) { - /* .trMatrix: fast if 'upper', 'uplo' agree; else need diagonal */ - if (need_upper == NA_LOGICAL) - RETURN_TRUE_OF_KIND((ul == 'U') ? "U" : "L"); - else if ((need_upper) ? ul == 'U' : ul != 'U') - return ScalarLogical(1); - else { - IF_DIAGONAL { - return ScalarLogical(1); - } - } - } else { - /* .syMatrix: triangular iff diagonal (upper _and_ lower tri.) */ - IF_DIAGONAL { - if (need_upper == NA_LOGICAL) - RETURN_TRUE_OF_KIND("U"); - else - return ScalarLogical(1); - } - } - -#undef IF_DIAGONAL - - return ScalarLogical(0); - } -} - -/* isTriangular(x, upper) */ -SEXP matrix_is_triangular(SEXP obj, SEXP upper) -{ - SEXP dim = PROTECT(getAttrib(obj, R_DimSymbol)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (!s) - return ScalarLogical(0); - int need_upper = asLogical(upper); - RETURN_GE_IS_TR(obj, n, need_upper, /* unprotect this many: */ 0); -} - -#undef RETURN_GE_IS_TR - -/* isSymmetric(x, tol = 0, checkDN) */ -/* FIXME: not checking for real diagonal in complex case */ -SEXP unpackedMatrix_is_symmetric(SEXP obj, SEXP checkDN) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) { - ERROR_INVALID_CLASS(obj, __func__); - return R_NilValue; - } else if (ivalid < 6) { - /* .(ge|tr)Matrix */ - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (s && asLogical(checkDN) != 0) { - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - s = DimNames_is_symmetric(dimnames); - UNPROTECT(1); /* dimnames */ - } - if (!s) - return ScalarLogical(0); - Rboolean res = FALSE; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - if (ivalid < 3) { - /* .geMatrix: need to do a complete symmetry check */ - UPM_IS_SY(res, x, n, ivalid == 1); - } else { - /* .trMatrix: symmetric iff diagonal (upper _and_ lower tri.) */ - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = (*CHAR(STRING_ELT(uplo, 0)) == 'U') ? 'L' : 'U'; - UNPROTECT(1); /* uplo */ - UPM_IS_TR(res, x, n, ul); - } - UNPROTECT(1); /* x */ - return ScalarLogical(res); - } else { - /* .syMatrix: symmetric by definition */ - return ScalarLogical(1); - } -} - -/* isSymmetric(x, tol = 0) */ -SEXP matrix_is_symmetric(SEXP obj, SEXP checkDN) -{ - SEXP dim = PROTECT(getAttrib(obj, R_DimSymbol)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (s && asLogical(checkDN) != 0) { - SEXP dimnames = PROTECT(getAttrib(obj, R_DimNamesSymbol)); - s = isNull(dimnames) || DimNames_is_symmetric(dimnames); - UNPROTECT(1); /* dimnames */ - } - if (!s) - return ScalarLogical(0); - Rboolean res = FALSE; - UPM_IS_SY(res, obj, n, 1); - return ScalarLogical(res); -} - -/* isDiagonal(x) */ -SEXP unpackedMatrix_is_diagonal(SEXP obj) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (!s) - return ScalarLogical(0); - Rboolean res = FALSE; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)); - if (ivalid < 3) { - /* .geMatrix: need to do a complete diagonality check */ - UPM_IS_DI(res, x, n); - } else { - /* .(tr|sy)Matrix: diagonal iff stored triangle is zero off diagonal */ - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = (*CHAR(STRING_ELT(uplo, 0)) == 'U') ? 'L' : 'U'; - UNPROTECT(1); /* uplo */ - UPM_IS_TR(res, x, n, ul); - } - UNPROTECT(1); /* x */ - return ScalarLogical(res); -} - -/* isDiagonal(x) */ -SEXP matrix_is_diagonal(SEXP obj) -{ - SEXP dim = PROTECT(getAttrib(obj, R_DimSymbol)); - int *pdim = INTEGER(dim), n = pdim[0], s = pdim[1] == n; - UNPROTECT(1); /* dim */ - if (!s) - return ScalarLogical(0); - Rboolean res = FALSE; - UPM_IS_DI(res, obj, n); - return ScalarLogical(res); -} - -#undef UPM_IS_DI -#undef UPM_IS_TR -#undef UPM_IS_SY - -/* t(x) */ -/* MJ: Technically no need to do full transpose of .(tr|sy)Matrix ... */ -/* but then identical(.@x, t(t(.))@x) can be FALSE ... */ -SEXP unpackedMatrix_transpose(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "corMatrix", "dpoMatrix", - /* 8 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *cl = valid[ivalid]; - - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(cl)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), m = pdim[0], n = pdim[1]; - if (m != n) { - UNPROTECT(1); /* dim */ - PROTECT(dim = GET_SLOT(to, Matrix_DimSym)); - pdim = INTEGER(dim); - pdim[0] = n; - pdim[1] = m; - } else if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (ivalid < 6) - set_reversed_DimNames(to, dimnames); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - if (ivalid >= 3) { - SEXP uplo_from = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ulf = *CHAR(STRING_ELT(uplo_from, 0)); - UNPROTECT(1); /* uplo_from */ - if (ulf == 'U') { - SEXP uplo_to = PROTECT(mkString("L")); - SET_SLOT(to, Matrix_uploSym, uplo_to); - UNPROTECT(1); /* uplo_to */ - } - if (ivalid < 6) { - /* .trMatrix */ - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - if (di != 'N') - SET_SLOT(to, Matrix_diagSym, diag); - UNPROTECT(1); /* diag */ - } else { - /* .syMatrix */ - SEXP factors = PROTECT(GET_SLOT(from, Matrix_factorSym)); - if (LENGTH(factors) > 0) - SET_SLOT(to, Matrix_factorSym, factors); - UNPROTECT(1); /* factors */ - - if (ivalid == 6) { - /* corMatrix */ - SEXP sd = PROTECT(GET_SLOT(from, Matrix_sdSym)); - if (LENGTH(sd) > 0) - SET_SLOT(to, Matrix_sdSym, sd); - UNPROTECT(1); /* sd */ - } - } - } - - SEXPTYPE tx; - R_xlen_t nx; - SEXP x_from = PROTECT(GET_SLOT(from, Matrix_xSym)), - x_to = PROTECT(allocVector(tx = TYPEOF(x_from), nx = XLENGTH(x_from))); - -#define UPM_T(_CTYPE_, _PTR_) \ - do { \ - _CTYPE_ *px0 = _PTR_(x_from), *px1 = _PTR_(x_to); \ - int i, j; \ - R_xlen_t nx1s = nx - 1; \ - for (j = 0; j < m; ++j, px0 -= nx1s) \ - for (i = 0; i < n; ++i, px0 += m) \ - *(px1++) = *px0; \ - } while (0) - - switch (tx) { - case LGLSXP: /* [nl]..Matrix */ - UPM_T(int, LOGICAL); - break; - case INTSXP: /* i..Matrix */ - UPM_T(int, INTEGER); - break; - case REALSXP: /* d..Matrix */ - UPM_T(double, REAL); - break; - case CPLXSXP: /* z..Matrix */ - UPM_T(Rcomplex, COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x_from, __func__); - break; - } - -#undef UPM_T - - SET_SLOT(to, Matrix_xSym, x_to); - - UNPROTECT(3); /* x_to, x_from, to */ - return to; -} - -/* diag(x, names) */ -SEXP unpackedMatrix_diag_get(SEXP obj, SEXP nms) -{ - int do_nms = asLogical(nms); - if (do_nms == NA_LOGICAL) - error(_("'%s' must be %s or %s"), "names", "TRUE", "FALSE"); - - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), - m = pdim[0], n = pdim[1], r = (m < n) ? m : n; - UNPROTECT(1); /* dim */ - - char ul = '\0', di = '\0'; - if (HAS_SLOT(obj, Matrix_uploSym)) { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - ul = *CHAR(STRING_ELT(uplo, 0)); - UNPROTECT(1); /* uplo */ - - if (HAS_SLOT(obj, Matrix_diagSym)) { - SEXP diag = PROTECT(GET_SLOT(obj, Matrix_diagSym)); - di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - } - } - - SEXPTYPE tx; - SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), - res = PROTECT(allocVector(tx = TYPEOF(x), r)); - -#define UPM_D_G(_CTYPE_, _PTR_, _ONE_) \ - do { \ - _CTYPE_ *pres = _PTR_(res); \ - int j; \ - if (di == 'U') { \ - for (j = 0; j < r; ++j) \ - *(pres++) = _ONE_; \ - } else { \ - _CTYPE_ *px = _PTR_(x); \ - R_xlen_t m1a = (R_xlen_t) m + 1; \ - for (j = 0; j < r; ++j, px += m1a) \ - *(pres++) = *px; \ - } \ - } while (0) - - switch (tx) { - case LGLSXP: /* [nl]..Matrix */ - UPM_D_G(int, LOGICAL, 1); - break; - case INTSXP: /* i..Matrix */ - UPM_D_G(int, INTEGER, 1); - break; - case REALSXP: /* d..Matrix */ - UPM_D_G(double, REAL, 1.0); - break; - case CPLXSXP: /* z..Matrix */ - UPM_D_G(Rcomplex, COMPLEX, Matrix_zone); - break; - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - -#undef UPM_D_G - - if (do_nms) { - /* NB: The logic here must be adjusted once the validity method - for 'symmetricMatrix' enforces symmetric 'Dimnames' */ - SEXP dn = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)), - rn = VECTOR_ELT(dn, 0), - cn = VECTOR_ELT(dn, 1); - if (isNull(cn)) { - if (ul != '\0' && di == '\0' && !isNull(rn)) - setAttrib(res, R_NamesSymbol, rn); - } else { - if (ul != '\0' && di == '\0') - setAttrib(res, R_NamesSymbol, cn); - else if (!isNull(rn) && - (rn == cn || equal_string_vectors(rn, cn, r))) - setAttrib(res, R_NamesSymbol, (r == m) ? rn : cn); - } - UNPROTECT(1); /* dn */ - } - - UNPROTECT(2); /* res, x */ - return res; -} - -/* diag(x) <- value */ -SEXP unpackedMatrix_diag_set(SEXP obj, SEXP val) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(obj, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(obj, __func__); - - SEXP dim = PROTECT(GET_SLOT(obj, Matrix_DimSym)); - int *pdim = INTEGER(dim), - m = pdim[0], n = pdim[1], r = (m < n) ? m : n; - - SEXPTYPE tv = TYPEOF(val); - if (tv < LGLSXP || tv > REALSXP) - /* Upper bound can become CPLXSXP once we have proper zMatrix */ - error(_("replacement diagonal has incompatible type \"%s\""), - type2char(tv)); - - R_xlen_t nv = XLENGTH(val); - if (nv != 1 && nv != r) - error(_("replacement diagonal has wrong length")); - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(obj, Matrix_xSym), &pid); - SEXPTYPE tx = TYPEOF(x); - - /* Allocate and coerce as necessary */ - SEXP res; - if (tv <= tx) { - PROTECT(val = coerceVector(val, tv = tx)); - PROTECT(res = NEW_OBJECT_OF_CLASS(valid[ivalid])); - REPROTECT(x = duplicate(x), pid); - } else { /* tv > tx */ - /* dMatrix is only possibility until we have proper [iz]Matrix */ - PROTECT(val = coerceVector(val, tv = REALSXP)); - char cl[] = "d..Matrix"; - cl[1] = valid[ivalid][1]; - cl[2] = valid[ivalid][2]; - PROTECT(res = NEW_OBJECT_OF_CLASS(cl)); - REPROTECT(x = coerceVector(x, tx = tv), pid); - } - - if (m != n || n > 0) - SET_SLOT(res, Matrix_DimSym, dim); - - SEXP dimnames = PROTECT(GET_SLOT(obj, Matrix_DimNamesSym)); - SET_SLOT(res, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - if (valid[ivalid][1] != 'g') { - SEXP uplo = PROTECT(GET_SLOT(obj, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - if (ul != 'U') - SET_SLOT(res, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - } - -#define UPM_D_S(_CTYPE_, _PTR_) \ - do { \ - _CTYPE_ *px = _PTR_(x), *pval = _PTR_(val); \ - R_xlen_t m1a = (R_xlen_t) m + 1; \ - int j; \ - if (nv == 1) \ - for (j = 0; j < r; ++j, px += m1a) \ - *px = *pval; \ - else \ - for (j = 0; j < r; ++j, px += m1a) \ - *px = *(pval++); \ - } while (0) - - switch (tx) { - case LGLSXP: - UPM_D_S(int, LOGICAL); - break; - case INTSXP: - UPM_D_S(int, INTEGER); - break; - case REALSXP: - UPM_D_S(double, REAL); - break; - case CPLXSXP: - UPM_D_S(Rcomplex, COMPLEX); - break; - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - -#undef UPM_D_S - - SET_SLOT(res, Matrix_xSym, x); - - UNPROTECT(4); /* x, res, val, dim */ - return res; -} - -/* symmpart(x) */ -SEXP unpackedMatrix_symmpart(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - - const char *clf = valid[ivalid]; - if (clf[0] == 'd' && clf[1] == 's') - return from; - - char clt[] = ".syMatrix"; - clt[0] = (clf[0] != 'z') ? 'd' : 'z'; - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0]; - if (pdim[1] != n) - error(_("attempt to get symmetric part of non-square matrix")); - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); /* dim */ - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (clf[1] != 's') - set_symmetrized_DimNames(to, dimnames, -1); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); /* dimnames */ - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(from, Matrix_xSym), &pid); - REPROTECT(x = (clf[0] == clt[0]) ? duplicate(x) : coerceVector(x, REALSXP), - pid); - if (clf[0] == 'n') - na2one(x); - - if (clf[1] == 'g') { - - int i, j; - R_xlen_t upos = 0, lpos = 0; - -#define UPM_SYMMPART_GE(_CTYPE_, _PTR_, _ASSIGN_OFFDIAG_) \ - do { \ - _CTYPE_ *px = _PTR_(x); \ - for (j = 0; j < n; ++j) { \ - for (i = j+1; i < n; ++i) { \ - upos += n; ++lpos; \ - _ASSIGN_OFFDIAG_(upos, lpos); \ - } \ - upos = (lpos += j+2); \ - } \ - } while (0) - -#define ASSIGN_OFFDIAG_DGE(_UPOS_, _LPOS_) \ - do { \ - px[_UPOS_] += px[_LPOS_]; \ - px[_UPOS_] *= 0.5; \ - } while (0) - -#define ASSIGN_OFFDIAG_ZGE(_UPOS_, _LPOS_) \ - do { \ - px[_UPOS_].r += px[_LPOS_].r; \ - px[_UPOS_].i += px[_LPOS_].i; \ - px[_UPOS_].r *= 0.5; \ - px[_UPOS_].i *= 0.5; \ - } while (0) - - if (clf[0] != 'z') - UPM_SYMMPART_GE(double, REAL, ASSIGN_OFFDIAG_DGE); - else - UPM_SYMMPART_GE(Rcomplex, COMPLEX, ASSIGN_OFFDIAG_ZGE); - - } else { - - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - char ul = *CHAR(STRING_ELT(uplo, 0)); - if (ul != 'U') - SET_SLOT(to, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - - if (clf[1] != 's') { - - SEXP diag = PROTECT(GET_SLOT(from, Matrix_diagSym)); - char di = *CHAR(STRING_ELT(diag, 0)); - UNPROTECT(1); /* diag */ - - int i, j; - -#define UPM_SYMMPART_TR(_CTYPE_, _PTR_, _ASSIGN_OFFDIAG_, _ASSIGN_ONDIAG_) \ - do { \ - _CTYPE_ *px = _PTR_(x); \ - if (ul == 'U') { \ - for (j = 0; j < n; ++j) { \ - for (i = 0; i < j; ++i, ++px) \ - _ASSIGN_OFFDIAG_; \ - px += n-j; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - px += j+1; \ - for (i = j+1; i < n; ++i, ++px) \ - _ASSIGN_OFFDIAG_; \ - } \ - } \ - if (di != 'N') { \ - R_xlen_t n1a = (R_xlen_t) n + 1; \ - px = _PTR_(x); \ - for (j = 0; j < n; ++j, px += n1a) \ - _ASSIGN_ONDIAG_; \ - } \ - } while (0) - - if (clt[0] != 'z') - UPM_SYMMPART_TR(double, REAL, - *px *= 0.5, - *px = 1.0); - else - UPM_SYMMPART_TR(Rcomplex, COMPLEX, - do { (*px).r *= 0.5; (*px).i *= 0.5; } while (0), - do { (*px).r = 1.0; (*px).i = 0.0; } while (0)); - - } else { /* clf[1] == 's' */ - - if (clt[0] == 'z') - /* Symmetric part of Hermitian matrix is real part */ - zeroIm(x); - - } - - } - - SET_SLOT(to, Matrix_xSym, x); - - UNPROTECT(2); /* x, to */ - return to; -} - -/* symmpart(x) */ -SEXP matrix_symmpart(SEXP from) -{ - SEXP dim = PROTECT(getAttrib(from, R_DimSymbol)); - int *pdim = INTEGER(dim), n = pdim[0]; - if (pdim[1] != n) - error(_("attempt to get symmetric part of non-square matrix")); - - SEXP to, x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = from, &pid); - - int i, j; - R_xlen_t upos = 0, lpos = 0, nn = (R_xlen_t) n * n; - - switch (TYPEOF(x)) { - case LGLSXP: - case INTSXP: - REPROTECT(x = coerceVector(x, REALSXP), pid); - case REALSXP: - PROTECT(to = NEW_OBJECT_OF_CLASS("dsyMatrix")); - if (!MAYBE_REFERENCED(x)) - SET_ATTRIB(x, R_NilValue); - else { - REPROTECT(x = allocVector(REALSXP, nn), pid); - Matrix_memcpy(REAL(x), REAL(from), nn, sizeof(double)); - } - UPM_SYMMPART_GE(double, REAL, ASSIGN_OFFDIAG_DGE); - break; -#ifdef MATRIX_ENABLE_ZMATRIX - case CPLXSXP: - PROTECT(to = NEW_OBJECT_OF_CLASS("zsyMatrix")); - if (!MAYBE_REFERENCED(x)) - SET_ATTRIB(x, R_NilValue); - else { - REPROTECT(x = allocVector(CPLXSXP, nn), pid); - Matrix_memcpy(COMPLEX(x), COMPLEX(from), nn, sizeof(Rcomplex)); - } - UPM_SYMMPART_GE(Rcomplex, COMPLEX, ASSIGN_OFFDIAG_ZGE); - break; -#endif - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - SET_SLOT(to, Matrix_xSym, x); - - SEXP dimnames = PROTECT(getAttrib(from, R_DimNamesSymbol)); - if (!isNull(dimnames)) - set_symmetrized_DimNames(to, dimnames, -1); - - UNPROTECT(4); /* dimnames, to, x, dim */ - return to; -} - -#undef ASSIGN_OFFDIAG_DGE -#undef ASSIGN_OFFDIAG_ZGE -#undef UPM_SYMMPART_GE -#undef UPM_SYMMPART_TR - -/* skewpart(x) */ -SEXP unpackedMatrix_skewpart(SEXP from) -{ - static const char *valid[] = { - /* 0 */ "dgeMatrix", "lgeMatrix", "ngeMatrix", - /* 3 */ "dtrMatrix", "ltrMatrix", "ntrMatrix", - /* 6 */ "dsyMatrix", "lsyMatrix", "nsyMatrix", ""}; - int ivalid = R_check_class_etc(from, valid); - if (ivalid < 0) - ERROR_INVALID_CLASS(from, __func__); - const char *clf = valid[ivalid]; - - char clt[] = "...Matrix"; - clt[0] = (clf[0] != 'z') ? 'd' : 'z'; - clt[1] = (clf[1] != 's') ? 'g' : 's'; - clt[2] = (clf[1] != 's') ? 'e' : ((clf[0] != 'z') ? 'C' : 'y'); - SEXP to = PROTECT(NEW_OBJECT_OF_CLASS(clt)); - - SEXP dim = PROTECT(GET_SLOT(from, Matrix_DimSym)); - int *pdim = INTEGER(dim), n = pdim[0]; - if (pdim[1] != n) - error(_("attempt to get skew-symmetric part of non-square matrix")); - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - UNPROTECT(1); - - SEXP dimnames = PROTECT(GET_SLOT(from, Matrix_DimNamesSym)); - if (clf[1] != 's') - set_symmetrized_DimNames(to, dimnames, -1); - else - SET_SLOT(to, Matrix_DimNamesSym, dimnames); - UNPROTECT(1); - - char ul = 'U'; - if (clf[1] != 'g') { - SEXP uplo = PROTECT(GET_SLOT(from, Matrix_uploSym)); - ul = *CHAR(STRING_ELT(uplo, 0)); - if (clf[1] == 's' && ul != 'U') - SET_SLOT(to, Matrix_uploSym, uplo); - UNPROTECT(1); /* uplo */ - } - - SEXP x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = GET_SLOT(from, Matrix_xSym), &pid); - - if (clf[1] != 's') { - - SEXP y; - int i, j; - R_xlen_t upos = 0, lpos = 0; - -#define UPM_SKEWPART(_CTYPE_, _PTR_, _X_, _Y_, \ - _ASSIGN_OFFDIAG_, _ASSIGN_ONDIAG_) \ - do { \ - _CTYPE_ *px = _PTR_(_X_), *py = _PTR_(_Y_); \ - if (ul == 'U') { \ - for (j = 0; j < n; ++j) { \ - lpos = j; \ - for (i = 0; i < j; ++i) { \ - _ASSIGN_OFFDIAG_(upos, lpos); \ - ++upos; lpos += n; \ - } \ - _ASSIGN_ONDIAG_(upos); \ - upos += n-j; \ - } \ - } else { \ - for (j = 0; j < n; ++j) { \ - upos = lpos; \ - _ASSIGN_ONDIAG_(lpos); \ - for (i = j+1; i < n; ++i) { \ - upos += n; ++lpos; \ - _ASSIGN_OFFDIAG_(lpos, upos); \ - } \ - lpos += j+2; \ - } \ - } \ - } while (0) - -#define ASSIGN_ONDIAG_DGE(_DPOS_) \ - py[_DPOS_] = 0.0 - -#define ASSIGN_OFFDIAG_DGE(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_] = 0.5 * (px[_UPOS_] - px[_LPOS_]); \ - py[_LPOS_] = -py[_UPOS_]; \ - } while (0) - -#define ASSIGN_OFFDIAG_DTR(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_] = 0.5 * px[_UPOS_]; \ - py[_LPOS_] = -py[_UPOS_]; \ - } while (0) - -#define ASSIGN_ONDIAG_ZGE(_DPOS_) \ - py[_DPOS_].r = py[_DPOS_].i = 0.0 - -#define ASSIGN_OFFDIAG_ZGE(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_].r = 0.5 * (px[_UPOS_].r - px[_LPOS_].r); \ - py[_UPOS_].i = 0.5 * (px[_UPOS_].i - px[_LPOS_].i); \ - py[_LPOS_].r = -py[upos].r; \ - py[_LPOS_].i = -py[upos].i; \ - } while (0) - -#define ASSIGN_OFFDIAG_ZTR(_UPOS_, _LPOS_) \ - do { \ - py[_UPOS_].r = 0.5 * px[_UPOS_].r; \ - py[_UPOS_].i = 0.5 * px[_UPOS_].i; \ - py[_LPOS_].r = -py[upos].r; \ - py[_LPOS_].i = -py[upos].i; \ - } while (0) - - if (clf[0] != 'z') { - if (clf[0] == 'd') - PROTECT(y = allocVector(REALSXP, (R_xlen_t) n * n)); - else - PROTECT(x = y = coerceVector(x, REALSXP)); - if (clf[1] == 'g') - UPM_SKEWPART(double, REAL, x, y, - ASSIGN_OFFDIAG_DGE, ASSIGN_ONDIAG_DGE); - else - UPM_SKEWPART(double, REAL, x, y, - ASSIGN_OFFDIAG_DTR, ASSIGN_ONDIAG_DGE); - } else { /* clf[0] == 'z' */ - PROTECT(y = allocVector(CPLXSXP, (R_xlen_t) n * n)); - if (clf[1] == 'g') - UPM_SKEWPART(Rcomplex, COMPLEX, x, y, - ASSIGN_OFFDIAG_ZGE, ASSIGN_ONDIAG_ZGE); - else - UPM_SKEWPART(Rcomplex, COMPLEX, x, y, - ASSIGN_OFFDIAG_ZTR, ASSIGN_ONDIAG_ZGE); - } - - SET_SLOT(to, Matrix_xSym, y); - UNPROTECT(1); /* y */ - - } else { /* clf[1] == 's' */ - - if (clf[0] != 'z') { - /* Skew-symmetric part of symmetric matrix is zero matrix */ - R_xlen_t n1a = (R_xlen_t) n + 1; - SEXP p = PROTECT(allocVector(INTSXP, n1a)); - int *pp = INTEGER(p); - Matrix_memset(pp, 0, n1a, sizeof(int)); - SET_SLOT(to, Matrix_pSym, p); - UNPROTECT(1); /* p */ - } else { - /* Skew-symmetric part of Hermitian matrix is imaginary part */ - REPROTECT(x = duplicate(x), pid); - zeroRe(x); - SET_SLOT(to, Matrix_xSym, x); - } - - } - - UNPROTECT(2); /* x, to */ - return to; -} - -/* skewpart(x) */ -SEXP matrix_skewpart(SEXP from) -{ - SEXP dim = PROTECT(getAttrib(from, R_DimSymbol)); - int *pdim = INTEGER(dim), n = pdim[0]; - if (pdim[1] != n) - error(_("attempt to get skew-symmetric part of non-square matrix")); - - SEXP to, x; - PROTECT_INDEX pid; - PROTECT_WITH_INDEX(x = from, &pid); - - char ul = 'U'; - int i, j; - R_xlen_t upos = 0, lpos = 0; - - switch (TYPEOF(x)) { - case LGLSXP: - case INTSXP: - REPROTECT(x = coerceVector(x, REALSXP), pid); - case REALSXP: - PROTECT(to = NEW_OBJECT_OF_CLASS("dgeMatrix")); - if (!MAYBE_REFERENCED(x)) { - SET_ATTRIB(x, R_NilValue); - UPM_SKEWPART(double, REAL, x, x, - ASSIGN_OFFDIAG_DGE, ASSIGN_ONDIAG_DGE); - } else { - REPROTECT(x = allocVector(REALSXP, (R_xlen_t) n * n), pid); - UPM_SKEWPART(double, REAL, from, x, - ASSIGN_OFFDIAG_DGE, ASSIGN_ONDIAG_DGE); - } - break; -#ifdef MATRIX_ENABLE_ZMATRIX - case CPLXSXP: - PROTECT(to = NEW_OBJECT_OF_CLASS("zgeMatrix")); - if (!MAYBE_REFERENCED(from)) { - SET_ATTRIB(x, R_NilValue); - UPM_SKEWPART(Rcomplex, COMPLEX, x, x, - ASSIGN_OFFDIAG_DGE, ASSIGN_ONDIAG_DGE); - } else { - REPROTECT(x = allocVector(CPLXSXP, (R_xlen_t) n * n), pid); - UPM_SKEWPART(Rcomplex, COMPLEX, from, x, - ASSIGN_OFFDIAG_ZGE, ASSIGN_ONDIAG_ZGE); - } - break; -#endif - default: - ERROR_INVALID_TYPE(x, __func__); - break; - } - - if (n > 0) - SET_SLOT(to, Matrix_DimSym, dim); - SET_SLOT(to, Matrix_xSym, x); - - SEXP dimnames = PROTECT(getAttrib(from, R_DimNamesSymbol)); - if (!isNull(dimnames)) - set_symmetrized_DimNames(to, dimnames, -1); - - UNPROTECT(4); /* dimnames, to, x, dim */ - return to; -} - -#undef ASSIGN_ONDIAG_DGE -#undef ASSIGN_ONDIAG_ZGE -#undef ASSIGN_OFFDIAG_DGE -#undef ASSIGN_OFFDIAG_DTR -#undef ASSIGN_OFFDIAG_ZGE -#undef ASSIGN_OFFDIAG_ZTR -#undef UPM_SKEWPART diff -Nru rmatrix-1.6-1.1/src/unpackedMatrix.h rmatrix-1.6-5/src/unpackedMatrix.h --- rmatrix-1.6-1.1/src/unpackedMatrix.h 2023-07-30 16:26:24.000000000 +0000 +++ rmatrix-1.6-5/src/unpackedMatrix.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -#ifndef MATRIX_UNPACKEDMATRIX_H -#define MATRIX_UNPACKEDMATRIX_H - -#include "Mutils.h" - -SEXP unpackedMatrix_force_symmetric(SEXP from, SEXP uplo_to); - -SEXP unpackedMatrix_is_triangular(SEXP obj, SEXP upper); -SEXP matrix_is_triangular(SEXP obj, SEXP upper); - -SEXP unpackedMatrix_is_symmetric(SEXP obj, SEXP checkDN); -SEXP matrix_is_symmetric(SEXP obj, SEXP checkDN); - -SEXP unpackedMatrix_is_diagonal(SEXP obj); -SEXP matrix_is_diagonal(SEXP obj); - -SEXP unpackedMatrix_transpose(SEXP from); -SEXP unpackedMatrix_diag_get(SEXP obj, SEXP nms); -SEXP unpackedMatrix_diag_set(SEXP obj, SEXP val); - -SEXP unpackedMatrix_symmpart(SEXP from); -SEXP matrix_symmpart(SEXP from); - -SEXP unpackedMatrix_skewpart(SEXP from); -SEXP matrix_skewpart(SEXP from); - -#endif /* MATRIX_UNPACKEDMATRIX_H */ diff -Nru rmatrix-1.6-1.1/src/utils-R.c rmatrix-1.6-5/src/utils-R.c --- rmatrix-1.6-1.1/src/utils-R.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/utils-R.c 2023-11-28 11:50:51.000000000 +0000 @@ -0,0 +1,644 @@ +#include "Mdefines.h" +#include "utils-R.h" + +SEXP R_Matrix_version(void) +{ + SEXP ans, nms; + PROTECT(ans = allocVector(INTSXP, 3)); + INTEGER(ans)[0] = MATRIX_PACKAGE_VERSION; + INTEGER(ans)[1] = MATRIX_ABI_VERSION; + INTEGER(ans)[2] = MATRIX_SUITESPARSE_VERSION; + PROTECT(nms = allocVector(STRSXP, 3)); + SET_STRING_ELT(nms, 0, mkChar("package")); + SET_STRING_ELT(nms, 1, mkChar("abi")); + SET_STRING_ELT(nms, 2, mkChar("suitesparse")); + setAttrib(ans, R_NamesSymbol, nms); + UNPROTECT(2); + return ans; +} + +SEXP R_index_triangle(SEXP n, SEXP packed, SEXP upper, SEXP diag) +{ + SEXP r; + int i, j, n_ = asInteger(n), packed_ = asLogical(packed), + upper_ = asLogical(upper), diag_ = asLogical(diag); + Matrix_int_fast64_t + nn = (Matrix_int_fast64_t) n_ * n_, + nx = (packed_) ? n_ + (nn - n_) / 2 : nn, + nr = (diag_) ? n_ + (nn - n_) / 2 : (nn - n_) / 2; + if (nx > 0x1.0p+53) + error(_("indices would exceed %s"), "2^53"); + if (nr > R_XLEN_T_MAX) + error(_("attempt to allocate vector of length exceeding %s"), + "R_XLEN_T_MAX"); + +#define DO_INDEX \ + do { \ + if (packed_) { \ + if (diag_) { \ + while (k <= nr_) \ + *(pr++) = k++; \ + } else if (upper_) { \ + for (j = 0; j < n_; ++j) { \ + for (i = 0; i < j; ++i) \ + *(pr++) = k++; \ + k++; \ + } \ + } else { \ + for (j = 0; j < n_; ++j) { \ + k++; \ + for (i = j+1; i < n_; ++i) \ + *(pr++) = k++; \ + } \ + } \ + } else if (diag_) { \ + if (upper_) { \ + for (j = 0; j < n_; ++j) { \ + for (i = 0; i <= j; ++i) \ + *(pr++) = k++; \ + k += n_-j-1; \ + } \ + } else { \ + for (j = 0; j < n_; ++j) { \ + k += j; \ + for (i = j; i < n_; ++i) \ + *(pr++) = k++; \ + } \ + } \ + } else { \ + if (upper_) { \ + for (j = 0; j < n_; ++j) { \ + for (i = 0; i < j; ++i) \ + *(pr++) = k++; \ + k += n_-j; \ + } \ + } else { \ + for (j = 0; j < n_; ++j) { \ + k += j+1; \ + for (i = j+1; i < n_; ++i) \ + *(pr++) = k++; \ + } \ + } \ + } \ + } while (0) + + if (nx > INT_MAX) { + + PROTECT(r = allocVector(REALSXP, (R_xlen_t) nr)); + double k = 1.0, nr_ = (double) nr, *pr = REAL(r); + + DO_INDEX; + + } else { + + PROTECT(r = allocVector(INTSXP, (R_xlen_t) nr)); + int k = 1, nr_ = (int) nr, *pr = INTEGER(r); + + DO_INDEX; + + } + +#undef DO_INDEX + + UNPROTECT(1); + return r; +} + +SEXP R_index_diagonal(SEXP n, SEXP packed, SEXP upper) +{ + SEXP r; + int j, n_ = asInteger(n), packed_ = asLogical(packed), + upper_ = asLogical(upper); + Matrix_int_fast64_t + nn = (Matrix_int_fast64_t) n_ * n_, + nx = (packed_) ? n_ + (nn - n_) / 2 : nn; + if (nx > 0x1.0p+53) + error(_("indices would exceed %s"), "2^53"); + +#define DO_INDEX \ + do { \ + if (!packed_) { \ + for (j = 0; j < n_; ++j) { \ + *(pr++) = k++; \ + k += n_; \ + } \ + } else if (upper_) { \ + for (j = 0; j < n_; ++j) { \ + *(pr++) = k; \ + k += j+2; \ + } \ + } else { \ + for (j = 0; j < n_; ++j) { \ + *(pr++) = k; \ + k += n_-j; \ + } \ + } \ + } while (0) + + if (nx > INT_MAX) { + + PROTECT(r = allocVector(REALSXP, n_)); + double k = 1.0, *pr = REAL(r); + + DO_INDEX; + + } else { + + PROTECT(r = allocVector(INTSXP, n_)); + int k = 1, *pr = INTEGER(r); + DO_INDEX; + + } + +#undef DO_INDEX + + UNPROTECT(1); + return r; +} + +SEXP R_nnz(SEXP x, SEXP countNA, SEXP nnzmax) +{ + int do_countNA = asLogical(countNA); + R_xlen_t n = XLENGTH(x), nnz = 0; + double n_ = asReal(nnzmax); + if (!ISNAN(n_) && n_ >= 0.0 && n_ < (double) n) + n = (R_xlen_t) n_; + +#define DO_NNZ(_CTYPE_, _PTR_, _ISNA_, _ISNZ_, _STRICTLY_ISNZ_) \ + do { \ + _CTYPE_ *px = _PTR_(x); \ + if (do_countNA == NA_LOGICAL) { \ + while (n-- > 0) { \ + if (_ISNA_(*px)) \ + return ScalarInteger(NA_INTEGER); \ + if (_ISNZ_(*px)) \ + ++nnz; \ + ++px; \ + } \ + } else if (do_countNA != 0) { \ + while (n-- > 0) { \ + if (_ISNZ_(*px)) \ + ++nnz; \ + ++px; \ + } \ + } else { \ + while (n-- > 0) { \ + if (_STRICTLY_ISNZ_(*px)) \ + ++nnz; \ + ++px; \ + } \ + } \ + } while (0) + + switch (TYPEOF(x)) { + case LGLSXP: + DO_NNZ(int, LOGICAL, + ISNA_LOGICAL, ISNZ_LOGICAL, STRICTLY_ISNZ_LOGICAL); + break; + case INTSXP: + DO_NNZ(int, INTEGER, + ISNA_INTEGER, ISNZ_INTEGER, STRICTLY_ISNZ_INTEGER); + break; + case REALSXP: + DO_NNZ(double, REAL, + ISNA_REAL, ISNZ_REAL, STRICTLY_ISNZ_REAL); + break; + case CPLXSXP: + DO_NNZ(Rcomplex, COMPLEX, + ISNA_COMPLEX, ISNZ_COMPLEX, STRICTLY_ISNZ_COMPLEX); + break; + default: + ERROR_INVALID_TYPE(x, __func__); + } + +#undef DO_NNZ + + return (nnz <= INT_MAX) + ? ScalarInteger((int) nnz) : ScalarReal((double) nnz); +} + + +/* ================================================================== */ +/* ================================================================== */ + + +#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_ + +// 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 [%lld] is not a sub-multiple " + "or multiple of the number of rows [%d]"), + (long long)lendat, nr); + else if ((lendat > nc && (lendat / nc) * nc != lendat) || + (lendat < nc && (nc / lendat) * lendat != nc)) + warning(_("data length [%lld] is not a sub-multiple " + "or multiple of the number of columns [%d]"), + (long long)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: + { + /* Initialization must work whether Rcomplex is typedef-ed + to a struct { R < 4.3.0 } or to a union { R >= 4.3.0 } + */ + Rcomplex zna = { .r = NA_REAL, .i = 0.0 }; + for (i = 0; i < N; i++) + COMPLEX(ans)[i] = zna; + 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; +} + +/** + * 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 +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; +} + +/** 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; +} + +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; +} + +/** + * 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 diff -Nru rmatrix-1.6-1.1/src/utils-R.h rmatrix-1.6-5/src/utils-R.h --- rmatrix-1.6-1.1/src/utils-R.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/utils-R.h 2023-10-18 20:44:10.000000000 +0000 @@ -0,0 +1,25 @@ +#ifndef MATRIX_UTILS_R_H +#define MATRIX_UTILS_R_H + +#include + +SEXP R_Matrix_version(void); + +SEXP R_index_triangle(SEXP, SEXP, SEXP, SEXP); +SEXP R_index_diagonal(SEXP, SEXP, SEXP); + +SEXP R_nnz(SEXP, SEXP, SEXP); + +SEXP R_all0(SEXP); +SEXP R_any0(SEXP); + +SEXP Mmatrix(SEXP); + +SEXP compressed_non_0_ij(SEXP, SEXP); + +SEXP Matrix_expand_pointers(SEXP); + +SEXP m_encodeInd (SEXP, SEXP, SEXP, SEXP); +SEXP m_encodeInd2(SEXP, SEXP, SEXP, SEXP, SEXP); + +#endif /* MATRIX_UTILS_R_H */ diff -Nru rmatrix-1.6-1.1/src/utils.c rmatrix-1.6-5/src/utils.c --- rmatrix-1.6-1.1/src/utils.c 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/utils.c 2023-09-26 21:39:15.000000000 +0000 @@ -0,0 +1,226 @@ +#include /* vsnprintf */ +#include "Mdefines.h" +#include "utils.h" + +/* memset() but passing length and size rather than their product + which can overflow size_t ... hence _safer_ than Memzero() +*/ +void *Matrix_memset(void *dest, int ch, R_xlen_t length, size_t size) +{ + if (dest && length > 0 && size > 0) { + + char *dest_ = (char *) dest; + size_t N = SIZE_MAX / size; + +#if (SIZE_MAX < R_XLEN_T_MAX) + R_xlen_t S_M = (R_xlen_t) SIZE_MAX; + if (length <= S_M) { +#endif + + /* 'length' is representable as size_t : */ + + size_t n = (size_t) length; + if (n <= N) + memset(dest_, ch, n * size); + else { + size_t d = N * size; + while (n > N) { + memset(dest_, ch, d); + dest_ += d; + n -= d; + } + memset(dest_, ch, n * size); + } + +#if (SIZE_MAX < R_XLEN_T_MAX) + } else { + + /* 'length' would overflow size_t : */ + + size_t n, d = N * size; + while (length > S_M) { + n = SIZE_MAX; + while (n > N) { + memset(dest_, ch, d); + dest_ += d; + n -= d; + } + memset(dest_, ch, n * size); + length -= S_M; + } + n = (size_t) length; + while (n > N) { + memset(dest_, ch, d); + dest_ += d; + n -= d; + } + memset(dest_, ch, n * size); + + } +#endif + + } + + return dest; +} + +/* memcpy() but passing length and size rather than their product + which can overflow size_t ... hence _safer_ than Memcpy() +*/ +void *Matrix_memcpy(void *dest, const void *src, R_xlen_t length, size_t size) +{ + if (dest && src && length > 0 && size > 0) { + + char *dest_ = (char *) dest; + const char *src_ = (const char *) src; + + size_t N = SIZE_MAX / size; + +#if (SIZE_MAX < R_XLEN_T_MAX) + R_xlen_t S_M = (R_xlen_t) SIZE_MAX; + if (length <= S_M) { +#endif + + /* 'length' is representable as size_t : */ + + size_t n = (size_t) length; + if (n <= N) + memcpy(dest_, src_, n * size); + else { + size_t d = N * size; + while (n > N) { + memcpy(dest_, src_, d); + dest_ += d; + src_ += d; + n -= d; + } + memcpy(dest_, src_, n * size); + } + +#if (SIZE_MAX < R_XLEN_T_MAX) + } else { + + /* 'length' would overflow size_t : */ + + size_t n, d = N * size; + while (length > S_M) { + n = SIZE_MAX; + while (n > N) { + memcpy(dest_, src_, d); + dest_ += d; + src_ += d; + n -= d; + } + memcpy(dest_, src_, n * size); + length -= S_M; + } + n = (size_t) length; + while (n > N) { + memcpy(dest_, src_, d); + dest_ += d; + n -= d; + } + memcpy(dest_, src_, n * size); + + } +#endif + + } + + return dest; +} + +char *Matrix_sprintf(const char *format, ...) +{ + char *buf = R_alloc(Matrix_ErrorBufferSize, sizeof(char)); + va_list args; + va_start(args, format); + vsnprintf(buf, Matrix_ErrorBufferSize, format, args); + va_end(args); + return buf; +} + +int equal_character_vectors(SEXP s1, SEXP s2, int n) +{ + /* FIXME? not distinguishing between NA_STRING and "NA" */ + for (int i = 0; i < n; ++i) + if (strcmp(CHAR(STRING_ELT(s1, i)), CHAR(STRING_ELT(s2, i))) != 0) + return 0; + return 1; +} + +void conjugate(SEXP x) +{ + Rcomplex *px = COMPLEX(x); + R_xlen_t nx = XLENGTH(x); + while (nx--) { + (*px).i = -(*px).i; + ++px; + } + return; +} + +void zeroRe(SEXP x) +{ + Rcomplex *px = COMPLEX(x); + R_xlen_t nx = XLENGTH(x); + while (nx--) { + (*px).r = 0.0; + ++px; + } + return; +} + +void zeroIm(SEXP x) +{ + Rcomplex *px = COMPLEX(x); + R_xlen_t nx = XLENGTH(x); + while (nx--) { + (*px).i = 0.0; + ++px; + } + return; +} + +void naToOne(SEXP x) +{ + R_xlen_t i, n = XLENGTH(x); + switch (TYPEOF(x)) { + case LGLSXP: + { + int *px = LOGICAL(x); + for (i = 0; i < n; ++i, ++px) + if (*px == NA_LOGICAL) + *px = 1; + break; + } + case INTSXP: + { + int *px = INTEGER(x); + for (i = 0; i < n; ++i, ++px) + if (*px == NA_INTEGER) + *px = 1; + break; + } + case REALSXP: + { + double *px = REAL(x); + for (i = 0; i < n; ++i, ++px) + if (ISNAN(*px)) + *px = 1.0; + break; + } + case CPLXSXP: + { + Rcomplex *px = COMPLEX(x); + for (i = 0; i < n; ++i, ++px) + if (ISNAN((*px).r) || ISNAN((*px).i)) + *px = Matrix_zone; + break; + } + default: + ERROR_INVALID_TYPE(x, __func__); + break; + } + return; +} diff -Nru rmatrix-1.6-1.1/src/utils.h rmatrix-1.6-5/src/utils.h --- rmatrix-1.6-1.1/src/utils.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/utils.h 2023-09-26 21:39:15.000000000 +0000 @@ -0,0 +1,18 @@ +#ifndef MATRIX_UTILS_H +#define MATRIX_UTILS_H + +#include /* size_t */ +#include + +void *Matrix_memset(void *, int, R_xlen_t, size_t); +void *Matrix_memcpy(void *, const void *, R_xlen_t, size_t); +char *Matrix_sprintf(const char *, ...); + +int equal_character_vectors(SEXP, SEXP, int); + +void conjugate(SEXP); +void zeroRe(SEXP); +void zeroIm(SEXP); +void naToOne(SEXP); + +#endif /* MATRIX_UTILS_H */ diff -Nru rmatrix-1.6-1.1/src/validity.c rmatrix-1.6-5/src/validity.c --- rmatrix-1.6-1.1/src/validity.c 2023-08-04 17:13:45.000000000 +0000 +++ rmatrix-1.6-5/src/validity.c 2024-01-03 20:13:16.000000000 +0000 @@ -1,15 +1,7 @@ +#include /* trunc */ +#include "Mdefines.h" #include "validity.h" -static char *Matrix_sprintf(const char *format, ...) -{ - char *buf = R_alloc(Matrix_ErrorBufferSize, sizeof(char)); - va_list args; - va_start(args, format); - vsnprintf(buf, Matrix_ErrorBufferSize, format, args); - va_end(args); - return buf; -} - #define MK(_FORMAT_ ) mkString(_FORMAT_ ) #define MS(_FORMAT_, ...) Matrix_sprintf(_FORMAT_, __VA_ARGS__) @@ -189,20 +181,18 @@ SEXP x = GET_SLOT(obj, Matrix_xSym); \ if (TYPEOF(x) != _SEXPTYPE_) \ RMKMS(_("'%s' slot is not of type \"%s\""), "x", type2char(_SEXPTYPE_)); \ - \ return ScalarLogical(1); \ } -/* NB: "nsparseMatrix" has no 'x' slot, only "ndenseMatrix" ... */ -KINDMATRIX_VALIDATE(ndense, LGLSXP) -KINDMATRIX_VALIDATE( l, LGLSXP) -KINDMATRIX_VALIDATE( i, INTSXP) -KINDMATRIX_VALIDATE( d, REALSXP) -KINDMATRIX_VALIDATE( z, CPLXSXP) +KINDMATRIX_VALIDATE(n, LGLSXP) +KINDMATRIX_VALIDATE(l, LGLSXP) +KINDMATRIX_VALIDATE(i, INTSXP) +KINDMATRIX_VALIDATE(d, REALSXP) +KINDMATRIX_VALIDATE(z, CPLXSXP) #undef KINDMATRIX_VALIDATE SEXP compMatrix_validate(SEXP obj) { - SEXP factors = GET_SLOT(obj, Matrix_factorSym); + SEXP factors = GET_SLOT(obj, Matrix_factorsSym); if (TYPEOF(factors) != VECSXP) RMKMS(_("'%s' slot is not a list"), "factors"); if (XLENGTH(factors) > 0) { @@ -258,7 +248,7 @@ PROTECT(rn = ANY_TO_STRING(rn)); PROTECT(cn = ANY_TO_STRING(cn)); UNPROTECT(4); /* cn, rn */ - if (!equal_string_vectors(rn, cn, n)) + if (!equal_character_vectors(rn, cn, n)) RMKMS(_("%s[1] differs from %s[2]"), "Dimnames", "Dimnames"); } } @@ -1010,6 +1000,88 @@ return ScalarLogical(1); } +SEXP sparseVector_validate(SEXP obj) +{ + SEXP length = GET_SLOT(obj, Matrix_lengthSym); + if (TYPEOF(length) != INTSXP && TYPEOF(length) != REALSXP) + RMKMS(_("'%s' slot is not of type \"%s\" or \"%s\""), + "length", "integer", "double"); + if (XLENGTH(length) != 1) + RMKMS(_("'%s' slot does not have length %d"), "length", 1); + Matrix_int_fast64_t n; + if (TYPEOF(length) == INTSXP) { + int n_ = INTEGER(length)[0]; + if (n_ == NA_INTEGER) + RMKMS(_("'%s' slot is NA"), "length"); + if (n_ < 0) + RMKMS(_("'%s' slot is negative"), "length"); + n = (Matrix_int_fast64_t) n_; + } else { + double n_ = REAL(length)[0]; + if (ISNAN(n_)) + RMKMS(_("'%s' slot is NA"), "length"); + if (n_ < 0.0) + RMKMS(_("'%s' slot is negative"), "length"); + if (n_ > 0x1.0p+53) + RMKMS(_("'%s' slot exceeds %s"), "length", "2^53"); + n = (Matrix_int_fast64_t) n_; + } + + SEXP i = GET_SLOT(obj, Matrix_iSym); + if (TYPEOF(i) != INTSXP && TYPEOF(i) != REALSXP) + RMKMS(_("'%s' slot is not of type \"%s\" or \"%s\""), + "i", "integer", "double"); + R_xlen_t nnz = XLENGTH(i); + if (nnz > n) + RMKMS(_("'%s' slot has length greater than '%s' slot"), "i", "length"); + if (TYPEOF(i) == INTSXP) { + int *pi = INTEGER(i), max = (n > INT_MAX) ? INT_MAX : (int) n, last = 0; + while (nnz--) { + if (*pi == NA_INTEGER) + RMKMS(_("'%s' slot contains NA"), "i"); + if (*pi < 1 || *pi > max) + RMKMS(_("'%s' slot has elements not in {%s}"), + "i", "1,...,length"); + if (*pi <= last) + RMKMS(_("'%s' slot is not increasing"), "i"); + last = *(pi++); + } + } else { + double *pi = REAL(i), max = (double) n, last = 0.0, tmp; + while (nnz--) { + if (ISNAN(*pi)) + RMKMS(_("'%s' slot contains NA"), "i"); + tmp = trunc(*(pi++)); + if (tmp < 1.0 || tmp > max) + RMKMS(_("'%s' slot has elements not in {%s} after truncation towards zero"), + "i", "1,...,length"); + if (tmp <= last) + RMKMS(_("'%s' slot is not increasing after truncation towards zero"), "i"); + last = tmp; + } + } + + return ScalarLogical(1); +} + +#define KINDVECTOR_VALIDATE(_PREFIX_, _SEXPTYPE_) \ +SEXP _PREFIX_ ## sparseVector_validate(SEXP obj) \ +{ \ + SEXP x = PROTECT(GET_SLOT(obj, Matrix_xSym)), \ + i = PROTECT(GET_SLOT(obj, Matrix_iSym)); \ + UNPROTECT(2); /* i, x */ \ + if (TYPEOF(x) != _SEXPTYPE_) \ + RMKMS(_("'%s' slot is not of type \"%s\""), "x", type2char(_SEXPTYPE_)); \ + if (XLENGTH(x) != XLENGTH(i)) \ + RMKMS(_("'%s' and '%s' slots do not have equal length"), "i", "x"); \ + return ScalarLogical(1); \ +} +KINDVECTOR_VALIDATE(l, LGLSXP) +KINDVECTOR_VALIDATE(i, INTSXP) +KINDVECTOR_VALIDATE(d, REALSXP) +KINDVECTOR_VALIDATE(z, CPLXSXP) +#undef KINDVECTOR_VALIDATE + SEXP denseLU_validate(SEXP obj) { /* In R, we start by checking that 'obj' would be a valid dgeMatrix */ @@ -1139,9 +1211,8 @@ if (XLENGTH(beta) != n) RMKMS(_("'%s' slot does not have length %s"), "beta", "Dim[2]"); - SEXP p, i, x, q; + SEXP p, i, q; int *pp, *pi, *pq, j, k, kend; - double *px; SEXP V = PROTECT(GET_SLOT(obj, Matrix_VSym)); PROTECT(dim = GET_SLOT(V, Matrix_DimSym)); @@ -1172,8 +1243,7 @@ PROTECT(dim = GET_SLOT(R, Matrix_DimSym)); PROTECT(p = GET_SLOT(R, Matrix_pSym)); PROTECT(i = GET_SLOT(R, Matrix_iSym)); - PROTECT(x = GET_SLOT(R, Matrix_xSym)); - UNPROTECT(5); /* x, i, p, dim, R */ + UNPROTECT(4); /* i, p, dim, R */ pdim = INTEGER(dim); if (pdim[0] != m0) @@ -1182,15 +1252,16 @@ RMKMS(_("'%s' slot does not have %s columns"), "R", "Dim[2]"); pp = INTEGER(p); pi = INTEGER(i); - px = REAL(x); for (j = 0, k = 0; j < n; ++j) { kend = pp[j + 1]; if (k < kend) { if (pi[kend - 1] > j) RMKMS(_("'%s' slot must be upper trapezoidal but has entries below the diagonal"), "R"); +#if 0 /* cs_house imposes diag(R) >= 0 in CSparse but not in CXSparse */ if (pi[kend - 1] == j && !ISNAN(px[kend - 1]) && px[kend - 1] < 0.0) RMKMS(_("'%s' slot has negative diagonal elements"), "R"); +#endif } k = kend; } @@ -1575,7 +1646,7 @@ /* FIXME: maxcsize and maxesize are well-defined properties of the factorization, so we should also test that the values are - _correct_ ... see ./CHOLMOD/Supernodal/cholmod_super_symbolic.c + _correct_ ... see CHOLMOD/Supernodal/cholmod_super_symbolic.c */ SEXP super = PROTECT(GET_SLOT(obj, install("super"))), @@ -1752,7 +1823,7 @@ SEXP v = GET_SLOT(obj, install("EValues")); SEXPTYPE tv = TYPEOF(v); if (tv != REALSXP && tv != CPLXSXP) - RMKMS(_("'%s' slot is not of type \"%s\" or type \"%s\""), + RMKMS(_("'%s' slot is not of type \"%s\" or \"%s\""), "EValues", "double", "complex"); if (XLENGTH(v) != n) RMKMS(_("'%s' slot does not have length %s"), "EValues", "Dim[1]"); @@ -1779,24 +1850,24 @@ do { \ IS_VALID(_C_ ## sparseMatrix); \ if (cl[0] == 'n') { \ - if (cl[1] == 't') \ - IS_VALID(t ## _C_ ## Matrix); \ - else if (cl[1] == 's') \ + if (cl[1] == 's') \ IS_VALID(s ## _C_ ## Matrix); \ + else if (cl[1] == 't') \ + IS_VALID(t ## _C_ ## Matrix); \ } else { \ if (cl[1] == 'g') \ IS_VALID(xg ## _C_ ## Matrix); \ - else if (cl[1] == 't') \ - IS_VALID(xt ## _C_ ## Matrix); \ else if (cl[1] == 's') \ IS_VALID(xs ## _C_ ## Matrix); \ + else if (cl[1] == 't') \ + IS_VALID(xt ## _C_ ## Matrix); \ } \ } while (0) IS_VALID(Matrix); if ((cl[0] == 'i' && cl[1] == 'n' && cl[2] == 'd') || - (cl[0] == 'p' && cl[1] != 'C' && cl[1] != 'c')) { + (cl[0] == 'p' && cl[1] != 'c')) { IS_VALID(indMatrix); if (cl[0] == 'p') IS_VALID(pMatrix); @@ -1804,17 +1875,13 @@ } const char *cl_ = cl; - if (cl[0] == 'C') - cl = "dtrMatrix"; - else if (cl[0] == 'p' && cl[1] == 'C') - cl = "dtpMatrix"; - else if (cl[0] == 'c') + if (cl[0] == 'c') cl = "dpoMatrix"; else if (cl[0] == 'p' && cl[1] == 'c') cl = "dppMatrix"; if (cl[0] == 'n' && cl[2] != 'C' && cl[2] != 'R' && cl[2] != 'T') - IS_VALID(ndenseMatrix); + IS_VALID(nMatrix); else if (cl[0] == 'l') IS_VALID(lMatrix); else if (cl[0] == 'i') @@ -1824,10 +1891,10 @@ else if (cl[0] == 'z') IS_VALID(zMatrix); - if (cl[1] == 't') - IS_VALID(triangularMatrix); - else if (cl[1] == 's' || cl[1] == 'p') + if (cl[1] == 's' || cl[1] == 'p') IS_VALID(symmetricMatrix); + else if (cl[1] == 't') + IS_VALID(triangularMatrix); else if (cl[1] == 'd') { IS_VALID(diagonalMatrix); return; @@ -1841,18 +1908,14 @@ IS_VALID_SPARSE(T); else if (cl[2] != 'p') { IS_VALID(unpackedMatrix); - if (cl_[0] == 'C') - IS_VALID(Cholesky); - else if (cl[1] == 'p') { + if (cl[1] == 'p') { IS_VALID(dpoMatrix); if (cl_[0] == 'c') IS_VALID(corMatrix); } } else { IS_VALID(packedMatrix); - if (cl_[0] == 'p' && cl_[1] == 'C') - IS_VALID(pCholesky); - else if (cl[1] == 'p') { + if (cl[1] == 'p') { IS_VALID(dppMatrix); if (cl_[0] == 'p' && cl_[1] == 'c') IS_VALID(pcorMatrix); diff -Nru rmatrix-1.6-1.1/src/validity.h rmatrix-1.6-5/src/validity.h --- rmatrix-1.6-1.1/src/validity.h 2023-08-03 17:38:48.000000000 +0000 +++ rmatrix-1.6-5/src/validity.h 2023-09-22 04:18:08.000000000 +0000 @@ -1,76 +1,82 @@ #ifndef MATRIX_VALIDITY_H #define MATRIX_VALIDITY_H -#include "Mutils.h" +#include -char* Dim_validate(SEXP dim); -SEXP R_Dim_validate(SEXP dim); +char* Dim_validate(SEXP); +SEXP R_Dim_validate(SEXP); -char* DimNames_validate(SEXP dimnames, int pdim[]); -SEXP R_DimNames_validate(SEXP dimnames, SEXP dim); +char* DimNames_validate(SEXP, int[]); +SEXP R_DimNames_validate(SEXP, SEXP); -SEXP R_DimNames_fixup(SEXP dn); - -SEXP Matrix_validate(SEXP obj); -SEXP MatrixFactorization_validate(SEXP obj); - -SEXP dMatrix_validate(SEXP obj); -SEXP lMatrix_validate(SEXP obj); -SEXP ndenseMatrix_validate(SEXP obj); -SEXP iMatrix_validate(SEXP obj); -SEXP zMatrix_validate(SEXP obj); - -SEXP compMatrix_validate(SEXP obj); -SEXP symmetricMatrix_validate(SEXP obj); -SEXP triangularMatrix_validate(SEXP obj); - -SEXP diagonalMatrix_validate(SEXP obj); -SEXP indMatrix_validate(SEXP obj); -SEXP pMatrix_validate(SEXP obj); - -SEXP CsparseMatrix_validate(SEXP obj); -SEXP RsparseMatrix_validate(SEXP obj); -SEXP TsparseMatrix_validate(SEXP obj); - -SEXP sCMatrix_validate(SEXP obj); -SEXP tCMatrix_validate(SEXP obj); -SEXP sRMatrix_validate(SEXP obj); -SEXP tRMatrix_validate(SEXP obj); -SEXP sTMatrix_validate(SEXP obj); -SEXP tTMatrix_validate(SEXP obj); - -SEXP xgCMatrix_validate(SEXP obj); -SEXP xsCMatrix_validate(SEXP obj); -SEXP xtCMatrix_validate(SEXP obj); -SEXP xgRMatrix_validate(SEXP obj); -SEXP xsRMatrix_validate(SEXP obj); -SEXP xtRMatrix_validate(SEXP obj); -SEXP xgTMatrix_validate(SEXP obj); -SEXP xsTMatrix_validate(SEXP obj); -SEXP xtTMatrix_validate(SEXP obj); - -SEXP unpackedMatrix_validate(SEXP obj); -SEXP packedMatrix_validate(SEXP obj); - -SEXP dpoMatrix_validate(SEXP obj); -SEXP dppMatrix_validate(SEXP obj); -SEXP corMatrix_validate(SEXP obj); -SEXP pcorMatrix_validate(SEXP obj); - -SEXP denseLU_validate(SEXP obj); -SEXP sparseLU_validate(SEXP obj); -SEXP sparseQR_validate(SEXP obj); -SEXP BunchKaufman_validate(SEXP obj); -SEXP pBunchKaufman_validate(SEXP obj); -SEXP Cholesky_validate(SEXP obj); -SEXP pCholesky_validate(SEXP obj); -SEXP CHMfactor_validate(SEXP obj); -SEXP CHMsimpl_validate(SEXP obj); -SEXP CHMsuper_validate(SEXP obj); -SEXP dCHMsimpl_validate(SEXP obj); -SEXP dCHMsuper_validate(SEXP obj); -SEXP Schur_validate(SEXP obj); +SEXP R_DimNames_fixup(SEXP); + +SEXP Matrix_validate(SEXP); +SEXP MatrixFactorization_validate(SEXP); + +SEXP nMatrix_validate(SEXP); +SEXP lMatrix_validate(SEXP); +SEXP iMatrix_validate(SEXP); +SEXP dMatrix_validate(SEXP); +SEXP zMatrix_validate(SEXP); + +SEXP compMatrix_validate(SEXP); +SEXP symmetricMatrix_validate(SEXP); +SEXP triangularMatrix_validate(SEXP); + +SEXP diagonalMatrix_validate(SEXP); +SEXP indMatrix_validate(SEXP); +SEXP pMatrix_validate(SEXP); + +SEXP CsparseMatrix_validate(SEXP); +SEXP RsparseMatrix_validate(SEXP); +SEXP TsparseMatrix_validate(SEXP); + +SEXP sCMatrix_validate(SEXP); +SEXP tCMatrix_validate(SEXP); +SEXP sRMatrix_validate(SEXP); +SEXP tRMatrix_validate(SEXP); +SEXP sTMatrix_validate(SEXP); +SEXP tTMatrix_validate(SEXP); + +SEXP xgCMatrix_validate(SEXP); +SEXP xsCMatrix_validate(SEXP); +SEXP xtCMatrix_validate(SEXP); +SEXP xgRMatrix_validate(SEXP); +SEXP xsRMatrix_validate(SEXP); +SEXP xtRMatrix_validate(SEXP); +SEXP xgTMatrix_validate(SEXP); +SEXP xsTMatrix_validate(SEXP); +SEXP xtTMatrix_validate(SEXP); + +SEXP unpackedMatrix_validate(SEXP); +SEXP packedMatrix_validate(SEXP); + +SEXP dpoMatrix_validate(SEXP); +SEXP dppMatrix_validate(SEXP); +SEXP corMatrix_validate(SEXP); +SEXP pcorMatrix_validate(SEXP); + +SEXP sparseVector_validate(SEXP); +SEXP lsparseVector_validate(SEXP); +SEXP isparseVector_validate(SEXP); +SEXP dsparseVector_validate(SEXP); +SEXP zsparseVector_validate(SEXP); + +SEXP denseLU_validate(SEXP); +SEXP sparseLU_validate(SEXP); +SEXP sparseQR_validate(SEXP); +SEXP BunchKaufman_validate(SEXP); +SEXP pBunchKaufman_validate(SEXP); +SEXP Cholesky_validate(SEXP); +SEXP pCholesky_validate(SEXP); +SEXP CHMfactor_validate(SEXP); +SEXP CHMsimpl_validate(SEXP); +SEXP CHMsuper_validate(SEXP); +SEXP dCHMsimpl_validate(SEXP); +SEXP dCHMsuper_validate(SEXP); +SEXP Schur_validate(SEXP); -void validObject(SEXP obj, const char* cl); +void validObject(SEXP, const char *); #endif /* MATRIX_VALIDITY_H */ diff -Nru rmatrix-1.6-1.1/src/version.h rmatrix-1.6-5/src/version.h --- rmatrix-1.6-1.1/src/version.h 1970-01-01 00:00:00.000000000 +0000 +++ rmatrix-1.6-5/src/version.h 2023-11-30 18:40:54.000000000 +0000 @@ -0,0 +1,18 @@ +#ifndef MATRIX_VERSION_H +#define MATRIX_VERSION_H + +/* (version)_{10} = (major minor patch)_{256} */ +#define MATRIX_PACKAGE_VERSION 67077 +#define MATRIX_PACKAGE_MAJOR 1 +#define MATRIX_PACKAGE_MINOR 6 +#define MATRIX_PACKAGE_PATCH 5 + +#define MATRIX_ABI_VERSION 1 + +/* (version)_{10} = (major minor patch)_{256} */ +#define MATRIX_SUITESPARSE_VERSION 330241 +#define MATRIX_SUITESPARSE_MAJOR 5 +#define MATRIX_SUITESPARSE_MINOR 10 +#define MATRIX_SUITESPARSE_PATCH 1 + +#endif /* MATRIX_VERSION_H */ diff -Nru rmatrix-1.6-1.1/tests/Class+Meth.R rmatrix-1.6-5/tests/Class+Meth.R --- rmatrix-1.6-1.1/tests/Class+Meth.R 2023-04-23 06:14:20.000000000 +0000 +++ rmatrix-1.6-5/tests/Class+Meth.R 2023-08-16 05:39:47.000000000 +0000 @@ -5,21 +5,18 @@ options(warn=1)# show as they happen cat("doExtras:",doExtras,"\n") -no.Mcl <- function(cl) ## TRUE if MatrixClass() returns empty, i.e., have "no Matrix-pkg class" - identical(MatrixClass(cl), character(0)) - setClass("myDGC", contains = "dgCMatrix") -M <- new("myDGC", as(Matrix(c(-2:4, rep(0,9)), 4), "CsparseMatrix")) -M -stopifnot(M[-4,2] == 2:4, - MatrixClass("myDGC" ) == "dgCMatrix", - MatrixClass("Cholesky" ) == "dtrMatrix", - MatrixClass("pCholesky") == "dtpMatrix", - MatrixClass("corMatrix") == "dpoMatrix", - no.Mcl("pMatrix"), - no.Mcl("indMatrix")) - -## FIXME: Export MatrixClass !! +(M <- new("myDGC", as(Matrix(c(-2:4, rep(0,9)), 4), "CsparseMatrix"))) +stopifnot(exprs = { + M[-4L, 2L] == 2:4 + MatrixClass( "myDGC") == "dgCMatrix" + MatrixClass( "dpoMatrix") == "dsyMatrix" + MatrixClass( "dppMatrix") == "dspMatrix" + MatrixClass( "corMatrix") == "dsyMatrix" + MatrixClass("pcorMatrix") == "dspMatrix" + identical(MatrixClass("indMatrix"), character(0L)) + identical(MatrixClass( "pMatrix"), character(0L)) +}) ## [matrix-Bugs][6182] Coercion method doesn't work on child class ## Bugs item #6182, at 2015-09-01 17:49 by Vitalie Spinu diff -Nru rmatrix-1.6-1.1/tests/Simple.R rmatrix-1.6-5/tests/Simple.R --- rmatrix-1.6-1.1/tests/Simple.R 2023-08-11 09:39:26.000000000 +0000 +++ rmatrix-1.6-5/tests/Simple.R 2023-12-09 22:30:22.000000000 +0000 @@ -34,6 +34,9 @@ } else options( Matrix.verbose = TRUE, warn = 1) # ^^^^^^ to show Matrix.msg()s +(Mv <- Matrix.Version()) +stopifnot(identical(packageVersion("Matrix"), Mv[["package"]])) + ### Matrix() ''smartness'' (d40 <- Matrix( diag(4))) (z4 <- Matrix(0*diag(4))) @@ -114,7 +117,7 @@ Mlp <- Matrix(.leap.seconds) stopifnot(identical(dim(Mlp), c(n.lsec, 1L))) assert.EQ.mat(Mlp, mlp) -lt.leap.seconds <- .LS <- as.POSIXlt(.leap.seconds) +lt.leap.seconds <- .LS <- as.POSIXlt(.leap.seconds, tz = "GMT") # GMT => sparse HMS .LS <- unclass(.LS); .LS <- .LS[setdiff(names(.LS), "zone")] # "zone" is character (not there for GMT/UTC in R <= 4.2.x) (matLS <- data.matrix(data.frame(.LS))) @@ -246,8 +249,8 @@ 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... + identical(all.equal(N3, t(N3)), all.equal.raw(1:6, 2:7)), # == "6 element mismatches" + 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, @@ -284,8 +287,8 @@ stopifnot(identical(dmat, ttdm), identical(dimnames(cc), dimnames(dmat)), ## coercing back should give original : - identical(cc, as(dmat, "sparseMatrix")), - identical(uniqTsparse(tt), as(ttdm, "TsparseMatrix"))) + identical(cc, as(dmat, "sparseMatrix")), + identical(asUniqueT(tt), as(ttdm, "TsparseMatrix"))) ## MM: now *if* cc is "truly symmetric", these dimnames should be, too: d5 <- cn[1:5]; dnm5 <- list(d5,d5) @@ -544,7 +547,7 @@ 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"), + is(nLg, "generalMatrix"), is(nnLg, "generalMatrix"), identical3(Lg1, Matrix(nnLg, forceCheck = TRUE), as(nnLg, "diagonalMatrix")), @@ -635,7 +638,7 @@ 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 + 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), @@ -958,7 +961,7 @@ 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")) +stopifnot(is(x, "dsyMatrix"), is(px, "dspMatrix"), is(D, "ddiMatrix")) class(x+D)#--> now "dsyMatrix" stopifnot(is(x+D, "symmetricMatrix"), @@ -1307,8 +1310,7 @@ 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")) +stopifnot(identical(dimnames(m4), dn4), Q.eq(D4n, m4, superclasses=NULL)) ## as(, "matrix") had lost dimnames before s24 <- new("dgCMatrix", Dim = c(2L, 4L), p = integer(5L)) @@ -1360,7 +1362,6 @@ !any(is.na(.dtr)), !any(is.infinite(.dtr)), !any(is.na(.dsy)), - is(is.na(.dsy), "sparseMatrix"), !anyNA(.nge), !anyNA(.dtr), !anyNA(.dsy), @@ -1376,7 +1377,7 @@ .ldi.sp <- symmpart(new("ldiMatrix", Dim = c(1L, 1L), Dimnames = list("a", "b"), x = TRUE)) stopifnot(is(.ldi.sp, "dMatrix"), - is(.ldi.sp, "symmetricMatrix"), + is(.ldi.sp, "diagonalMatrix"), Matrix:::isSymmetricDN(.ldi.sp@Dimnames)) ## as.vector(), etc. must do NA->TRUE @@ -1463,6 +1464,7 @@ y <- new("indMatrix", Dim = c(3L, 9L), perm = sample.int(9L, size = 3L, replace = TRUE)) validObject(x %*% y) +stopifnot(all(tril(y, -1) == 0)) # was wrong in Matrix 1.5-x ## dimScale(x) (i.e., with 'd1' missing) did not work in 1.5-2; ## same with dimScale() ... @@ -1546,6 +1548,50 @@ new("dgeMatrix", x = as.double(1:4), Dim = c(2L, 2L), Dimnames = list(NULL, c("a", "b"))))) +## tri[ul](<.t[rp]Matrix>) was often wrong at least in 1.6-1 +u <- new("dtrMatrix", Dim = c(8L, 8L), x = as.double(seq_len(64L))) +stopifnot(identical(triu(u, 1L), triu(as(u, "generalMatrix"), 1L))) + +## more tril()/triu() woes {introduced after 2021; present till 1.6-4} +for(n in 0:7) { + cat("n = ", n,"\n----\n") + ##TODO: for(m in pmax(0, n-3):(n+3)) { + for(m in pmax(0, n-3):(n+3)) { #-- n x m matrix + cat(" m = ", m,": using k's in ", (-n),":", m, "\n", sep="") + symm <- (m == n) + mn2 <- (mn <- m*n) %/% 2 + ma <- array(seq_len(mn) - mn2 - 1/2, dim = c(n, m)) + if(symm) ma <- crossprod(ma) # crossprod() to be symmetric + dM <- as(as(ma, "denseMatrix"), "generalMatrix") + sM <- as(as(ma, "CsparseMatrix"), "generalMatrix") + for(k in (-n):m) { + trum <- triuChk(ma,k); trlm <- trilChk(ma, k) + trud <- triuChk(dM,k); trld <- trilChk(dM, k) + trus <- triuChk(sM,k); trls <- trilChk(sM, k) + if(symm) { + assert.EQ( trum, t(tril(ma,-k))) + assert.EQ.mat(trud, as.mat(t(tril(dM,-k)))) + assert.EQ.mat(trus, as.mat(t(tril(sM,-k)))) + } + stopifnot(exprs = { + ## matrix + identical(trlm, band(ma, -n, k)) + identical(trum, band(ma, k, m)) + inherits(trum, "denseMatrix") # "dge" / "dtr" ... + ## denseMatrix + identical(trld, band(dM, -n, k)) + identical(trud, band(dM, k, m)) + inherits(trud, "denseMatrix") + assert.EQ.Mat(trud, trum, giveRE=TRUE) + ## sparseMatrix + identical(trls, band(sM, -n, k)) + identical(trus, band(sM, k, m)) + inherits(trus, "sparseMatrix") + assert.EQ.Mat(trus, trum, giveRE=TRUE) + }) + } + } +} ## Platform - and other such info -- so we find it in old saved outputs .libPaths() diff -Nru rmatrix-1.6-1.1/tests/bind.R rmatrix-1.6-5/tests/bind.R --- rmatrix-1.6-1.1/tests/bind.R 2023-06-21 07:07:50.000000000 +0000 +++ rmatrix-1.6-5/tests/bind.R 2023-08-21 15:41:59.000000000 +0000 @@ -122,8 +122,8 @@ 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))) + identical(.tCRT(d4), cbind(Diagonal(4), 0:3)), + identical(.tCRT(m4), rbind(Diagonal(x=-1:2), 0:3))) showProc.time() ### --- Sparse Matrices --- @@ -160,8 +160,9 @@ 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), "CsparseMatrix"))) +stopifnot(identical3(cc, + as(cbind(mT, 0, 7, 0, diag(nr), 0), "CsparseMatrix"), + as(cbind( M, 0, 7, 0, diag(nr), 0), "CsparseMatrix"))) cbind(mC, 1, 100*mC, 0, 0:2) cbind(mT, 1, 0, mT+10*mT, 0, 0:2) @@ -202,8 +203,8 @@ 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(print(rbind2(Matrix(1:10, 2,5), D5)), "dgRMatrix") +stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgCMatrix") stopifnotValid(zz <- cbind2(z42, C86), "dgCMatrix") stopifnot(identical(zz, cbind2(s42, C86))) diff -Nru rmatrix-1.6-1.1/tests/bind.Rout.save rmatrix-1.6-5/tests/bind.Rout.save --- rmatrix-1.6-1.1/tests/bind.Rout.save 2023-06-21 07:15:25.000000000 +0000 +++ rmatrix-1.6-5/tests/bind.Rout.save 2023-08-21 15:41:59.000000000 +0000 @@ -1,5 +1,5 @@ -R version 4.3.1 Patched (2023-06-19 r84580) -- "Beagle Scouts" +R version 4.3.1 Patched (2023-08-08 r84910) -- "Beagle Scouts" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: aarch64-apple-darwin22.5.0 (64-bit) @@ -150,6 +150,9 @@ 1 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] 0 0 1 3 +Warning message: +In cbind.Matrix(x, y, deparse.level = 0L) : + number of rows of result is not a multiple of vector length > as(rbind(0, Matrix(0+0:1, 1,2), 3:2), + "sparseMatrix") 3 x 2 sparse Matrix of class "dgCMatrix" @@ -199,7 +202,7 @@ 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.052 0.005 0.058 +Time (user system elapsed): 0.051 0.006 0.056 > > ## lgeMatrix -- rbind2() had bug (in C code): > is.lge <- function(M) isValid(M, "lgeMatrix") @@ -239,10 +242,10 @@ > 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))) ++ identical(.tCRT(d4), cbind(Diagonal(4), 0:3)), ++ identical(.tCRT(m4), rbind(Diagonal(x=-1:2), 0:3))) > showProc.time() -Time (user system elapsed): 0.019 0 0.019 +Time (user system elapsed): 0.019 0 0.02 > > ### --- Sparse Matrices --- > @@ -290,7 +293,7 @@ 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.023 0.001 0.023 +Time (user system elapsed): 0.018 0.001 0.019 > > cbind(0, mC); cbind(mC, 0) 4 x 7 sparse Matrix of class "dgCMatrix" @@ -306,20 +309,20 @@ [3,] 1 2 . -1 . 1 . [4,] . 1 2 . -1 . . > cbind(0, mT); cbind(mT, 2) -4 x 7 sparse Matrix of class "dgCMatrix" +4 x 7 sparse Matrix of class "dgTMatrix" [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" +4 x 7 sparse Matrix of class "dgTMatrix" [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" +4 x 10 sparse Matrix of class "dgTMatrix" [1,] 1 . . . . -1 . 1 2 . [2,] . 1 . . 2 . -1 . 1 2 @@ -334,8 +337,9 @@ [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), "CsparseMatrix"))) +> stopifnot(identical3(cc, ++ as(cbind(mT, 0, 7, 0, diag(nr), 0), "CsparseMatrix"), ++ as(cbind( M, 0, 7, 0, diag(nr), 0), "CsparseMatrix"))) > > cbind(mC, 1, 100*mC, 0, 0:2) 4 x 15 sparse Matrix of class "dgCMatrix" @@ -392,7 +396,7 @@ + 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" +6 x 5 sparse Matrix of class "lgRMatrix" [,1] [,2] [,3] [,4] [,5] | . . . . . | . . . @@ -471,8 +475,8 @@ [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" +> stopifnotValid(print(rbind2(Matrix(1:10, 2,5), D5)), "dgRMatrix") +7 x 5 sparse Matrix of class "dgRMatrix" [,1] [,2] [,3] [,4] [,5] [1,] 1 3 5 7 9 [2,] 2 4 6 8 10 @@ -481,14 +485,14 @@ [5,] . . 30 . . [6,] . . . 40 . [7,] . . . . 50 -> stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgeMatrix") -5 x 8 Matrix of class "dgeMatrix" +> stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgCMatrix") +5 x 8 sparse Matrix of class "dgCMatrix" [,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 +[1,] 10 5 10 . . . . 1 +[2,] 9 4 . 20 . . . 1 +[3,] 8 3 . . 30 . . 1 +[4,] 7 2 . . . 40 . 1 +[5,] 6 1 . . . . 50 1 > stopifnotValid(zz <- cbind2(z42, C86), "dgCMatrix") > stopifnot(identical(zz, cbind2(s42, C86))) > @@ -534,8 +538,8 @@ > > options(op) > showProc.time() -Time (user system elapsed): 0.048 0.003 0.051 +Time (user system elapsed): 0.06 0.003 0.063 > > proc.time() user system elapsed - 0.615 0.039 0.652 + 0.609 0.039 0.646 diff -Nru rmatrix-1.6-1.1/tests/dg_Matrix.R rmatrix-1.6-5/tests/dg_Matrix.R --- rmatrix-1.6-1.1/tests/dg_Matrix.R 2023-06-21 21:01:51.000000000 +0000 +++ rmatrix-1.6-5/tests/dg_Matrix.R 2023-08-30 06:03:42.000000000 +0000 @@ -72,7 +72,7 @@ identical(mc, as(m2, "CsparseMatrix"))) ### -> uniq* functions now in ../R/Auxiliaries.R -(t2 <- system.time(um2 <- uniqTsparse(m1))) +(t2 <- system.time(um2 <- asUniqueT(m1))) stopifnot(identical(m2,um2)) ### -> error/warning condition for solve() of a singular matrix (Barry Rowlingson) diff -Nru rmatrix-1.6-1.1/tests/dpo-test.R rmatrix-1.6-5/tests/dpo-test.R --- rmatrix-1.6-1.1/tests/dpo-test.R 2023-06-21 07:07:50.000000000 +0000 +++ rmatrix-1.6-5/tests/dpo-test.R 2023-08-16 04:53:38.000000000 +0000 @@ -27,10 +27,8 @@ (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") +h9. <- round(h9, 2) # dpo->dsy +h9p <- pack(h9) ch9p <- Cholesky(h9p, perm = FALSE) stopifnot(identical(ch9p, h9p@factors$pCholesky), identical(names(h9p@factors), c("Cholesky", "pCholesky"))) @@ -54,8 +52,8 @@ po6 <- as(pp6, "dpoMatrix") hs <- as(h9p, "dspMatrix") stopifnot(names(H6@factors) == "pCholesky", - names(pp6@factors) == "pCholesky", - names(hs@factors) == "Cholesky") # for now + 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(as(hs@factors$pCholesky, "dtpMatrix")), diff -Nru rmatrix-1.6-1.1/tests/factorizing.R rmatrix-1.6-5/tests/factorizing.R --- rmatrix-1.6-1.1/tests/factorizing.R 2023-06-21 21:01:51.000000000 +0000 +++ rmatrix-1.6-5/tests/factorizing.R 2024-01-03 16:12:15.000000000 +0000 @@ -393,7 +393,7 @@ 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)) + all.equal(A, A..., tolerance = 1e-14)) invisible(ecc) } @@ -576,16 +576,23 @@ ## Schur ( ) <--> Schur( ) Su <- Schur(uT) ; checkSchur(uT, Su) gT <- as(uT,"generalMatrix") -Sg <- Schur(gT) ; checkSchur(gT, Sg) +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), "generalMatrix")), - identical(Stg@T, as(t(gT[,p:1])[,p:1], "triangularMatrix")), - identical(Stg@Q, as(diag(p)[,p:1], "generalMatrix")), - identical(Stu@T, Stg@T)) -assert.EQ.mat(Stu@Q, as(Stg@Q,"matrix"), tol=0) +stopifnot(exprs = { + identical3(Sg@T, uT, Su@T) + identical(Sg@Q, as(diag(p), "generalMatrix")) + ## LaPck 3.12.0: these must be more careful (Q is *different* permutation): + is.integer(print(ip <- invPerm(pp <- as(Stg@Q, "pMatrix")@perm))) + identical(Stg@T, as(t(gT[,ip])[,ip], "triangularMatrix")) + identical(Stg@Q, as( diag(p)[,ip], "generalMatrix")) + ## Stu still has p:1 permutation, but should not rely on it + is.integer(print(i2 <- invPerm(as(Stu@Q, "pMatrix")@perm))) + identical(Stu@T, as(t(uT[,i2])[,i2], "triangularMatrix")) + identical(Stu@Q, as( diag(p)[,i2], "pMatrix")) # Schur() ==> 'Q' is pMatrix +}) + ## 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), diff -Nru rmatrix-1.6-1.1/tests/group-methods.R rmatrix-1.6-5/tests/group-methods.R --- rmatrix-1.6-1.1/tests/group-methods.R 2023-07-31 00:55:24.000000000 +0000 +++ rmatrix-1.6-5/tests/group-methods.R 2023-11-09 09:24:18.000000000 +0000 @@ -113,8 +113,8 @@ D3 <- Diagonal(x=4:2); L7 <- Diagonal(7) > 0 validObject(xpp <- pack(round(xpx,2))) lsp <- xpp > 0 -(dsyU <- .diag2dense(D3, "s")) - lsyU <- .diag2dense(Diagonal(5) > 0, "s") +(dsyU <- .diag2dense(D3, ".", "s")) + lsyU <- .diag2dense(Diagonal(5) > 0, ".", "s") str(lsyU) stopifnot({ isValid(dsyU, "dsyMatrix") && dsyU@uplo == "U" @@ -240,7 +240,7 @@ identical(dsc, dsc * as(lm1, "dMatrix"))) crossprod(lm1) # lm1: "lsC*" -cnm1 <- crossprod(nm1) +cnm1 <- crossprod(nm1, boolArith = FALSE) stopifnot(is(cnm1, "symmetricMatrix"), ## whereas the %*% is not: Q.eq(cnm1, nm1 %*% nm1)) dn1 <- as(nm1, "denseMatrix") @@ -286,7 +286,7 @@ ## Subclasses (!) setClass("m.spV", contains = "dsparseVector") (m.ddv <- as(ddv, "m.spV")) -stopifnot(all.equal(m.ddv, ddv))# failed +stopifnot(all.equal(m.ddv, ddv, check.class = FALSE))# failed setClass("m.dgC", contains = "dgCMatrix") (m.mC <- as(mC, "m.dgC")) stopifnot(all(m.mC == mC)) @@ -372,7 +372,7 @@ options(op) -if(!doExtras && !interactive()) q("no") ## (saving testing time) +if(doExtras || interactive()) { # save testing time ### Systematically look at all "Ops" group generics for "all" Matrix classes ### -------------- Main issue: Detect infinite recursion problems @@ -457,6 +457,8 @@ } if(length(warnings())) print(summary(warnings())) showProc.time() +options(op) # reset 'warn' +} # doExtras ###---- Now checking 0-length / 0-dim cases <==> to R >= 3.4.0 ! @@ -504,7 +506,7 @@ 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' +if(doExtras || interactive()) { # save testing time mStop <- function(...) stop(..., call. = FALSE) ## cat("Checking the Math (+ Math2) group generics for a set of arguments:\n", @@ -526,9 +528,9 @@ 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) + assert.EQ(R, r, check.class = FALSE) } else { ## (almost always:) matrix result - assert.EQ.mat(R, r) + assert.EQ.mat(R, r, check.class = FALSE) ## 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 && @@ -559,6 +561,7 @@ cat("\n") if(length(warnings())) print(summary(warnings())) } +} # doExtras ## (x) behaved incorrectly in Matrix <= 1.4-1 ## for unit diagonal 'x' when f(0) == 0 and f(1) != 1 @@ -572,4 +575,37 @@ for(u in list(udi, utC, utr)) stopifnot(identical(as(sin(u), "matrix"), sinu)) +## Originally in ../man/all-methods.Rd : +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 +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) + ) + +## prod() does not perform multiplies in row/column order : +x4 <- new("dspMatrix", Dim = c(4L, 4L), + x = c(171, 53, 79, 205, 100, 285, 98, 15, 99, 84)) +p4 <- prod( x4) +p4. <- prod(as(x4, "generalMatrix")) +p4.. <- prod(as(x4, "matrix")) +stopifnot(all.equal(p4, p4. , tolerance = 1e-15), + all.equal(p4., p4.., tolerance = 1e-15)) +all.equal(p4, p4. , tolerance = 0) +all.equal(p4., p4.., tolerance = 0) +.Machine[["sizeof.longdouble"]] + cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' diff -Nru rmatrix-1.6-1.1/tests/indexing.R rmatrix-1.6-5/tests/indexing.R --- rmatrix-1.6-1.1/tests/indexing.R 2023-06-21 17:28:44.000000000 +0000 +++ rmatrix-1.6-5/tests/indexing.R 2023-08-30 06:03:42.000000000 +0000 @@ -608,8 +608,8 @@ 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"))) + identical(asUniqueT(m1[, c(4,2)]), + asUniqueT(m2[, c(4,2)])) )## failed in 0.9975-11 ## 0-dimensional diagonal - subsetting ---------------------------- diff -Nru rmatrix-1.6-1.1/tests/indexing.Rout.save rmatrix-1.6-5/tests/indexing.Rout.save --- rmatrix-1.6-1.1/tests/indexing.Rout.save 2023-08-03 18:14:44.000000000 +0000 +++ rmatrix-1.6-5/tests/indexing.Rout.save 2023-08-30 17:33:15.000000000 +0000 @@ -1,5 +1,5 @@ -R version 4.3.1 Patched (2023-07-29 r84790) -- "Beagle Scouts" +R version 4.3.1 Patched (2023-08-16 r84986) -- "Beagle Scouts" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: aarch64-apple-darwin22.5.0 (64-bit) @@ -57,18 +57,12 @@ + 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[...] : nargs() = 2 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > m[2, 3:4, drop=FALSE] # sub matrix of class 'dgeMatrix' -M[iil] : nargs() = 4 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[ii.] : nargs() = 3 3 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 15 22 @@ -77,13 +71,10 @@ > > ## rows or columns only: > m[1,] # first row, as simple numeric vector -M[i..] : nargs() = 3 [1] 1 8 15 22 > m[,2] # 2nd column -M[.i.] : nargs() = 3 [1] 8 9 10 11 12 13 14 > m[,1:2] # sub matrix of first two columns -M[.i.] : nargs() = 3 7 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 1 8 @@ -94,16 +85,13 @@ [6,] 6 13 [7,] 7 14 > m[-(1:6),, drop=FALSE] # not the first 6 rows, i.e. only the 7th -M[i.l] : nargs() = 4 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..] : nargs() = 3 0 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] > m[2:4, numeric(0)] #-> 3 x 0 Matrix -M[ii.] : nargs() = 3 3 x 0 Matrix of class "dgeMatrix" [1,] @@ -114,27 +102,18 @@ > 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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > > ## dimnames indexing: > mn <- m > dimnames(mn) <- list(paste("r",letters[1:nrow(mn)],sep=""), + LETTERS[1:ncol(mn)]) > checkMatrix(mn) -M[.i.] : nargs() = 3 -M[.il] : nargs() = 4 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[ii.] : nargs() = 3 [1] 25 > msr <- ms <- as(mn,"sparseMatrix") > mnr <- mn @@ -160,28 +139,8 @@ + identical(unname(z), zz), + identical(a.m, array(v, dim=dim(mn), dimnames=dimnames(mn))) + ) -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > showProc.time() -Time (user system elapsed): 0.173 0.006 0.178 +Time (user system elapsed): 0.171 0.006 0.177 > > ## Bug found thanks to Timothy Mak, Feb 3, 2017: > ## sparseMatrix logical indexing with (partial) NA: @@ -189,10 +148,8 @@ > 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[.i.] : nargs() = 3 > ##assert.EQ(as.matrix(ms[,iN4]), a.m[,iN4]) # ms[, ] fails still : _FIXME_ > try(ms[,iN4]) -M[.i.] : nargs() = 3 Error in ..subscript.2ary(x, l[[1L]], l[[2L]], drop = drop[1L]) : NA subscripts in x[i,j] not supported for 'x' inheriting from sparseMatrix > try(ms[,iN4] <- 100) ## <- segfaulted in Matrix <= 1.2-8 (!) @@ -207,14 +164,11 @@ > identical( + dimnames(m44[,FALSE, drop=FALSE]), + dimnames( a[,FALSE, drop=FALSE])) -M[.il] : nargs() = 4 [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..] : nargs() = 3 -M[ii.] : nargs() = 3 > ## Sparse matrix: ----------------------------------------- > s <- as(a %% 3 == 1, "sparseMatrix") > ts <- as(s,"TsparseMatrix") @@ -225,31 +179,17 @@ + dimnames(b), dimnames(tb))) > > chk.ndn(b [i, i]); chk.ndn(b [i, ]) -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 > chk.ndn(s [i, i]); chk.ndn(s [i, ]) -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 > chk.ndn(tb[i, i]); chk.ndn(tb[i, ]) -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 > chk.ndn(ts[i, i]); chk.ndn(ts[i, ]) -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 > chk.ndn( b[ , 1, drop=FALSE]); chk.ndn( s[i, 2, drop=FALSE]) -M[.il] : nargs() = 4 -M[iil] : nargs() = 4 > chk.ndn(tb[ , 1, drop=FALSE]); chk.ndn(ts[i, 2, drop=FALSE]) -M[.il] : nargs() = 4 -M[iil] : 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[.i.] : nargs() = 3 -M[i..] : nargs() = 3 > > ## Printing sparse colnames: > ms[sample(28, 20)] <- 0 @@ -269,7 +209,6 @@ > m[1:2, 4] <- 200 > m[, 1] <- -1 > m[1:3,] -M[i..] : nargs() = 3 3 x 4 Matrix of class "dgeMatrix" [,1] [,2] [,3] [,4] [1,] -1 8 15 200 @@ -283,15 +222,11 @@ > iN[2:3,] <- iN[5,2] <- NA > stopifnot(identical(m[ij], m.[ij]), + identical(m[iN], m.[iN])) -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 > > ## testing operations on logical Matrices rather more than indexing: > g10 <- m [ m > 10 ] -M[m..] : nargs() = 2 > stopifnot(18 == length(g10)) > stopifnot(10 == length(m[ m <= 10 ])) -M[m..] : nargs() = 2 > sel <- (20 < m) & (m < 150) > sel.<- (20 < m.)& (m.< 150) > nsel <-(20 >= m) | (m >= 150) @@ -311,12 +246,8 @@ + identical3(m[ sel], m[ ssel], as(m, "matrix")[as( ssel, "matrix")]), + identical3(m[!sel], m[!ssel], as(m, "matrix")[as(!ssel, "matrix")]) + ) -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 > showProc.time() -Time (user system elapsed): 0.049 0.001 0.05 +Time (user system elapsed): 0.046 0.002 0.048 > > ## more sparse Matrices -------------------------------------- > @@ -463,55 +394,18 @@ .. ..$ : NULL .. ..$ : NULL ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 [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..] : nargs() = 3 2 x 20 sparse Matrix of class "ngCMatrix" [1,] . . . | . . | . . . . | . . | . | . . . [2,] . | . . . | . . . . . . | | . . . . | . -M[i.l] : nargs() = 3 [1] TRUE -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -531,36 +425,9 @@ .. ..$ : chr [1:40] "r1" "r2" "r3" "r4" ... .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 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 @@ -569,22 +436,12 @@ FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE r40 FALSE -M[i..] : nargs() = 3 2 x 20 sparse Matrix of class "ngCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] r1 . . . | . . | . . . . | . . | . | . . . r2 . | . . . | . . . . . . | | . . . . | . -M[i.l] : nargs() = 3 [1] TRUE -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -610,55 +467,18 @@ .. ..$ : NULL ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 [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..] : nargs() = 3 2 x 20 sparse Matrix of class "lgCMatrix" [1,] . . . | . . | . . . . | . . | . | . . . [2,] . | . . . | . . . . . . | | . . . . | . -M[i.l] : nargs() = 3 [1] TRUE -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -680,36 +500,9 @@ .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : logi [1:200] TRUE TRUE TRUE TRUE TRUE TRUE ... ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 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 @@ -718,22 +511,12 @@ FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE r40 FALSE -M[i..] : nargs() = 3 2 x 20 sparse Matrix of class "lgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] r1 . . . | . . | . . . . | . . | . | . . . r2 . | . . . | . . . . . . | | . . . . | . -M[i.l] : nargs() = 3 [1] TRUE -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -759,53 +542,16 @@ .. ..$ : NULL ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 [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..] : nargs() = 3 2 x 20 sparse Matrix of class "dgCMatrix" [1,] . . . 121 . . 241 . . . . 441 . . 561 . 641 . . . [2,] . 42 . . . 202 . . . . . . 482 522 . . . . 722 . -M[i.l] : nargs() = 3 [1] 7 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -827,56 +573,19 @@ .. ..$ : chr [1:20] "c1" "c2" "c3" "c4" ... ..@ x : num [1:200] 3 7 12 22 25 30 38 39 42 45 ... ..@ factors : list() -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 IDENT(): -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 sapply(..): -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 ok -M[.i.] : nargs() = 3 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..] : nargs() = 3 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 . -M[i.l] : nargs() = 3 [1] 7 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 for(): ..... [Ok]---------------------------------------------------------------- @@ -885,7 +594,7 @@ == ###====================================================================== > showProc.time() -Time (user system elapsed): 0.219 0.004 0.223 +Time (user system elapsed): 0.204 0.006 0.212 > > if(doExtras) {### {was ./AAA_index.R, MM-only} + ## an nsparse-example @@ -986,25 +695,18 @@ > ds <- as(S, "denseMatrix") > ## NA-indexing of *dense* Matrices: should work as traditionally > assert.EQ.mat(ds[NA,NA], ss[NA,NA]) -M[ii.] : nargs() = 3 > assert.EQ.mat(ds[NA, ], ss[NA,]) -M[i..] : nargs() = 3 > assert.EQ.mat(ds[ ,NA], ss[,NA]) -M[.i.] : 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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > ## non-repeated indices: > i <- c(7:5, 2:4);assert.EQ.mat(T[i,i], ss[i,i]) -M[ii.] : nargs() = 3 > ## NA in indices -- check that we get a helpful error message: > i[2] <- NA > er <- tryCatch(T[i,i], error = function(e)e) -M[ii.] : nargs() = 3 > if(englishMsgs) + stopifnot(as.logical(grep("indices.*sparse Matrices", er$message))) > @@ -1018,12 +720,6 @@ + identical(as(t(Tii),"CsparseMatrix"), as(tTi,"CsparseMatrix"))) + assert.EQ.mat(Tii, ss[i,i]) + } -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > b <- diag(1:2)[,c(1,1,2,2)] > cb <- crossprod(b) @@ -1042,7 +738,6 @@ > ## 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[ii.] : nargs() = 3 > ## 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)) @@ -1064,57 +759,25 @@ + assert.EQ.mat(A.ii, a.[i,i]) + assert.EQ.mat(T[i,i], ss[i,i]) + } -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > showProc.time() -Time (user system elapsed): 0.069 0.001 0.07 +Time (user system elapsed): 0.062 0.001 0.063 > > 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[.i.] : nargs() = 3 -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 -M[m..] : nargs() = 2 > ## out of bound indexing must be detected: > assertError(mC[cbind(ij[,1] - 5, ij[,2])]) -M[m..] : nargs() = 2 > assertError(mC[cbind(ij[,1], ij[,2] + ncol(mC))]) -M[m..] : nargs() = 2 > > assert.EQ.mat(mC[7, , drop=FALSE], mm[7, , drop=FALSE]) -M[i.l] : nargs() = 4 > identical (mC[7, drop=FALSE], mm[7, drop=FALSE]) # *vector* indexing -M[i.l] : nargs() = 3 [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..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > validObject(print(mT[,c(2,4)])) -M[.i.] : nargs() = 3 40 x 2 sparse Matrix of class "dgTMatrix" c2 c4 r1 . 121 @@ -1163,15 +826,7 @@ + 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..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 > assert.EQ.mat(mT[4,, drop = FALSE], mm[4,, drop = FALSE]) -M[i.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), @@ -1179,26 +834,13 @@ + 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[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[...] : nargs() = 2 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > 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], names=FALSE))) -M[m..] : nargs() = 2 -M[ii.] : nargs() = 3 > head(x.x.) # Note the *non*-structural 0's printed as "0" -M[i.l] : nargs() = 4 6 x 20 sparse Matrix of class "dgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] @@ -1209,7 +851,6 @@ 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 -M[i.l] : nargs() = 4 17 x 20 sparse Matrix of class "dgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] @@ -1233,7 +874,6 @@ > > lx.x <- as(as(x.x, "lMatrix"), "symmetricMatrix") # FALSE only for "structural" 0 > (l10 <- lx.x[1:10, 1:10])# "lsC" -M[ii.] : nargs() = 3 10 x 10 sparse Matrix of class "lsCMatrix" [[ suppressing 10 column names 'c1', 'c2', 'c3' ... ]] @@ -1248,7 +888,6 @@ c9 . | | | . | | | | | c10 | | | | | | | | | | > (l3 <- lx.x[1:3, ]) -M[i..] : nargs() = 3 3 x 20 sparse Matrix of class "lgCMatrix" [[ suppressing 20 column names 'c1', 'c2', 'c3' ... ]] @@ -1285,12 +924,8 @@ > ## change the diagonal and the upper and lower subdiagonal : > diag(B.) <- 10 * diag(B.) > diag(B.[,-1]) <- 5* diag(B.[,-1]) -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (1,0) > diag(B.[-1,]) <- 4* diag(B.[-1,]) ; B. -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (0,1) 4 x 3 sparse Matrix of class "dgCMatrix" @@ -1299,11 +934,8 @@ [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[.i.] : nargs() = 3 replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (1,0) -M[i..] : nargs() = 3 replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (0,1) -M[ii.] : nargs() = 3 replCmat[x,i,j,..,val] : nargs()=4; > stopifnot(identical(unname(as(A, "matrix")), + local({a <- matrix(0,4,3); a[c(1,2,1), 2] <- 1 ; a})), @@ -1334,7 +966,6 @@ [4,] . . . . . [5,] . . . . . > sm[2,] -M[i..] : nargs() = 3 [1] 0 1 0 0 0 > stopifnot(sm[2,] == c(0:1, rep.int(0,ncol(sm)-2)), + sm[2,] == cm[2,], @@ -1342,16 +973,8 @@ + all(sm[,-(1:3)] == t(sm[-(1:3),])), # all() + all(sm[,-(1:3)] == 0) + ) -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 > showProc.time() -Time (user system elapsed): 0.061 0.003 0.065 +Time (user system elapsed): 0.055 0.002 0.057 > > ##--- "nsparse*" sub-assignment :---------- > M <- Matrix(c(1, rep(0,7), 1:4), 3,4) @@ -1508,38 +1131,30 @@ replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (1,0) replCmat[x,i,j,..,val] : nargs()=4; .> showProc.time() -Time (user system elapsed): 0.064 0.001 0.064 +Time (user system elapsed): 0.058 0.002 0.059 > 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]) 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) -M[i..] : nargs() = 2 > assertWarning(Nn[ii <- 22:24] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) 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) -M[i..] : nargs() = 2 > assertWarning(Nn[ii <- -(1:99)] <- NA); stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii]) 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) -M[i..] : nargs() = 2 > assertWarning(Nn[ii <- 3:4 ] <- c(0,NA)) 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) > stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == 0:1) -M[i..] : nargs() = 2 > assertWarning(Nn[ii <- 25:27] <- c(0,1,NA)) 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) > stopifnot(isValid(Nn,"nsparseMatrix"), Nn[ii] == c(FALSE,TRUE,TRUE)) -M[i..] : nargs() = 2 > > m0 <- Diagonal(5) > stopifnot(identical(m0[2,], m0[,2]), + identical(m0[,1], c(1,0,0,0,0))) -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > ### Diagonal -- Sparse: > (m1 <- as(m0, "TsparseMatrix")) # dtTMatrix unitriangular 5 x 5 sparse Matrix of class "dtTMatrix" (unitriangular) @@ -1563,17 +1178,11 @@ > 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..] : nargs() = 3 > assert.EQ.mat(m2[,c(4,1)], diag(5)[,c(4,1)]) -M[.i.] : nargs() = 3 > stopifnot(identical(m2[1:3,], as(m1[1:3,], "CsparseMatrix")), -+ identical(uniqTsparse(m1[, c(4,2)]), -+ uniqTsparse(as(m2[, c(4,2)], "TsparseMatrix"))) ++ identical(asUniqueT(m1[, c(4,2)]), ++ asUniqueT(m2[, c(4,2)])) + )## failed in 0.9975-11 -M[i..] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > > ## 0-dimensional diagonal - subsetting ---------------------------- > ## before that diagU2N() etc for 0-dim. dtC*: @@ -1605,20 +1214,6 @@ + identical(tC0, tC0[,]) # (worked already) + ## vector indexing + }) -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[...] : nargs() = 3 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[...] : nargs() = 3 > > expr <- quote({ ## FIXME -- both 'TRUE' and 'FALSE' should fail "out of bound",etc + D0[TRUE, TRUE ] @@ -1638,18 +1233,6 @@ > EE <- lapply(expr[-1], function(e) + list(expr = e, + r = tryCatch(eval(e), error = identity))) -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[.i.] : nargs() = 3 > exR <- lapply(EE, `[[`, "r") > stopifnot(exprs = { + vapply(exR, inherits, logical(1), what = "error") @@ -1683,10 +1266,7 @@ [3,] . . 3 . . [4,] . . 3 1 . [5,] . . 3 . 1 -M[.i.] : nargs() = 3 > checkMatrix(M) -M[.i.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok @@ -1711,7 +1291,6 @@ 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[.i.] : nargs() = 3 > > 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) @@ -1725,11 +1304,8 @@ > 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[.i.] : nargs() = 3 > Z <- m1; Z[] <- 0 > checkMatrix(M) -M[.i.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok @@ -1753,8 +1329,6 @@ > 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.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dtCMatrix" != "dtCMatrix" : norm(m [5 x 5]) : 1 I F M ok @@ -1772,7 +1346,6 @@ as(mm., "triangularMatrix"): valid: TRUE > stopifnot(is(T, "triangularMatrix"), identical(T[,3], c(10,10,10,0,0)), + Qidentical(as(Z, "matrix"), z)) -M[.i.] : nargs() = 3 > > 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) @@ -1785,10 +1358,7 @@ [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[.i.] : nargs() = 3 > checkMatrix(M) -M[.i.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 5]) : 1 I F M ok @@ -1813,8 +1383,6 @@ > 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.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dtCMatrix" != "dtCMatrix" : norm(m [5 x 5]) : 1 I F M ok @@ -1832,9 +1400,8 @@ as(mm., "triangularMatrix"): valid: TRUE > stopifnot(is(T, "dtCMatrix"), identical(T[,3], c(10,10,10,0,0)), + Qidentical(as(Z, "matrix"), z)) -M[.i.] : nargs() = 3 > showProc.time() -Time (user system elapsed): 0.184 0.003 0.186 +Time (user system elapsed): 0.183 0.003 0.186 > > > ## "Vector indices" ------------------- @@ -1934,78 +1501,36 @@ > 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..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 > ## 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])) -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 > 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])) -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.l] : nargs() = 3 -M[i.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[i..] : nargs() = 3 -M[i.l] : nargs() = 4 > assertError(S[L,]); assertError(S[L,, drop=FALSE]) -M[i..] : nargs() = 3 -M[i.l] : nargs() = 4 > assertError(N[L,]); assertError(N[L,, drop=FALSE]) -M[i..] : nargs() = 3 -M[i.l] : nargs() = 4 > > ## row indexing: > assert.EQ.mat(D[i,], m[i,]) -M[i..] : nargs() = 3 > assert.EQ.mat(M[i,], m[i,]) -M[i..] : nargs() = 3 > assert.EQ.mat(s[i,], m[i,]) -M[i..] : nargs() = 3 > assert.EQ.mat(S[i,], m[i,]) -M[i..] : nargs() = 3 > assert.EQ.mat(C[i,], asLogical(m[i,])) -M[i..] : nargs() = 3 > assert.EQ.mat(N[i,], asLogical(m[i,])) -M[i..] : nargs() = 3 > ## column indexing: > assert.EQ.mat(D[,i], m[,i]) -M[.i.] : nargs() = 3 > assert.EQ.mat(M[,i], m[,i]) -M[.i.] : nargs() = 3 > assert.EQ.mat(s[,i], m[,i]) -M[.i.] : nargs() = 3 > assert.EQ.mat(S[,i], m[,i]) -M[.i.] : nargs() = 3 > assert.EQ.mat(C[,i], asLogical(m[,i])) -M[.i.] : nargs() = 3 > assert.EQ.mat(N[,i], asLogical(m[,i])) -M[.i.] : nargs() = 3 > > > ### --- negative indices ---------- @@ -2015,12 +1540,6 @@ > 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..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 -M[i..] : nargs() = 2 > ## negative vector subassignment : > v <- seq_along(m[i]) > m[i] <- v; m.L <- asLogical(m) @@ -2078,41 +1597,23 @@ > > ## 2) negative [i,j] indices > mc <- mC[1:5, 1:7] -M[ii.] : nargs() = 3 > mt <- mT[1:5, 1:7] -M[ii.] : nargs() = 3 > ## sub matrix > assert.EQ.mat(mC[1:2, 0:3], mm[1:2, 0:3]) # test 0-index -M[ii.] : nargs() = 3 > 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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > assert.EQ.mat(mC[1:2,], mm[1:2,]) -M[i..] : nargs() = 3 > ## sub vector > stopifnot(identical4(mc[-(1:4), ], mC[5, 1:7], + mt[-(1:4), ], mT[5, 1:7])) -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 -M[i..] : nargs() = 3 -M[ii.] : nargs() = 3 > 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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > ## mixing of negative and positive must give error > assertError(mT[-1:1,]) -M[i..] : nargs() = 3 > showProc.time() -Time (user system elapsed): 0.067 0.001 0.068 +Time (user system elapsed): 0.044 0.001 0.045 > > ## Sub *Assignment* ---- now works (partially): > mt0 <- mt @@ -2136,8 +1637,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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > 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 @@ -2164,7 +1663,6 @@ > assert.EQ.mat(mt, tt) > > mt[1:5, 2:6] -M[ii.] : nargs() = 3 5 x 5 sparse Matrix of class "dgTMatrix" c2 c3 c4 c5 c6 r1 . . -99 . . @@ -2173,7 +1671,6 @@ r4 . 30 . . . r5 2 4 . 6 . > as((mt0 - mt)[1:5,], "dsparseMatrix")# [1,5] and lines 2:3 -M[i..] : nargs() = 3 5 x 7 sparse Matrix of class "dgCMatrix" c1 c2 c3 c4 c5 c6 c7 r1 . . . 220 . . 241 @@ -2184,12 +1681,9 @@ > > 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..] : nargs() = 3 > mt[2:3, 4:7] <- 33 .. replTmat(x,i,j,v): nargs()= 4; cl.(x)=dgTMatrix; len.(value)=1; > checkMatrix(mt) -M[.i.] : nargs() = 3 -M[.il] : nargs() = 4 Compare -- "dgCMatrix" != "dgCMatrix" : norm(m [5 x 7]) : 1 I F M ok @@ -2211,16 +1705,12 @@ > > mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) replCmat[x,i,j,..,val] : nargs()=4; -M[ii.] : nargs() = 3 > mc[1,4] <- 00 ; stopifnot(mc[1,4] == 00) replCmat[x,i,j,..,val] : nargs()=4; -M[ii.] : nargs() = 3 > mc[1,4] <- -99 ; stopifnot(mc[1,4] == -99) replCmat[x,i,j,..,val] : nargs()=4; -M[ii.] : nargs() = 3 > mc[1:2,4:3] <- 4:1; stopifnot(as(mc[1:2,4:3], "matrix") == 4:1) replCmat[x,i,j,..,val] : nargs()=4; -M[ii.] : nargs() = 3 > > mc[-1, 3] <- -2:1 # 0 should not be entered; 'value' recycled replCmat[x,i,j,..,val] : nargs()=4; @@ -2228,8 +1718,6 @@ .. 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[ii.] : nargs() = 3 -M[ii.] : nargs() = 3 > > mc0 <- mc > mt0 <- as(mc0, "TsparseMatrix") @@ -2254,7 +1742,7 @@ r2 2 r4 . > showProc.time() -Time (user system elapsed): 0.076 0.001 0.078 +Time (user system elapsed): 0.091 0.001 0.093 > options(Matrix.verbose = TRUE) > > mc # no longer has non-structural zeros @@ -2477,7 +1965,7 @@ > assert.EQ.mat(t2, m)# ok > assert.EQ.mat(s2, m)# failed in 0.9975-8 > showProc.time() -Time (user system elapsed): 0.181 0.003 0.183 +Time (user system elapsed): 0.17 0.003 0.172 > > ## 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 @@ -2678,7 +2166,7 @@ > > cc <- capture.output(show(dLrg))# show() used to error for large n > showProc.time() -Time (user system elapsed): 0.109 0.004 0.113 +Time (user system elapsed): 0.109 0.004 0.114 > > ## FIXME: "dspMatrix" (symmetric *packed*) not going via "matrix" > @@ -2707,7 +2195,6 @@ > prod(dim(f)) # 699930301096 == 699'930'301'096 (~ 700'000 millions) [1] 699930301096 > str(thisCol <- f[,5000])# logi [~ 7 mio....] -M[.i.] : nargs() = 3 logi [1:6999863] FALSE FALSE FALSE FALSE FALSE FALSE ... > sv <- as(thisCol, "sparseVector") > str(sv) ## "empty" ! @@ -2716,7 +2203,6 @@ ..@ length: int 6999863 ..@ i : int(0) > validObject(spCol <- f[,5000, drop=FALSE]) # "empty" [n x 1] ngCmatrix -M[.il] : nargs() = 4 [1] TRUE > ## > ## *not* identical(): as(spCol, "sparseVector")@length is "double"prec: @@ -2738,19 +2224,15 @@ > fx[,6000] <- (tC <- rep(thisCol, length.out=nrow(fx)))# fine replCmat[x,i,j,..,val] : nargs()=4; missing (i,j) = (1,0) > thCol <- fx[,2000] -M[.i.] : nargs() = 3 > 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[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 -M[.i.] : nargs() = 3 > > showProc.time() -Time (user system elapsed): 0.62 0.066 0.685 +Time (user system elapsed): 0.422 0.048 0.469 > options(op)# revert > ## > if(doExtras) {#----------------------------------------------------------------- @@ -2809,7 +2291,7 @@ [1] "Matrix" > stopifnot(isValid(x1, class(x1)), identical(x1, x2)) > showProc.time() -Time (user system elapsed): 0.013 0 0.014 +Time (user system elapsed): 0.012 0 0.013 > > > ## check valid indexing (using *random* indices, often duplicated): @@ -2904,7 +2386,7 @@ > stopifnot(all.equal(x[i] , y1+y2, tolerance=0), + x[i] == y1+y2) > showProc.time() -Time (user system elapsed): 0.299 0.002 0.299 +Time (user system elapsed): 0.247 0.001 0.248 > > if(!interactive()) warnings() > @@ -2995,7 +2477,7 @@ [926] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [963] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ............................ - ........suppressing 8589933593 entries in show(); maybe adjust 'options(max.print= *)' + ........suppressing 8589933593 entries in show(); maybe adjust options(max.print=) ............................ > (xs0 <- sparseVector(i=integer(), length=2^33, x = numeric()))# ditto @@ -3028,7 +2510,7 @@ [926] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . [963] . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ............................ - ........suppressing 8589933593 entries in show(); maybe adjust 'options(max.print= *)' + ........suppressing 8589933593 entries in show(); maybe adjust options(max.print=) ............................ > options(op); tail(s0) ; tail(xs0) # (always worked) @@ -3084,4 +2566,4 @@ > > proc.time() user system elapsed - 2.679 0.129 2.802 + 2.359 0.112 2.471 diff -Nru rmatrix-1.6-1.1/tests/matprod.R rmatrix-1.6-5/tests/matprod.R --- rmatrix-1.6-1.1/tests/matprod.R 2023-07-31 00:55:24.000000000 +0000 +++ rmatrix-1.6-5/tests/matprod.R 2023-09-14 00:01:56.000000000 +0000 @@ -161,7 +161,7 @@ stopifnot(is(pT, "dtpMatrix"), validObject(pT), validObject(mt), is(mt, "dgeMatrix"), identical(as.matrix(mt), - array(c(1,0,0, 5,2,1), dim = 3:2, dimnames = list(c("A","B","C"), c("b","c")))) + array(c(1,0,0, 5,2,1), dim = 3:2, dimnames = list(c("A","B","C"), c("C1","C2")))) ) A <- matrix(c(0.4, 0.1, 0, 0), 2) @@ -237,7 +237,7 @@ ## 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])) + identical(dimnames(m51), list(NULL, Rows = LETTERS[1:5])) ) m51 <- m5[, 1, drop=FALSE] # [6 x 1] m.1 <- m.[, 1, drop=FALSE] ; assert.EQ.mat(m51, m.1) @@ -432,8 +432,8 @@ ## [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))) +stopifnot(identical(as(s.s, "symmetricMatrix"), crossprod(sv)), + identical(as(ss., "symmetricMatrix"), tcrossprod(sv))) assert.EQ.mat(s.s, crossprod(v,v)) assert.EQ.mat(ss., tcrossprod(v,v)) @@ -702,10 +702,10 @@ ## 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) + MM <- M %*% M # numeric (dgC) 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() + assert.EQ.mat(t(M) %&% M, (t(m) %*% m) > 0, tol=0) cM <- crossprod(M) # pattern {FIXME ?? warning ...} tM <- tcrossprod(M) # pattern {FIXME ?? warning ...} @@ -713,9 +713,9 @@ if(verbose) {cat("tcrossprod(M):\n"); show(tM) } stopifnot(is(cM,"symmetricMatrix"), is(tM,"symmetricMatrix"), identical(as(as(cM, "CsparseMatrix"), "generalMatrix"), - t(M) %*% M), + t(M) %&% M), identical(as(as(tM, "CsparseMatrix"), "generalMatrix"), - M %*% t(M))) + M %&% t(M))) assert.EQ.mat(cM, crossprod(m) > 0) assert.EQ.mat(tM, as(tcrossprod(m), "matrix") > 0) @@ -766,13 +766,13 @@ 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") +stopifnotValid(dm %*% sM, "denseMatrix")## failed {missing coercion} +stopifnotValid(crossprod (dm , sM),"denseMatrix") +stopifnotValid(tcrossprod(dm , sM),"denseMatrix") dm[2,1] <- TRUE # no longer triangular -stopifnotValid( dm %*% sM, "CsparseMatrix") -stopifnotValid(crossprod (dm , sM),"CsparseMatrix") -stopifnotValid(tcrossprod(dm , sM),"CsparseMatrix") +stopifnotValid( dm %*% sM, "denseMatrix") +stopifnotValid(crossprod (dm , sM),"denseMatrix") +stopifnotValid(tcrossprod(dm , sM),"denseMatrix") ## A sparse example - with *integer* matrix: M <- Matrix(cbind(c(1,0,-2,0,0,0,0,0,2.2,0), @@ -930,11 +930,11 @@ x5 <- c(2,0,0,1,4) D5 <- Diagonal(x=x5) -L5 <- D5 != 0 ## an "ldiMatrix" NB: have *no* ndiMatrix class +N5 <- as(D5 != 0, "nMatrix") ## an "ndiMatrix" D. <- Diagonal(x=c(TRUE,FALSE,TRUE,TRUE,TRUE)) -stopifnot(identical(D5 %&% D., L5)) +stopifnot(identical(D5 %&% D., N5)) stopifnot(identical(D5 %&% as(D.,"CsparseMatrix"), - as(as(L5, "nMatrix"),"CsparseMatrix"))) + as(N5,"CsparseMatrix"))) set.seed(7) L <- Matrix(rnorm(20) > 1, 4,5) @@ -957,8 +957,7 @@ (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), "nsCMatrix") stopifnotValid(csy. <- crossprod(nsy, boolArith=TRUE),"nsCMatrix") stopifnot(all((csy > 0) == csy.), all(csy. == (nsy %&% nsy))) @@ -984,16 +983,16 @@ (m <- Matrix(c(0,0,2:0), 3,5)) stopifnotValid(R <- as(m, "RsparseMatrix"), "RsparseMatrix") stopifnotValid(T <- as(m, "TsparseMatrix"), "TsparseMatrix") -stopifnot(exprs = { ## may change, once (t)crossprod(R) returns dsC* - all.equal(t(R) %*% R, crossprod(R) -> cR) - all.equal(R %*% t(R), tcrossprod(R) -> tR) # both dgC {latter could improve to dsC*} - all.equal(as(R %*% t(m),"symmetricMatrix"), tcrossprod(m)) - all.equal(as(m %*% t(R),"symmetricMatrix"), tcrossprod(m)) +stopifnot(exprs = { + all.equal(as(t(R) %*% R, "symmetricMatrix"), crossprod(R) -> cR) + all.equal(as(R %*% t(R), "symmetricMatrix"), tcrossprod(R) -> tR) + all.equal(as(R %*% t(m), "symmetricMatrix"), as(tcrossprod(m), "RsparseMatrix")) + all.equal(as(m %*% t(R), "symmetricMatrix"), as(tcrossprod(m), "CsparseMatrix")) ## failed in Matrix <= 1.4.1 (since 1.2.0, when 'boolArith' was introduced): - all.equal(cR, crossprod(R,T)) - all.equal(cR, crossprod(T,R)) - all.equal(tR, tcrossprod(R,T)) - all.equal(tR, tcrossprod(T,R)) + all.equal(as(cR, "RsparseMatrix"), as( crossprod(R, T), "symmetricMatrix")) + all.equal(as(cR, "CsparseMatrix"), as( crossprod(T, R), "symmetricMatrix")) + all.equal(as(tR, "RsparseMatrix"), as(tcrossprod(R, T), "symmetricMatrix")) + all.equal(as(tR, "CsparseMatrix"), as(tcrossprod(T, R), "symmetricMatrix")) }) ## More for kronecker() ------------------------------------------------ diff -Nru rmatrix-1.6-1.1/tests/matr-exp.R rmatrix-1.6-5/tests/matr-exp.R --- rmatrix-1.6-1.1/tests/matr-exp.R 2023-06-21 07:07:50.000000000 +0000 +++ rmatrix-1.6-5/tests/matr-exp.R 2023-10-03 15:58:30.000000000 +0000 @@ -4,7 +4,6 @@ library(Matrix) ## Matrix Exponential - source(system.file("test-tools.R", package = "Matrix")) ## e ^ 0 = 1 - for matrices: @@ -26,7 +25,11 @@ m1 <- Matrix(c(1,0,1,1), ncol = 2) e1 <- expm(m1) assert.EQ.mat(e1, cbind(c(exp(1),0), exp(1))) - +(p1 <- pack(m1)) +stopifnot(exprs = { + is(p1, "dtpMatrix") + all.equal(pack(e1), expm(p1), tolerance = 2e-15)# failed in Matrix 1.6.1 +}) m2 <- Matrix(c(-49, -64, 24, 31), ncol = 2) e2 <- expm(m2) ## The true matrix exponential is 'te2': @@ -36,7 +39,10 @@ c(4*e_17 - 4*e_1, -2 *e_17 + 3 *e_1)) assert.EQ.mat(e2, te2, tol = 1e-13) ## See the (average relative) difference: -all.equal(as(e2,"matrix"), te2, tolerance = 0) # 1.48e-14 on "lynne" +all.equal(as(e2,"matrix"), te2, tolerance = 0) # 2.22e-14 {was 1.48e-14} on "lynne" + +(dsp <- pack(crossprod(matrix(-2:3, 2,3)))) +stopifnot(all(abs(expm(dsp) - expm(as.matrix(dsp))) <= 0.5)) # failed badly in Matrix 1.6.1 ## The ``surprising identity'' det(exp(A)) == exp( tr(A) ) ## or log det(exp(A)) == tr(A) : diff -Nru rmatrix-1.6-1.1/tests/other-pkgs.R rmatrix-1.6-5/tests/other-pkgs.R --- rmatrix-1.6-1.1/tests/other-pkgs.R 2023-06-22 15:53:11.000000000 +0000 +++ rmatrix-1.6-5/tests/other-pkgs.R 2023-08-30 06:03:42.000000000 +0000 @@ -144,9 +144,9 @@ 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)) + stopifnot(identical4(asUniqueT(T ), asUniqueT(T.), + asUniqueT(T3), asUniqueT(M5)), + identical3(M, M3, M4)) } # {else} diff -Nru rmatrix-1.6-1.1/tests/packed-unpacked.R rmatrix-1.6-5/tests/packed-unpacked.R --- rmatrix-1.6-1.1/tests/packed-unpacked.R 2023-06-21 07:07:50.000000000 +0000 +++ rmatrix-1.6-5/tests/packed-unpacked.R 2023-09-22 03:43:08.000000000 +0000 @@ -187,7 +187,7 @@ if (is.sy) { tri0(m2, diag = TRUE) <- tri0(t(m2), diag = TRUE) - dimnames(m2) <- Matrix:::symmDN(M@Dimnames) + dimnames(m2) <- Matrix:::symDN(M@Dimnames) } if (is.tr && M@diag == "U") { diag(m2) <- .ONE @@ -293,7 +293,7 @@ identical(isTriangular(M, upper = TRUE), TRUE), identical(isTriangular(M, upper = FALSE), TRUE), identical(isTriangular(M, upper = NA), - `attr<-`(TRUE, "kind", "U")), + `attr<-`(TRUE, "kind", M@uplo)), isDiagonal(M)) } else { ## Not symmetric diff -Nru rmatrix-1.6-1.1/tests/spModel.matrix.R rmatrix-1.6-5/tests/spModel.matrix.R --- rmatrix-1.6-1.1/tests/spModel.matrix.R 2023-06-21 07:07:50.000000000 +0000 +++ rmatrix-1.6-5/tests/spModel.matrix.R 2023-08-16 05:39:47.000000000 +0000 @@ -6,17 +6,17 @@ ## This is example(sp....) -- much extended -mEQ <- function(x,y, ...) { +mEQ <- function(x, y, check.attributes = NA, ...) { ## 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] + 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] + y <- y[, !i0, drop = FALSE] } - isTRUE(all.equal(x,y, tolerance =0, ...)) + isTRUE(all.equal(x, y, tolerance = 0, check.attributes = check.attributes, ...)) } ##' Is sparse.model.matrix() giving the "same" as dense model.matrix() ? @@ -113,7 +113,8 @@ 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 ! +stopifnot(all.equal(sm., mm[, - which("d5" == colnames(mm))], ## indeed ! + check.attributes = NA)) ## i.e., sm has just dropped an all zero column --- which it should! stopifnot(isEQsparseDense(~ 1 + sin(x) + b*c + a:x, dd4, showFactors=TRUE)) @@ -210,7 +211,7 @@ 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, tolerance=0)) +stopifnot(all.equal(X2, X2S, tolerance = 0, check.attributes = NA)) ## X2S was missing the last column ('b6') in Matrix <= 1.x-y diff -Nru rmatrix-1.6-1.1/tests/symmDN.R rmatrix-1.6-5/tests/symmDN.R --- rmatrix-1.6-1.1/tests/symmDN.R 2023-04-28 20:58:01.000000000 +0000 +++ rmatrix-1.6-5/tests/symmDN.R 2023-09-22 03:43:08.000000000 +0000 @@ -28,7 +28,7 @@ } ## SDN1(dn) is documented to behave as SDN2(dn, NULL) -SDN1 <- Matrix:::symmDN +SDN1 <- Matrix:::symDN SDN2 <- function(dn, uplo = NULL) { J <- if (is.null(uplo)) { diff -Nru rmatrix-1.6-1.1/tests/validObj.R rmatrix-1.6-5/tests/validObj.R --- rmatrix-1.6-1.1/tests/validObj.R 2023-05-08 16:33:16.000000000 +0000 +++ rmatrix-1.6-5/tests/validObj.R 2023-09-09 00:05:48.000000000 +0000 @@ -18,8 +18,8 @@ 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 +c("dgeMatrix", "ddenseMatrix", "generalMatrix", "dMatrix", + "denseMatrix", "compMatrix", "Matrix") -> 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='') @@ -123,7 +123,7 @@ m.@x <- m.x <- mm@x[ip] stopifnot(identical(1L, grep("not increasing within columns", validObject(m., test = TRUE)))) -Matrix:::.sortCsparse(m.) # don't use this at home, boys! +.validateCsparse(m., TRUE) # don't use this at home, boys! m. # now is fixed ## Make sure that validObject() objects...