diff -Nru rmatrix-1.6-3/DESCRIPTION rmatrix-1.6-5/DESCRIPTION --- rmatrix-1.6-3/DESCRIPTION 2023-11-14 11:55:00.000000000 +0000 +++ rmatrix-1.6-5/DESCRIPTION 2024-01-11 17:50:15.000000000 +0000 @@ -1,7 +1,7 @@ Package: Matrix -Version: 1.6-3 +Version: 1.6-5 VersionNote: do also bump src/version.h, inst/include/Matrix/version.h -Date: 2023-11-13 +Date: 2024-01-06 Priority: recommended Title: Sparse and Dense Matrix Classes and Methods Description: A rich hierarchy of sparse and dense matrix classes, @@ -42,7 +42,7 @@ BuildResaveData: no Encoding: UTF-8 NeedsCompilation: yes -Packaged: 2023-11-13 10:16:52 UTC; maechler +Packaged: 2024-01-11 08:36:29 UTC; maechler Author: Douglas Bates [aut] (), Martin Maechler [aut, cre] (), Mikael Jagan [aut] (), @@ -57,4 +57,4 @@ R Core Team [ctb] (base R's matrix implementation) Maintainer: Martin Maechler Repository: CRAN -Date/Publication: 2023-11-14 11:55:00 UTC +Date/Publication: 2024-01-11 17:50:15 UTC diff -Nru rmatrix-1.6-3/MD5 rmatrix-1.6-5/MD5 --- rmatrix-1.6-3/MD5 2023-11-14 11:55:00.000000000 +0000 +++ rmatrix-1.6-5/MD5 2024-01-11 17:50:15.000000000 +0000 @@ -1,9 +1,9 @@ -8d0a8862e6720381f6ad91b701530940 *DESCRIPTION +dead28547ab9f4749a4630fa7e7881e4 *DESCRIPTION 7866cc186e8ad4d6a243c271f64c13fc *LICENCE ba6604808100abfe8137ad02b0a04f22 *NAMESPACE d641435295187325a3663988363105bb *R/AllClass.R 41bdc701502b0096f23a48bde2df7b89 *R/AllGeneric.R -ae0a61a509d32d86fe11108feef863a5 *R/Auxiliaries.R +863a228d6948c7e1f0efddb4e0fef824 *R/Auxiliaries.R 94b926ced0ed00c0fd056996865155e0 *R/BunchKaufman.R f20a1e47661e7bf1ea1ffd0dbc145b3a *R/HBMM.R 7acb17192c1c08969822defdd531e35a *R/KhatriRao.R @@ -14,21 +14,21 @@ b20351ebc9920c3528219fcc5522f61c *R/Summary.R e0e755ece77810961adf04e91b70230d *R/abIndex.R e2d05abaf1f4ebbe1adda99af6863935 *R/all.equal.R -836e0c82296cfdbfe99a27b0c25b5d23 *R/bind2.R +0a3d332743633e23f1f178098be0d5d6 *R/bind2.R 5ba76f2df9a7550ba8762851525fad7f *R/chol.R -eb6a12fc1e9d85b592b4ef38ed307eb5 *R/coerce.R +9a8bce4a85126b3b3935cdd890ef5bf8 *R/coerce.R 4b3415e4af41dabcbd6048b32280ec29 *R/colSums.R 73f70ce30c4eb94c71d69d824173f8e3 *R/condest.R a848a0850272aac7b5562d679adaea69 *R/construct.R dc61ddb7ae05aa3133071ba579837c72 *R/denseMatrix.R 79c09a13e4d88aaaf9a55735543441c5 *R/determinant.R 629d04a285348773c4e8bd34308d33cc *R/diagMatrix.R -b2d5fe76520f3f832ab280ffb476592f *R/dim.R +067989137256de2d8e537d40471aa47a *R/dim.R 6b2a21f53902ea2a062e9b97895ed5a5 *R/eigen.R 8d5d3c7b32c7b9f7d7eebc1be0d76220 *R/expm.R ab5cc27deac115816214f76aa0ec9bdd *R/graph-conv.R cc55b09add598ed7fe8c723a5c630b52 *R/image.R -1bb7a7b6b07300a8cdc00d54ddc17b0e *R/indMatrix.R +dc8d8f51145233a1d0141dfef262f275 *R/indMatrix.R ee20f86a83c09162cce6a92ea40b121d *R/is.na.R bea101095f5f5c9b4705c11056440108 *R/kappa.R 618b44c13d0f660e8a6b91917593f007 *R/kronecker.R @@ -42,16 +42,16 @@ 3c12768b00d5e2845f55d13c4b00b188 *R/qr.R 49a56dab6ff6e6a943dda3bb4ccf46b7 *R/rankMatrix.R eb631f40e60461240c94a9eeee347e64 *R/show.R -0ac9d648aed3154ff3fe54e15bb13919 *R/solve.R +89b8a1434e8109b332810c2d0d0d6542 *R/solve.R 31b8d3853f6bed848a0714af7e9f94df *R/spModels.R 8418d68302196cfa3f2380a94e4d2a35 *R/sparseMatrix.R -ee9131172b092aab5fe5cf65c31e7a3c *R/sparseVector.R -1d53662e289e483d4b47531e31bbfd58 *R/subassign.R -652621c4dfe1d178c7d0b6dd6094d2ad *R/subscript.R +768e95dd230030db02fa41b83c54e37f *R/sparseVector.R +64f26baaf7096cf33df4aaefd58be4d7 *R/subassign.R +e79d7adbfcc224017905e2d9c3306bc3 *R/subscript.R 4e983e0d3d1a87f0e9058bc9cf0b6143 *R/which.R -69f3cdbddc841fd0b984e9b2ebc9f088 *R/zzz.R -67e0005a66bf87e12c1179b435c1f581 *build/Matrix.pdf -8c1f231b6be2a509e34ac857a0de43bb *build/stage23.rdb +4b678c1d95b4f8a0f5dd259904ba6bfa *R/zzz.R +af387b75c02032478c85023d8e53cf37 *build/Matrix.pdf +4f3dda2ade8b34ae0296685e81dfc10a *build/stage23.rdb 75b445cb0f3b5549d3132a7236c6d050 *build/vignette.rds afeec9c25bf3c232f8567ee3f27cf0f6 *cleanup 9f8e37cf17a5d4811d0c28f07148cf7d *data/CAex.R @@ -59,19 +59,19 @@ d6193dad1031a61ebc3d3e38fabd252d *data/USCounties.R 0d65337740b3914f535239cbe6e8a2df *data/datalist a40150a1c71deabec67e61af2b8f7e38 *data/wrld_1deg.R -4678b4ef31bd6f9be39ebf701d1890e4 *inst/NEWS.Rd +f4f31b32389050a5f38097160a185de7 *inst/NEWS.Rd d1092f2de709b554fb06b516ee00a885 *inst/doc/Comparisons.R f6c9e4986022f1db4c085b8429d06fca *inst/doc/Comparisons.Rnw -d75c29b6d6251ceb575f3f0e4261e9dd *inst/doc/Comparisons.pdf +1c06a154d9826ce6b0ea20a7786a2bc1 *inst/doc/Comparisons.pdf 3f45bdb5515081392d14b87f4770cb2b *inst/doc/Design-issues.R 2bd2896847fb11eaf102158b8696c884 *inst/doc/Design-issues.Rnw -fd610ec99b3062e078d6b2759b5fcd67 *inst/doc/Design-issues.pdf +4d96b8c1ac1f86a3cc193b08b38b53e7 *inst/doc/Design-issues.pdf 3f87d045a10e0afc85a3385bab8f215b *inst/doc/Intro2Matrix.R 448278dab638a78df6eb59270772cbe2 *inst/doc/Intro2Matrix.Rnw -713681f1b9329d8b6e2761390e3abaee *inst/doc/Intro2Matrix.pdf +ddaf6aedae6a73934bdd9c234a6c6d88 *inst/doc/Intro2Matrix.pdf 1a59a7d3257a30349a5e10285ea05a69 *inst/doc/Introduction.R c39a26dfe7ccaafd044e88468155b153 *inst/doc/Introduction.Rnw -82679e83e76c810b5b28664d8eef82fb *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 @@ -79,7 +79,7 @@ c7da19803d926fe0e3604c08bedfb3c5 *inst/doc/SuiteSparse/SuiteSparse_config.txt e4e486aee6a99cb21909bb6de32db68d *inst/doc/sparseModels.R 813e0c8cc7a5f7ecff43e5882270a431 *inst/doc/sparseModels.Rnw -be62d49a7f8fb435243178f3f04b4929 *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 @@ -97,11 +97,11 @@ 9a7e9eac66c8e2e4f302ef50e52e7a56 *inst/include/Matrix.h 393d17634a64d5414c62d83cb4b05764 *inst/include/Matrix/Matrix.h a8f80507036f68ab0180c36e4d874abd *inst/include/Matrix/alloca.h -32910f8f19d3a18bad0c5ab170cd3b0e *inst/include/Matrix/cholmod-utils.h +9453d69ed641a1842043a4b28b677784 *inst/include/Matrix/cholmod-utils.h 573270a60b73ad502ab087e00bb22d91 *inst/include/Matrix/cholmod.h -a31e55cd9a1f668102dcf38b335eb134 *inst/include/Matrix/remap.h -fedfc6bfec2247c1933a7bdf9bdce4df *inst/include/Matrix/stubs.c -6bf71f44c24df06c5896443a5e5c09a8 *inst/include/Matrix/version.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 @@ -118,8 +118,8 @@ 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 -3c1f83c7d331c9013a3435ab8a35984b *inst/test-tools-1.R -bc0b1bbed7cee3d103d87aa4c3a303d5 *inst/test-tools-Matrix.R +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 @@ -146,12 +146,12 @@ 5a159696cf62f4098a1fc9c28d84a7d3 *man/Subassign-methods.Rd afc8dc11f750be8e2baeb2f250502829 *man/TsparseMatrix-class.Rd 878b685a8830a6a9b246e271f08de034 *man/USCounties.Rd -3fae788139d56394375a231eb5b6fef7 *man/Xtrct-methods.Rd +e8742ccaf058cc44a9482cbcdfd50e2f *man/Xtrct-methods.Rd 3de3d37c17171bf90a417615ee83d74b *man/abIndex-class.Rd fcc83ecd00de345e89e3f4fd51544255 *man/abIseq.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 d9c43ef03b0db490d2548c4889c0ce1b *man/boolean-matprod.Rd @@ -193,7 +193,7 @@ 0f54fb0f3457bb48b78da8521be53128 *man/generalMatrix-class.Rd da8ce2fc366523d31ec02e036c8d4690 *man/graph2T.Rd 334d679156521d39c80673b7138736c8 *man/image-methods.Rd -57a6b010435d4a00f0468ab81040f5e1 *man/indMatrix-class.Rd +35673a6311eb2119721fa1fdf91515a6 *man/indMatrix-class.Rd a1ab8d5ea99ad38051701c106e033a99 *man/index-class.Rd cbb67630dfbac437f9d7e9a7648e03ed *man/invPerm.Rd 44270ed554b737f9ebf9050ac16505c0 *man/is.na-methods.Rd @@ -221,7 +221,7 @@ abc1d387f0b990d7b92edf8179a7638a *man/nsyMatrix-class.Rd 9e2a8c507c74de92a095f0850af4826b *man/ntrMatrix-class.Rd 76f34ad30ce23c52a8cdb5e2fd3203d6 *man/number-class.Rd -f45e8aba2132a3080c63deff818ce400 *man/pMatrix-class.Rd +6ab28432582e3d39abf69ee16493fa9d *man/pMatrix-class.Rd fb6a793c391cc14f23f368aee00baa9f *man/packedMatrix-class.Rd e4ee4dcf3182e1879220877382b4f963 *man/printSpMatrix.Rd d04bb8807a93274f6dd80c7c0b18d8a9 *man/qr-methods.Rd @@ -394,9 +394,9 @@ f957aa1decb3ab62e5768873dacbd08d *src/attrib.h 2c5fba5b2b59e716446291cf65d1beaa *src/bind.c ae9faa18a9b4d9e424979c2c8018c110 *src/bind.h -865b0daf858338af3231b064e1899023 *src/chm_common.c -25dadcb67b993d6c9c21bc5f5d05ff46 *src/chm_common.h -0b8e6dc7c39c678e1d9b63a75e95555a *src/cholmod-etc.c +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 @@ -404,7 +404,7 @@ bdeb2fdd1d475a5af6614bcc5e3a6c38 *src/cs-etc.h e90b77e2b99ecfc3829ae442f64ab69f *src/cs.c 1bcb7a109eed6463413de50e66989bb3 *src/cs.h -4a4f9446957f3d2c4913d163d6d6a2e8 *src/dense.c +98f16ec801ccad037f30d9bace8efda7 *src/dense.c 1b283c24487fa2a8a08a5d5a5a8a5728 *src/dense.h fb5d6b8b559b3c6f369d335d7286afec *src/determinant.c 22ba2bee6a8de4cda0c60534be652beb *src/determinant.h @@ -416,7 +416,7 @@ e8265b2a487f2c17ab46a4bba3c4fbb9 *src/factorizations.h 3a00ec0197947e526799ddef28b9f265 *src/idz.c 0b015211a474aa369610621fd3c543c2 *src/idz.h -03441ca2803b03b51ed010338b4578ae *src/init.c +9df4d8eeb26e33b8964bd8c1db8a94af *src/init.c 15d79a179e59c135b44f5967efd8d90f *src/kappa.c 6204a5bcb90a0715baf19669ef9eb940 *src/kappa.h 9bc0932a84ef35921138ccb7e22112d3 *src/objects.c @@ -429,23 +429,23 @@ 8f746c52ccc69697252ccec2c601d667 *src/scripts/SOURCES_C.mkf 16e5ab15e7251f9cac15877574f4993e *src/solve.c c7e4d0db483efe92dc836aac9ec0e894 *src/solve.h -3cde6bed19097d9834ac9bab9304a5af *src/sparse.c +0a3c1ca9dddfc78eaab799354e06a1ca *src/sparse.c 1e950bcfe739de1fa814cda80a680aa8 *src/sparse.h e63b80a881df16e35711cd6dfbb56d0b *src/sparseVector.c 024ab3a6d182f9f3e585b802c6e43661 *src/sparseVector.h 239a1593560fe15f100577b5f81814b2 *src/subscript.c 5801e16aa00d9d5188f34e7270057e3b *src/subscript.h -ed9a22e450a45f8ab7ecbb5ebf47a06d *src/t_Csparse_subassign.c +bf38710f2a1be89c059d0d0c62b9327d *src/t_Csparse_subassign.c 9542b498b327ff7c9345ed5df2b9fc01 *src/t_Matrix_rle.c -63f21d666296603d235f68c8f7909868 *src/utils-R.c +d1e9d8b116fdc339313a6d2d63f58e5b *src/utils-R.c 46f34227d88921a56c0eb1e5ce4f17ac *src/utils-R.h 7dd32b8add5da5db098536fd6323bfdd *src/utils.c a819313eb7f9d3c3fc57990d6022b076 *src/utils.h -68452519a0af12ef44ae93e39afb50e0 *src/validity.c +857a3a8c830efbeef46340ad3c46619b *src/validity.c 9488bc95eb18488965cc74af6674cd76 *src/validity.h -ed6c934753e947c5d10edf58c29570fb *src/version.h +418b002e2b2b78bfabe54f19ddf4b10c *src/version.h 242ec9448d48cc231d1369448e310018 *tests/Class+Meth.R -6d046b4f202bc199400b4d5f02f8afd4 *tests/Simple.R +fc506ccab4036af8ad69cc1dd0b3e987 *tests/Simple.R 5e53e6b4552a116eb3a0d6d2feff0105 *tests/abIndex-tsts.R 0de6da80621eb6de7e56a07e766e9a81 *tests/base-matrix-fun.R ffe85c58a3ff60c53ae1d66b4720764e *tests/bind.R @@ -453,7 +453,7 @@ d8d4dec1de3026e421c1faeee559e6fe *tests/dg_Matrix.R d9e757825755abd46eaa5bb29f1b9848 *tests/dpo-test.R c8ee301b09c474efe164f0b1455f74a8 *tests/dtpMatrix.R -71f1291cb2f3d3a53525b09fc500ff0a *tests/factorizing.R +3e75f51d54d7ffd38f8a5451cef43c2a *tests/factorizing.R 58db5af64179692469bceceebe17c8e9 *tests/group-methods.R ecda3b001378e86ba5dff287e0c2f91e *tests/indexing.R ff1b0ddb4c97e1da3ac465f113919c1d *tests/indexing.Rout.save diff -Nru rmatrix-1.6-3/R/Auxiliaries.R rmatrix-1.6-5/R/Auxiliaries.R --- rmatrix-1.6-3/R/Auxiliaries.R 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/R/Auxiliaries.R 2023-12-05 19:58:20.000000000 +0000 @@ -1,8 +1,6 @@ #### "Namespace private" Auxiliaries such as method functions #### (called from more than one place --> need to be defined early) -`%||%` <- function(L, R) if (is.null(L)) R else L # stats:::`%||%` - is0 <- function(x) !(is.na(x) | x) isN0 <- function(x) is.na(x) | x is1 <- function(x) !is.na(x) & x == 1L diff -Nru rmatrix-1.6-3/R/bind2.R rmatrix-1.6-5/R/bind2.R --- rmatrix-1.6-3/R/bind2.R 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/R/bind2.R 2023-12-06 18:46:20.000000000 +0000 @@ -21,7 +21,7 @@ i <- match(vapply(args, .M.kind, ""), s) k <- range(i) n <- sum(args.length) - a <- if(n <= .Machine$integer.max) as.integer else as.double + a <- if(n - 1 <= .Machine$integer.max) as.integer else as.double r <- new(paste0(s[k[2L]], "sparseVector")) r@length <- a(n) diff -Nru rmatrix-1.6-3/R/coerce.R rmatrix-1.6-5/R/coerce.R --- rmatrix-1.6-3/R/coerce.R 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/R/coerce.R 2023-12-06 18:46:20.000000000 +0000 @@ -163,33 +163,27 @@ } .V2m <- function(from) { - if(is.double(m <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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 <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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 <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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) @@ -199,11 +193,9 @@ } .V2C <- function(from) { - if(is.double(m <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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) @@ -215,11 +207,9 @@ } .V2R <- function(from) { - if(is.double(m <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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) @@ -231,11 +221,9 @@ } .V2T <- function(from) { - if(is.double(m <- from@length)) { - if(m > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), domain = NA) - m <- as.integer(m) - } + 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) diff -Nru rmatrix-1.6-3/R/dim.R rmatrix-1.6-5/R/dim.R --- rmatrix-1.6-3/R/dim.R 2023-09-22 03:43:08.000000000 +0000 +++ rmatrix-1.6-5/R/dim.R 2023-12-06 18:46:20.000000000 +0000 @@ -122,9 +122,11 @@ setMethod("length", "sparseVector", function(x) - if(is.integer(r <- x@length) || r > .Machine$integer.max) + if(is.integer(r <- x@length)) r - else as.integer(r)) + else if(r - 1 <= .Machine$integer.max) + as.integer(r) + else trunc(r)) ## METHODS FOR GENERIC: dimnames diff -Nru rmatrix-1.6-3/R/indMatrix.R rmatrix-1.6-5/R/indMatrix.R --- rmatrix-1.6-3/R/indMatrix.R 2023-09-19 21:23:49.000000000 +0000 +++ rmatrix-1.6-5/R/indMatrix.R 2023-12-11 01:46:59.000000000 +0000 @@ -93,13 +93,13 @@ }) setMethod("band", signature(x = "indMatrix"), - function(x, k1, k2, ...) band(.M2kind(x, "n"), k1, k2)) + function(x, k1, k2, ...) band(.M2kind(x, "n"), k1, k2, ...)) setMethod("triu", signature(x = "indMatrix"), - function(x, k = 0L, ...) triu(.M2kind(x, "n"))) + function(x, k = 0L, ...) triu(.M2kind(x, "n"), k, ...)) setMethod("tril", signature(x = "indMatrix"), - function(x, k = 0L, ...) tril(.M2kind(x, "n"))) + function(x, k = 0L, ...) tril(.M2kind(x, "n"), k, ...)) setMethod("diag", signature(x = "indMatrix"), function(x, nrow, ncol, names = TRUE) { diff -Nru rmatrix-1.6-3/R/solve.R rmatrix-1.6-5/R/solve.R --- rmatrix-1.6-3/R/solve.R 2023-09-26 15:59:18.000000000 +0000 +++ rmatrix-1.6-5/R/solve.R 2023-12-06 18:46:20.000000000 +0000 @@ -586,12 +586,9 @@ ## for now ... fast for this special case ... .spV2dgC <- function(x) { - if(is.double(m <- x@length)) { - if(trunc(m) > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), - domain = NA) - 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") @@ -610,13 +607,9 @@ ## for now ... fast for this special case ... .spV2dge <- function(x) { - m <- x@length - if(is.double(m)) { - if(trunc(m) > .Machine$integer.max) - stop(gettextf("dimensions cannot exceed %s", "2^31-1"), - domain = NA) - 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, diff -Nru rmatrix-1.6-3/R/sparseVector.R rmatrix-1.6-5/R/sparseVector.R --- rmatrix-1.6-3/R/sparseVector.R 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/R/sparseVector.R 2023-12-06 18:46:20.000000000 +0000 @@ -53,7 +53,7 @@ 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) / x@length + sum(x@x) / length(x) } }) diff -Nru rmatrix-1.6-3/R/subassign.R rmatrix-1.6-5/R/subassign.R --- rmatrix-1.6-3/R/subassign.R 2023-10-18 19:54:12.000000000 +0000 +++ rmatrix-1.6-5/R/subassign.R 2023-12-27 04:50:39.000000000 +0000 @@ -14,6 +14,236 @@ ## 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 ========================================================= diff -Nru rmatrix-1.6-3/R/subscript.R rmatrix-1.6-5/R/subscript.R --- rmatrix-1.6-3/R/subscript.R 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/R/subscript.R 2023-12-27 04:50:39.000000000 +0000 @@ -7,27 +7,27 @@ else gettextf("invalid subscript type \"%s\"", typeof(i)) } -.subscript.recycle <- function(i, mn, pattern) { +.subscript.recycle <- function(i, n, pattern) { ## Return integer or double vector corresponding - ## to [nl]sparseVector 'i' recycled to length 'mn' : + ## to [nl]sparseVector 'i' recycled to length 'n' : 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.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)] > mn) - i.i[i.i > mn] <- NA + 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(mn / i.length) - mn. <- r * i.length + r <- ceiling(n / i.length) + n. <- r * i.length i.i <- - if(mn. <= .Machine$integer.max) + if(n. <= .Machine$integer.max) rep.int(as.integer(i.i), r) + rep(seq.int(from = 0L, by = as.integer(i.length), @@ -43,16 +43,16 @@ "[nl]sparseVector", "2^53"), domain = NA) if(pattern) { - if(mn. > mn) i.i[ i.i <= mn] else i.i + if(n. > n) i.i[ i.i <= n] else i.i } else { - if(mn. > mn) i.i[i@x & i.i <= mn] else i.i[i@x] + 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)) { @@ -61,7 +61,7 @@ kind <- .M.kind(i) if((pattern <- kind == "n") || kind == "l") { ## [nl]sparseVector - i <- .subscript.recycle(i, mn, pattern) + i <- .subscript.recycle(i, x.length, pattern) return(..subscript.1ary(x, i, unsorted = !pattern && anyNA(i))) } i <- i@x @@ -72,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) }, @@ -81,16 +81,16 @@ 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) + 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, len - mn)) + else c(as.vector(x), rep.int(NA, i.length - x.length)) } else .subscript.1ary(x, .m2V(i)) # recursively }, character = @@ -112,15 +112,15 @@ 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(gettextf("subscripts exceeding %s replaced with NA", "2^53"), domain = NA) @@ -138,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 } @@ -165,9 +165,9 @@ 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))) } i <- if(.isDense(i)) .M2v(i) else .M2V(i) return(.subscript.1ary(x, i)) @@ -329,122 +329,114 @@ drop = "missing"), function(x, i, j, ..., drop = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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 = TRUE) { na <- nargs() - 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")) @@ -452,17 +444,17 @@ drop = "missing"), function(x, i, j, ..., drop = TRUE) { na <- nargs() - 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"), @@ -486,20 +478,28 @@ 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") - mn <- length(x) + 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 <= -mn - 1) - i <- i[i > -mn - 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") @@ -507,7 +507,7 @@ i <- i[i <= -1] d <- unique.default(sort.int(-trunc(i))) k <- match(x@i, d, 0L) == 0L - x@length <- x@length - length(d) + x@length <- length(x) - length(d) x@i <- { tmp <- x@i[k] @@ -518,8 +518,8 @@ } else { if(r < 1) i <- i[i >= 1] - if(max(0, i, na.rm = TRUE) >= mn + 1) - i[i >= mn + 1] <- NA + 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 @@ -543,8 +543,8 @@ { r <- min(1L, i, na.rm = TRUE) if(r <= -1L) { - if(r < -mn) - i <- i[i >= -mn] + 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") @@ -552,7 +552,7 @@ i <- i[i <= -1L] d <- unique.default(sort.int(-i)) k <- is.na(match(x@i, d)) - x@length <- x@length - length(d) + x@length <- length(x) - length(d) x@i <- { tmp <- x@i[k] @@ -563,8 +563,8 @@ } else { if(r < 1L) i <- i[i >= 1L] - if(max(0L, i, na.rm = TRUE) > mn) - i[i > mn] <- NA + 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 @@ -586,13 +586,13 @@ }, logical = { - if(length(i) && !is.na(a <- all(i)) && a) { - if((len <- length(i)) > mn) { + if((i.length <- length(i)) && !is.na(a <- all(i)) && a) { + if(i.length > x.length) { if(pattern) x <- .V2kind(x, "l") - x@length <- len - x@i <- c(x@i, (mn + 1):len) - x@x <- c(x@x, rep.int(NA, len - mn)) + 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 @@ -600,15 +600,20 @@ stop(.subscript.invalid(i), domain = NA)) }) -setMethod("[", signature(x = "sparseVector", i = "sparseVector", j = "missing", +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") - kind <- .M.kind(i) - if((pattern <- kind == "n") || kind == "l") - x[.subscript.recycle(i, x@length, pattern)] - else x[i@x] + x[.subscript.recycle(i, length(x), FALSE)] }) setMethod("[", signature(x = "sparseVector", i = "NULL", j = "ANY", diff -Nru rmatrix-1.6-3/R/zzz.R rmatrix-1.6-5/R/zzz.R --- rmatrix-1.6-3/R/zzz.R 2023-11-02 01:49:49.000000000 +0000 +++ rmatrix-1.6-5/R/zzz.R 2023-12-05 19:58:20.000000000 +0000 @@ -35,36 +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, ...) { - 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))) - } + 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: @@ -120,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") Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/build/Matrix.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/build/Matrix.pdf differ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/build/stage23.rdb and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/build/stage23.rdb differ diff -Nru rmatrix-1.6-3/debian/changelog rmatrix-1.6-5/debian/changelog --- rmatrix-1.6-3/debian/changelog 2023-11-25 14:57:21.000000000 +0000 +++ rmatrix-1.6-5/debian/changelog 2024-03-19 02:54:34.000000000 +0000 @@ -1,8 +1,22 @@ -rmatrix (1.6-3-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 Sat, 25 Nov 2023 14:57:21 +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 diff -Nru rmatrix-1.6-3/inst/NEWS.Rd rmatrix-1.6-5/inst/NEWS.Rd --- rmatrix-1.6-3/inst/NEWS.Rd 2023-11-13 10:13:15.000000000 +0000 +++ rmatrix-1.6-5/inst/NEWS.Rd 2024-01-06 06:59:15.000000000 +0000 @@ -4,6 +4,55 @@ \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{ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/inst/doc/Comparisons.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/inst/doc/Comparisons.pdf differ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/inst/doc/Design-issues.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/inst/doc/Design-issues.pdf differ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/inst/doc/Intro2Matrix.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/inst/doc/Intro2Matrix.pdf differ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/inst/doc/Introduction.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/inst/doc/Introduction.pdf differ Binary files /tmp/tmp57eho7m4/KYcKMmPJHz/rmatrix-1.6-3/inst/doc/sparseModels.pdf and /tmp/tmp57eho7m4/g1RABgtKRT/rmatrix-1.6-5/inst/doc/sparseModels.pdf differ diff -Nru rmatrix-1.6-3/inst/include/Matrix/cholmod-utils.h rmatrix-1.6-5/inst/include/Matrix/cholmod-utils.h --- rmatrix-1.6-3/inst/include/Matrix/cholmod-utils.h 2023-10-09 01:11:49.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/cholmod-utils.h 2023-11-27 20:27:27.000000000 +0000 @@ -16,6 +16,8 @@ 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( @@ -25,6 +27,8 @@ 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); diff -Nru rmatrix-1.6-3/inst/include/Matrix/remap.h rmatrix-1.6-5/inst/include/Matrix/remap.h --- rmatrix-1.6-3/inst/include/Matrix/remap.h 2023-10-09 01:11:49.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/remap.h 2023-11-27 20:27:27.000000000 +0000 @@ -1,15 +1,16 @@ #ifndef R_MATRIX_REMAP_H #define R_MATRIX_REMAP_H -/* MJ: backwards compatibility with Matrix <= 1.6-1.1 */ +/* 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_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 +#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-3/inst/include/Matrix/stubs.c rmatrix-1.6-5/inst/include/Matrix/stubs.c --- rmatrix-1.6-3/inst/include/Matrix/stubs.c 2023-10-09 01:11:49.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/stubs.c 2023-12-04 07:08:01.000000000 +0000 @@ -19,35 +19,35 @@ R_MATRIX_CHOLMOD(aat)(CHM_SP A, int *fset, size_t fsize, int mode, CHM_CM Common) { - static CHM_SP(*fun)(CHM_SP, int *, size_t, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, int *, size_t, int, CHM_CM)) + 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 fun(A, fset, fsize, mode, Common); + 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(*fun)(CHM_SP, CHM_SP, double[2], double[2], + static CHM_SP (*fn)(CHM_SP, CHM_SP, double[2], double[2], int, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, CHM_SP, double[2], double[2], + if (!fn) + fn = (CHM_SP (*)(CHM_SP, CHM_SP, double[2], double[2], int, int, CHM_CM)) R_GetCCallable("Matrix", "cholmod_add"); - return fun(A, B, alpha, beta, values, sorted, Common); + 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(*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)) + 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 fun(nrow, ncol, d, xtype, Common); + return fn(nrow, ncol, d, xtype, Common); } R_MATRIX_INLINE CHM_SP attribute_hidden @@ -55,56 +55,56 @@ 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, + static CHM_SP (*fn)(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, + if (!fn) + fn = (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); + 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(*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)) + 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 fun(nrow, ncol, nzmax, stype, xtype, Common); + 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(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_FR(*)(CHM_SP,CHM_CM)) + static CHM_FR (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_SP,CHM_CM)) R_GetCCallable("Matrix", "cholmod_analyze"); - return fun(A, Common); + 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(*fun)(CHM_SP, int *, int *, size_t, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_FR(*)(CHM_SP, int *, int *, size_t, CHM_CM)) + 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 fun(A, Perm, fset, fsize, Common); + 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(*fun)(int, int, int, CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(int, int, int, CHM_SP, CHM_CM)) + 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 fun(k1, k2, mode, A, Common); + return fn(k1, k2, mode, A, Common); } R_MATRIX_INLINE int attribute_hidden @@ -112,172 +112,172 @@ 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)) + 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 fun(to_xtype, to_ll, to_super, to_packed, to_monotonic, L, Common); + 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(*fun)(CHM_SP, int, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, int, int, CHM_CM)) + 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 fun(A, stype, mode, Common); + 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(*fun)(CHM_DN, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_DN(*)(CHM_DN, CHM_CM)) + 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 fun(A, Common); + 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(*fun)(CHM_FR, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_FR(*)(CHM_FR, CHM_CM)) + 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 fun(L, Common); + 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(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, CHM_CM)) + 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 fun(A, Common); + return fn(A, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_CHOLMOD(defaults)(CHM_CM Common) { - static int(*fun)(CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_CM)) + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_defaults"); - return fun(Common); + 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(*fun)(CHM_DN, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_DN, int, CHM_CM)) + 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 fun(X, values, Common); + 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(*fun)(CHM_FR, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_FR, CHM_CM)) + 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 fun(L, Common); + 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(*fun)(CHM_SP, CHM_FR, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_SP, CHM_FR, CHM_CM)) + 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 fun(A, L, Common); + 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(*fun)(CHM_SP, double[2], int *, size_t, CHM_FR, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_SP, double[2], int *, size_t, CHM_FR, CHM_CM)) + 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 fun(A, beta, fset, fsize, L, Common); + return fn(A, beta, fset, fsize, L, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_CHOLMOD(finish)(CHM_CM Common) { - static int(*fun)(CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_CM)) + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_finish"); - return fun(Common); + return fn(Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_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)) + static int (*fn)(CHM_DN *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_DN *,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_dense"); - return fun(A, Common); + return fn(A, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_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)) + static int (*fn)(CHM_FR *,CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_FR *, CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_factor"); - return fun(L, Common); + return fn(L, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_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)) + static int (*fn)(CHM_SP *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP *, CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_sparse"); - return fun(A, Common); + return fn(A, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_CHOLMOD(free_triplet)(CHM_TR *T, CHM_CM Common) { - static int(*fun)(CHM_TR *, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_TR *,CHM_CM)) + static int (*fn)(CHM_TR *, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_TR *,CHM_CM)) R_GetCCallable("Matrix", "cholmod_free_triplet"); - return fun(T, Common); + return fn(T, Common); } R_MATRIX_INLINE int attribute_hidden R_MATRIX_CHOLMOD(nnz)(CHM_SP A, CHM_CM Common) { - static int(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_SP, CHM_CM)) + static int (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, CHM_CM)) R_GetCCallable("Matrix", "cholmod_nnz"); - return fun(A, Common); + 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(*fun)(CHM_DN, int, CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_DN, int, CHM_SP, CHM_CM)) + 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 fun(S, scale, A, Common); + return fn(S, scale, A, Common); } R_MATRIX_INLINE int attribute_hidden @@ -285,23 +285,23 @@ double alpha[2], double beta[2], CHM_DN X, CHM_DN Y, CHM_CM Common) { - static int(*fun)(CHM_SP, int, double[2], double[2], + static int (*fn)(CHM_SP, int, double[2], double[2], CHM_DN, CHM_DN, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_SP, int, double[2], double[2], + if (!fn) + fn = (int (*)(CHM_SP, int, double[2], double[2], CHM_DN, CHM_DN, CHM_CM)) R_GetCCallable("Matrix", "cholmod_sdmult"); - return fun(A, transpose, alpha, beta, X, Y, Common); + 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(*fun)(int, CHM_FR, CHM_DN, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_DN(*)(int, CHM_FR, CHM_DN, CHM_CM)) + 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 fun(sys, L, B, Common); + return fn(sys, L, B, Common); } R_MATRIX_INLINE int attribute_hidden @@ -309,145 +309,133 @@ CHM_DN *X_Handle, CHM_DN *Y_Handle, CHM_DN *E_Handle, CHM_CM Common) { - static int(*fun)(int, CHM_FR, CHM_DN, CHM_SP, + static int (*fn)(int, CHM_FR, CHM_DN, CHM_SP, CHM_DN *, CHM_SP *, CHM_DN *, CHM_DN *, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(int, CHM_FR, CHM_DN, CHM_SP, + 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 fun(sys, L, B, NULL, X_Handle, NULL, Y_Handle, E_Handle, Common); + 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(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_SP, CHM_CM)) + static int (*fn)(CHM_SP, CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_SP, CHM_CM)) R_GetCCallable("Matrix", "cholmod_sort"); - return fun(A, Common); + 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(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_DN(*)(CHM_SP, CHM_CM)) + 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 fun(A, Common); + 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(*fun)(CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_TR(*)(CHM_SP, CHM_CM)) + 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 fun(A, Common); + 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(*fun)(size_t, size_t, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(size_t, size_t, int, CHM_CM)) + 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 fun(nrow, ncol, xtype, Common); + 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(*fun)(int, CHM_FR, CHM_SP, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(int,CHM_FR, CHM_SP, CHM_CM)) + 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 fun(sys, L, B, Common); + 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(*fun)(CHM_SP, CHM_SP, int, int, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, CHM_SP, int, int, int, CHM_CM)) + 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 fun(A, B, stype, values, sorted, Common); + 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(*fun)(CHM_SP, int *, int, int *, + static CHM_SP (*fn)(CHM_SP, int *, int, int *, int, int, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, int *, int, int *, + if (!fn) + fn = (CHM_SP (*)(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); + 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(*fun)(CHM_SP, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, int, CHM_CM)) + 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 fun(A, values, Common); + 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(*fun)(CHM_TR, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_TR, int, CHM_CM)) + 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 fun(T, nzmax, Common); + 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(*fun)(int, CHM_SP, CHM_FR, CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(int, CHM_SP, CHM_FR, CHM_CM)) + 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 fun(update, C, L, Common); + 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(*fun)(CHM_SP, CHM_SP, int, CHM_CM) = NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, CHM_SP, int, CHM_CM)) + 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 fun(A, B, values, Common); + return fn(A, B, values, Common); } /* ---- cholmod_start ----------------------------------------------- */ /* NB: keep synchronized with analogues in ../../src/chm_common.c */ -#if 0 -static int attribute_hidden -R_MATRIX_CHOLMOD(print_function)(const char *fmt, ...) -{ - va_list(ap); - va_start(ap, fmt); - Rprintf((char *) fmt, ap); - va_end(ap); - return 0; -} -#endif - R_MATRIX_INLINE void attribute_hidden R_MATRIX_CHOLMOD(error_handler)(int status, const char *file, int line, const char *message) @@ -468,20 +456,11 @@ R_MATRIX_INLINE int attribute_hidden R_MATRIX_CHOLMOD(start)(CHM_CM Common) { - static int(*fun)(CHM_CM) = NULL; - if (fun == NULL) - fun = (int(*)(CHM_CM)) + static int (*fn)(CHM_CM) = NULL; + if (!fn) + fn = (int (*)(CHM_CM)) R_GetCCallable("Matrix", "cholmod_start"); - int ans = fun(Common); -#if 0 - /* No longer, with SuiteSparse 5.7.1 : */ - Common->print_function = -# if 0 - R_MATRIX_CHOLMOD(print_function); -# else - NULL; -# endif -#endif + int ans = fn(Common); Common->error_handler = R_MATRIX_CHOLMOD(error_handler); return ans; } @@ -504,52 +483,63 @@ R_MATRIX_INLINE CHM_FR attribute_hidden M_sexp_as_cholmod_factor(CHM_FR L, SEXP from) { - static CHM_FR(*fun)(CHM_FR, SEXP) = NULL; - if (fun == NULL) - fun = (CHM_FR(*)(CHM_FR, SEXP)) + static CHM_FR (*fn)(CHM_FR, SEXP) = NULL; + if (!fn) + fn = (CHM_FR (*)(CHM_FR, SEXP)) R_GetCCallable("Matrix", "sexp_as_cholmod_factor"); - return fun(L, from); + 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(*fun)(CHM_SP, SEXP, Rboolean, Rboolean)= NULL; - if (fun == NULL) - fun = (CHM_SP(*)(CHM_SP, SEXP, Rboolean, Rboolean)) + 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 fun(A, from, checkUnit, sortInPlace); + 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(*fun)(CHM_DN, SEXP) = NULL; - if (fun == NULL) - fun = (CHM_DN(*)(CHM_DN, SEXP)) + static CHM_DN (*fn)(CHM_DN, SEXP) = NULL; + if (!fn) + fn = (CHM_DN (*)(CHM_DN, SEXP)) R_GetCCallable("Matrix", "sexp_as_cholmod_dense"); - return fun(A, from); + 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(*fun)(CHM_DN, double *, int, int) = NULL; - if (fun == NULL) - fun = (CHM_DN(*)(CHM_DN, double *, int, int)) + 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 fun(A, data, nrow, ncol); + return fn(A, data, nrow, ncol); } R_MATRIX_INLINE SEXP attribute_hidden M_cholmod_factor_as_sexp(CHM_FR L, int doFree) { - static SEXP(*fun)(CHM_FR, int) = NULL; - if (fun == NULL) - fun = (SEXP(*)(CHM_FR, int)) + static SEXP (*fn)(CHM_FR, int) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_FR, int)) R_GetCCallable("Matrix", "cholmod_factor_as_sexp"); - return fun(L, doFree); + return fn(L, doFree); } R_MATRIX_INLINE SEXP attribute_hidden @@ -557,41 +547,53 @@ int ttype, int doLogic, const char *diagString, SEXP dimnames) { - static SEXP(*fun)(CHM_SP, int, int, int, const char *, SEXP) = NULL; - if (fun == NULL) - fun = (SEXP(*)(CHM_SP, int, int, int, const char *, SEXP)) + 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 fun(A, doFree, ttype, doLogic, diagString, dimnames); + 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(*fun)(CHM_DN, int) = NULL; - if (fun == NULL) - fun = (SEXP(*)(CHM_DN, int)) + static SEXP (*fn)(CHM_DN, int) = NULL; + if (!fn) + fn = (SEXP (*)(CHM_DN, int)) R_GetCCallable("Matrix", "cholmod_dense_as_sexp"); - return fun(A, doFree); + return fn(A, doFree); } R_MATRIX_INLINE double attribute_hidden M_cholmod_factor_ldetA(CHM_FR L) { - static double(*fun)(CHM_FR) = NULL; - if (fun == NULL) - fun = (double(*)(CHM_FR)) + static double (*fn)(CHM_FR) = NULL; + if (!fn) + fn = (double (*)(CHM_FR)) R_GetCCallable("Matrix", "cholmod_factor_ldetA"); - return fun(L); + 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(*fun)(CHM_FR, CHM_SP, double) = NULL; - if (fun == NULL) - fun = (CHM_FR(*)(CHM_FR, CHM_SP, double)) + 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 fun(L, A, beta); + return fn(L, A, beta); } #ifdef __cplusplus diff -Nru rmatrix-1.6-3/inst/include/Matrix/version.h rmatrix-1.6-5/inst/include/Matrix/version.h --- rmatrix-1.6-3/inst/include/Matrix/version.h 2023-11-08 00:40:22.000000000 +0000 +++ rmatrix-1.6-5/inst/include/Matrix/version.h 2023-11-30 18:40:54.000000000 +0000 @@ -5,10 +5,10 @@ /* e.g., R_MATRIX_PACKAGE_VERSION R_version(major, minor, patch) : */ /* (version)_{10} = (major minor patch)_{256} */ -#define R_MATRIX_PACKAGE_VERSION 67075 +#define R_MATRIX_PACKAGE_VERSION 67077 #define R_MATRIX_PACKAGE_MAJOR 1 #define R_MATRIX_PACKAGE_MINOR 6 -#define R_MATRIX_PACKAGE_PATCH 3 +#define R_MATRIX_PACKAGE_PATCH 5 #define R_MATRIX_ABI_VERSION 1 diff -Nru rmatrix-1.6-3/inst/test-tools-1.R rmatrix-1.6-5/inst/test-tools-1.R --- rmatrix-1.6-3/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-3/inst/test-tools-Matrix.R rmatrix-1.6-5/inst/test-tools-Matrix.R --- rmatrix-1.6-3/inst/test-tools-Matrix.R 2023-11-13 10:13:15.000000000 +0000 +++ rmatrix-1.6-5/inst/test-tools-Matrix.R 2023-12-27 05:10:03.000000000 +0000 @@ -448,7 +448,7 @@ doCoerce2 = doCoerce && !isRsp, doDet = do.matrix, do.prod = do.t && do.matrix && !isRsp, verbose = TRUE, catFUN = cat, - MSG = if(interactive() || capabilities("long.double") || + MSG = if(interactive() || capabilities("long.double") || isTRUE(get0("doExtras"))) message else function(...) {} ) { @@ -820,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-3/man/Xtrct-methods.Rd rmatrix-1.6-5/man/Xtrct-methods.Rd --- rmatrix-1.6-3/man/Xtrct-methods.Rd 2023-08-15 22:08:58.000000000 +0000 +++ rmatrix-1.6-5/man/Xtrct-methods.Rd 2023-12-05 23:11:56.000000000 +0000 @@ -26,7 +26,9 @@ \alias{[,abIndex,index,ANY,ANY-method} \alias{[,sparseVector,NULL,ANY,ANY-method} \alias{[,sparseVector,index,missing,missing-method} -\alias{[,sparseVector,sparseVector,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-3/man/band.Rd rmatrix-1.6-5/man/band.Rd --- rmatrix-1.6-3/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-3/man/indMatrix-class.Rd rmatrix-1.6-5/man/indMatrix-class.Rd --- rmatrix-1.6-3/man/indMatrix-class.Rd 2023-09-13 23:51:33.000000000 +0000 +++ rmatrix-1.6-5/man/indMatrix-class.Rd 2024-01-03 16:12:15.000000000 +0000 @@ -93,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 @@ -111,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-3/man/pMatrix-class.Rd rmatrix-1.6-5/man/pMatrix-class.Rd --- rmatrix-1.6-3/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-3/src/chm_common.c rmatrix-1.6-5/src/chm_common.c --- rmatrix-1.6-3/src/chm_common.c 2023-10-18 20:44:10.000000000 +0000 +++ rmatrix-1.6-5/src/chm_common.c 2024-01-06 06:57:56.000000000 +0000 @@ -100,8 +100,8 @@ /* 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) + 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; } @@ -162,7 +162,7 @@ } if (!cholmod_check_factor(L, &c)) - error(_("'%s' failed"), "cholmod_check_factor"); + error(_("'%s' failed in '%s'"), "cholmod_check_factor", __func__); UNPROTECT(4); return L; } @@ -177,6 +177,10 @@ * * @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. */ @@ -205,16 +209,17 @@ i = PROTECT(GET_SLOT(from, Matrix_iSym)), cpi = PROTECT(checkpi(p, i, m, n)); if (TYPEOF(cpi) != LGLSXP) - error(CHAR(STRING_ELT(cpi, 0))); + error(_("'%s' failed in '%s': %s"), + "checkpi", __func__, CHAR(STRING_ELT(cpi, 0))); int *pp = INTEGER(p), *pi = INTEGER(i), sorted = LOGICAL(cpi)[0]; - R_xlen_t np = XLENGTH(p), ni = XLENGTH(i); + size_t np = (size_t) XLENGTH(p), ni = (size_t) XLENGTH(i); if (!sorted && !sortInPlace) { int *tmp; - tmp = (int *) R_alloc((size_t) np, sizeof(int)); - memcpy(tmp, pp, (size_t) np * sizeof(int)); + tmp = (int *) R_alloc(np, sizeof(int)); + memcpy(tmp, pp, np * sizeof(int)); pp = tmp; - tmp = (int *) R_alloc((size_t) ni, sizeof(int)); - memcpy(tmp, pi, (size_t) ni * sizeof(int)); + tmp = (int *) R_alloc(ni, sizeof(int)); + memcpy(tmp, pi, ni * sizeof(int)); pi = tmp; } @@ -222,7 +227,7 @@ A->ncol = n; A->p = pp; A->i = pi; - A->nzmax = (size_t) ni; + A->nzmax = ni; A->stype = 0; A->itype = CHOLMOD_INT; A->xtype = CHOLMOD_PATTERN; @@ -232,8 +237,8 @@ if (ni > pp[n]) { /* overallocated */ A->packed = 0; - int j, *tmp = (int *) R_alloc(n, sizeof(int)); - for (j = 0; j < n; ++j) + 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; } @@ -250,7 +255,7 @@ case 'i': { int *px = (TYPEOF(x) == LGLSXP) ? LOGICAL(x) : INTEGER(x); - double *rtmp = (double *) R_alloc(nx + 1, sizeof(double)); + 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]; @@ -262,8 +267,8 @@ { double *px = REAL(x); if (!sorted && !sortInPlace) { - double *rtmp = (double *) R_alloc(nx + 1, sizeof(double)); - memcpy(rtmp, px, (nx + 1) * sizeof(double)); + double *rtmp = (double *) R_alloc(nx, sizeof(double)); + memcpy(rtmp, px, nx * sizeof(double)); px = rtmp; } A->x = px; @@ -274,8 +279,8 @@ { Rcomplex *px = COMPLEX(x); if (!sorted && !sortInPlace) { - Rcomplex *rtmp = (Rcomplex *) R_alloc(nx + 1, sizeof(Rcomplex)); - memcpy(rtmp, px, (nx + 1) * sizeof(Rcomplex)); + Rcomplex *rtmp = (Rcomplex *) R_alloc(nx, sizeof(Rcomplex)); + memcpy(rtmp, px, nx * sizeof(Rcomplex)); px = rtmp; } A->x = px; @@ -288,7 +293,7 @@ UNPROTECT(1); /* x */ } if (!sorted && !cholmod_sort(A, &c)) - error(_("'%s' failed"), "cholmod_sort"); + 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)); @@ -318,6 +323,135 @@ } /** + * Coerce from TsparseMatrix to (cholmod_triplet *) + * + * 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 A. + */ +cholmod_triplet *sexp_as_cholmod_triplet(cholmod_triplet *A, SEXP from, + Rboolean checkUnit) +{ + 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; + } + + 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 */ + } + + UNPROTECT(2); /* j, i */ + return A; +} + +/** * Coerce from [nlidz]geMatrix or vector to (cholmod_dense *) * * Sets the members of a pointed-to cholmod_dense struct, using "data" @@ -558,6 +692,7 @@ SET_SLOT(to, Matrix_xSym, x); UNPROTECT(1); } + FREE_THEN(); #undef FREE_THEN @@ -649,9 +784,126 @@ memcpy(REAL(x), A->x, (size_t) nnz * sizeof(double)); } else { PROTECT(x = allocVector(LGLSXP, nnz)); - int k, *px = LOGICAL(x); + 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; +} + +/** + * Coerce from (cholmod_triplet *) to TsparseMatrix + * + * 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 A TsparseMatrix. + */ +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; + } + } + 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 { + PROTECT(x = allocVector(LGLSXP, nnz)); + int *px = LOGICAL(x); double *py = (double *) A->x; - for (k = 0; k < nnz; ++k) + for (R_xlen_t k = 0; k < nnz; ++k) px[k] = (ISNAN(py[k])) ? NA_LOGICAL : (py[k] != 0.0); } SET_SLOT(to, Matrix_xSym, x); @@ -669,6 +921,7 @@ } if (TYPEOF(dimnames) == VECSXP && LENGTH(dimnames) == 2) SET_SLOT(to, Matrix_DimNamesSym, dimnames); + FREE_THEN(); #undef FREE_THEN @@ -734,6 +987,7 @@ memcpy(REAL(x), A->x, (size_t) m * n * sizeof(double)); } SET_SLOT(to, Matrix_xSym, x); + FREE_THEN(); #undef FREE_THEN @@ -810,10 +1064,10 @@ z[0] = beta; z[1] = 0.0; if (!cholmod_factorize_p(A, z, NULL, 0, L, &c)) - error(_("'%s' failed"), "cholmod_factorize_p"); + 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"), "cholmod_change_factor"); + error(_("'%s' failed in '%s'"), "cholmod_change_factor", __func__); return L; } @@ -846,7 +1100,7 @@ { int ans = cholmod_start(Common); if (!ans) - error(_("'%s' failed"), "cholmod_start"); + error(_("'%s' failed in '%s'"), "cholmod_start", __func__); #if 0 /* No longer, with SuiteSparse 5.7.1 : */ Common->print_function = @@ -864,7 +1118,7 @@ { int ans = cholmod_finish(Common); if (!ans) - error(_("'%s' failed"), "cholmod_finish"); + error(_("'%s' failed in '%s'"), "cholmod_finish", __func__); return ans; } diff -Nru rmatrix-1.6-3/src/chm_common.h rmatrix-1.6-5/src/chm_common.h --- rmatrix-1.6-3/src/chm_common.h 2023-10-18 20:44:10.000000000 +0000 +++ rmatrix-1.6-5/src/chm_common.h 2023-11-27 20:27:27.000000000 +0000 @@ -3,17 +3,21 @@ #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_dense * sexp_as_cholmod_dense (cholmod_dense *, SEXP); -cholmod_dense *numeric_as_cholmod_dense (cholmod_dense *, double *, - int, int); +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_dense_as_sexp (cholmod_dense *, 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 *, diff -Nru rmatrix-1.6-3/src/cholmod-etc.c rmatrix-1.6-5/src/cholmod-etc.c --- rmatrix-1.6-3/src/cholmod-etc.c 2023-10-13 20:01:06.000000000 +0000 +++ rmatrix-1.6-5/src/cholmod-etc.c 2024-01-06 06:57:56.000000000 +0000 @@ -23,8 +23,8 @@ /* 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) + 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; } diff -Nru rmatrix-1.6-3/src/dense.c rmatrix-1.6-5/src/dense.c --- rmatrix-1.6-3/src/dense.c 2023-10-11 14:06:48.000000000 +0000 +++ rmatrix-1.6-5/src/dense.c 2023-12-11 01:57:56.000000000 +0000 @@ -204,19 +204,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); from = dense_band(from, valid[ivalid], a, b); UNPROTECT(1); diff -Nru rmatrix-1.6-3/src/init.c rmatrix-1.6-5/src/init.c --- rmatrix-1.6-3/src/init.c 2023-10-18 20:44:10.000000000 +0000 +++ rmatrix-1.6-5/src/init.c 2024-01-06 06:59:15.000000000 +0000 @@ -299,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); @@ -323,21 +324,20 @@ RREGDEF(cholmod_submatrix); RREGDEF(cholmod_transpose); RREGDEF(cholmod_triplet_to_sparse); - RREGDEF(cholmod_vertcat); RREGDEF(cholmod_updown); + 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); - /* Because lme4 inexplicably does not use _our_ headers: */ - R_RegisterCCallable("Matrix", "chm_factor_ldetL2", - (DL_FUNC) cholmod_factor_ldetA); Matrix_DimNamesSym = install("Dimnames"); Matrix_DimSym = install("Dim"); diff -Nru rmatrix-1.6-3/src/sparse.c rmatrix-1.6-5/src/sparse.c --- rmatrix-1.6-3/src/sparse.c 2023-10-11 13:25:02.000000000 +0000 +++ rmatrix-1.6-5/src/sparse.c 2023-12-11 01:57:56.000000000 +0000 @@ -584,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); } diff -Nru rmatrix-1.6-3/src/t_Csparse_subassign.c rmatrix-1.6-5/src/t_Csparse_subassign.c --- rmatrix-1.6-3/src/t_Csparse_subassign.c 2023-09-29 19:53:32.000000000 +0000 +++ rmatrix-1.6-5/src/t_Csparse_subassign.c 2023-11-28 11:50:51.000000000 +0000 @@ -267,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 } } diff -Nru rmatrix-1.6-3/src/utils-R.c rmatrix-1.6-5/src/utils-R.c --- rmatrix-1.6-3/src/utils-R.c 2023-10-19 04:13:21.000000000 +0000 +++ rmatrix-1.6-5/src/utils-R.c 2023-11-28 11:50:51.000000000 +0000 @@ -385,17 +385,17 @@ 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 " + 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]"), - 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 " + (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]"), - lendat, nc); - } else if ((lendat > 1) && (nrc == 0)) + (long long)lendat, nc); + } else if (lendat > 1 && nrc == 0) warning(_("data length exceeds size of matrix")); } diff -Nru rmatrix-1.6-3/src/validity.c rmatrix-1.6-5/src/validity.c --- rmatrix-1.6-3/src/validity.c 2023-10-25 15:50:21.000000000 +0000 +++ rmatrix-1.6-5/src/validity.c 2024-01-03 20:13:16.000000000 +0000 @@ -1850,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); @@ -1875,11 +1875,7 @@ } 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"; @@ -1895,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; @@ -1912,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-3/src/version.h rmatrix-1.6-5/src/version.h --- rmatrix-1.6-3/src/version.h 2023-11-08 00:40:22.000000000 +0000 +++ rmatrix-1.6-5/src/version.h 2023-11-30 18:40:54.000000000 +0000 @@ -2,10 +2,10 @@ #define MATRIX_VERSION_H /* (version)_{10} = (major minor patch)_{256} */ -#define MATRIX_PACKAGE_VERSION 67075 +#define MATRIX_PACKAGE_VERSION 67077 #define MATRIX_PACKAGE_MAJOR 1 #define MATRIX_PACKAGE_MINOR 6 -#define MATRIX_PACKAGE_PATCH 3 +#define MATRIX_PACKAGE_PATCH 5 #define MATRIX_ABI_VERSION 1 diff -Nru rmatrix-1.6-3/tests/Simple.R rmatrix-1.6-5/tests/Simple.R --- rmatrix-1.6-3/tests/Simple.R 2023-11-02 02:27:39.000000000 +0000 +++ rmatrix-1.6-5/tests/Simple.R 2023-12-09 22:30:22.000000000 +0000 @@ -1464,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() ... @@ -1551,6 +1552,47 @@ 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() SysI <- Sys.info() diff -Nru rmatrix-1.6-3/tests/factorizing.R rmatrix-1.6-5/tests/factorizing.R --- rmatrix-1.6-3/tests/factorizing.R 2023-08-16 05:39:47.000000000 +0000 +++ rmatrix-1.6-5/tests/factorizing.R 2024-01-03 16:12:15.000000000 +0000 @@ -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),