provide diag(<big[zq]matrix>)

.gitignore

@@ -2,9 +2,8 @@
 src/*.o
 src/*.so
 src/*.dll
-misc/cache/*
+misc/*
 .Rhistory
-misc/
 *.out
 gmp-Ex.Rout*
 \#*

ChangeLog

+2025-03-06  Martin Maechler  <maechler@stat.math.ethz.ch>
+
+	* R/biginteger.R (.diag.big): new  `diag(.)` methods for bigz and bigq matrices.
+
 2024-08-24 Antoine Lucas
 
-	Fix issue "compliation with R_NO_REMAP flag" i.e. use of Rf_error and Rf_warning instead of error / warning.
+	Fix issue "compilation with R_NO_REMAP flag" i.e. use of Rf_error and Rf_warning instead of error / warning.
 
 2024-01-30  Martin Maechler  <maechler@stat.math.ethz.ch>
 

DESCRIPTION

 Package: gmp
-Version: 0.7-5
-Date: 2024-08-23
+Version: 0.7-6
+Date: 2025-03-07
 Title: Multiple Precision Arithmetic
 Authors@R: c(person("Antoine","Lucas",role = c("aut","cre"),
-	  email = "antoinelucas@gmail.com", comment = c(ORCID="0000-0002-8059-9767")),
+		email = "antoinelucas@gmail.com", comment = c(ORCID="0000-0002-8059-9767")),
 	  person("Immanuel","Scholz", role= "aut"),
 	  person("Rainer","Boehme", role = "ctb", email= "rb-gmp@reflex-studio.de"),
  	  person("Sylvain","Jasson", role = "ctb", email= "Sylvain.Jasson@inrae.fr"),
-	  person("Martin", "Maechler", role = "ctb", email="maechler@stat.math.ethz.ch"))
+	  person("Martin", "Maechler", role = "ctb",
+		email = "maechler@stat.math.ethz.ch", comment = c(ORCID="0000-0002-8685-9910"))
+	)
 Maintainer: Antoine Lucas <antoinelucas@gmail.com>
 Description: Multiple Precision Arithmetic (big integers and rationals,
  prime number tests, matrix computation), "arithmetic without limitations"
@@ -21,4 +23,3 @@ BuildResaveData: no
 LazyDataNote: not available, as we use data/*.R *and* our classes
 NeedsCompilation: yes
 URL: https://forgemia.inra.fr/sylvain.jasson/gmp
-Packaged: 2024-01-15 14:34:19 UTC; antoine

NAMESPACE

@@ -22,6 +22,7 @@ export(
        ## "c.bigq", "c.bigz", "cbind.bigq", "cbind.bigz",  "rbind.bigq", "rbind.bigz",
        ## "cumsum.bigq", "cumsum.bigz",
        "denominator", "denominator<-",
+       ## diag, # S3 generic --> rather S4 + exportMethods()
        ## "dim<-.bigq", "dim.bigq", "dim<-.bigz", "dim.bigz",
        "div.bigq", "div.bigz", "divq.bigz",
        dbinomQ, # dbinom() with exact rationals
@@ -264,6 +265,9 @@ S3method(diff, bigq, .diff.big)
 export(asNumeric)
 exportMethods(asNumeric)
 
+export(diag)
+exportMethods(diag)
+
 exportMethods(which.max, which.min)
 
 exportClasses("bigz", "bigq")# setOldClass()'ed, needed in  Rmpfr

R/AllClasses-etc.R

@@ -29,3 +29,17 @@ setOldClass("bigq")#, prototype=as.bigq(integer()))
     x
 }
 ##--> and entries in ../NAMESPACE
+
+
+indDiag <- function(n) cumsum(c(1L, rep.int(n+1L, n-1)))
+## to be used in  diag() methods {but potentially elsewhere; {Matrix} has a C version}
+
+.diag.big <- function(x, nrow, ncol, names) {
+    if(!missing(nrow) || !missing(ncol) || !missing(names))
+        stop("'nrow', 'ncol' or 'names' cannot be specified for diag(<big[zq]-matrix>)")
+    stopifnot(is.numeric(n <- attr(x, "nrow")))
+    ## ncol(.) is  if(n) length(x) %/% n else 0L
+    x[[indDiag(if(n) min(n, length(x) %/% n) else 0L)]]
+}
+setMethod("diag", signature(x = "bigz"), .diag.big)
+setMethod("diag", signature(x = "bigq"), .diag.big)

R/biginteger.R

@@ -498,17 +498,15 @@ solve.bigz <- function(a, b,...)
 
 `[.bigz` <- function(x, i=NULL, j=NULL, drop=TRUE)
 {
-
   mdrop <- missing(drop)
   Narg <- nargs() - (!mdrop)
   # matrix access [i,j] [,j] [i,]
   # vector access [i]
-  matrixAccess = Narg > 2
-  has.j <- !missing(j)
-  if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
+  matrixAccess <- Narg > 2
+  if(matrixAccess && !is.null(attr(x, "nrow"))) { ## matrix
     .Call(matrix_get_at_z, x, i,j)
   } else { ## non-matrix
-    if(has.j) stop("invalid vector subsetting")
+    if(!missing(j)) stop("invalid vector subsetting")
 
     r <- .Call(biginteger_get_at, x, i)
     attr(r,"nrow") <- NULL
@@ -518,20 +516,15 @@ solve.bigz <- function(a, b,...)
 
 `[<-.bigz` <- function(x, i=NULL, j=NULL, value)
 {
-
   # matrix access [i,j] [,j] [i,]
   # vector access [i]
-  matrixAccess = nargs() > 3
-
-  has.j <- !missing(j)
-  if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
+  matrixAccess <- nargs() > 3
+  if(matrixAccess && !is.null(attr(x, "nrow"))) { ## matrix
       .Call(matrix_set_at_z, x, value, i,j)
-  } else { ## non-matrix 
-    if(has.j) stop("invalid vector subsetting")
-    r <- .Call(biginteger_set_at, x, i, value) 
+  } else { ## non-matrix
+    if(!missing(j)) stop("invalid vector subsetting")
+    r <- .Call(biginteger_set_at, x, i, value)
     attr(r,"nrow") <- attr(x, "nrow")
     r
   }
 }
-
-

man/extract.Rd

 \name{extract}
 \title{Extract or Replace Parts of a 'bigz' or 'bigq' Object}
 \alias{[.bigz}
+\alias{[.bigq}
 %F\alias{[<-}% otherwise warning " Objects in \usage w/o \alias : '[<-' "
 \alias{[<-.bigz}
-\alias{[[.bigz}
-\alias{[[<-.bigz}
-\alias{c.bigz}
-\alias{rep.bigz}
-\alias{length.bigz}
-\alias{length<-.bigz}
-\alias{[.bigq}
 \alias{[<-.bigq}
+\alias{[[.bigz}
 \alias{[[.bigq}
+\alias{[[<-.bigz}
 \alias{[[<-.bigq}
-%-
+\alias{c.bigz}
 \alias{c.bigq}
+\alias{diag,bigz-method}
+\alias{diag,bigq-method}
+\alias{diff.bigz}% which only "exists" via  S3method(diff, *, .diff.big)
+\alias{diff.bigq}% (ditto)
+\alias{rep.bigz}
 \alias{rep.bigq}
+\alias{length.bigz}
 \alias{length.bigq}
+\alias{length<-.bigz}
 \alias{length<-.bigq}
 \description{
   Operators acting on vectors, arrays and lists to extract or replace subsets.
+
+  Further, methods for \code{\link{c}()}, \code{\link{diag}()},
+  \code{\link{diff}()}, \code{\link{rep}()}, \code{\link{length}()}, the
+  latter also with replacement methods (\code{\link{length<-}}) for package
+  \pkg{gmp} objects of class \code{"bigz"} and \code{"bigq"}.
 }
 \usage{
 \method{[}{bigz}(x, i=NULL, j=NULL, drop = TRUE)
 \method{[}{bigq}(x, i=NULL, j=NULL, drop = TRUE)
-%F \method{[<-}{bigq}(x, i=NULL, j=NULL, value) %    ==> "the same", manually -- R check-bug:
-%F x[i=NULL, j=NULL] <- value % still WARNING .. usage in doc.. .. but not in code: `[<-`
+%F \method{[<-}{bigq}(x, i=NULL, j=NULL, value) %    ==> R check-bug:
+%  Bad \usage lines found in Rd file 'extract.Rd':
+%   <unescaped bksl>method{[<-}{bigq}(x, i = NA, value) 
 ##___ In the following, only the bigq method is mentioned (but 'bigz' is "the same"): ___
+\method{[[}{bigq}(x, i = NA) 
+%F \method{[[<-}{bigq}(x, i = NA, value) % R check-bug (see above)
+
 \method{c}{bigq}(\dots, recursive = FALSE)
 \method{rep}{bigq}(x, times=1, length.out=NA, each=1, \dots)
+
+\S4method{diag}{bigq}(x, nrow, ncol, names)
+
+\method{diff}{bigq}(x, lag = 1, differences = 1, \dots) # via .diff.big()
 }
 \arguments{
   \item{x}{\R object of class \code{"bigz"} or \code{"bigq"}, respectively.}
@@ -37,10 +53,12 @@
   \item{drop}{logical, unused here, i.e., matrix subsetting \bold{always} returns a matrix, here!}
 %F \item{value}{\R object, typically of same \code{\link{class}} as
 %F   \code{x}, or also \code{\link{numeric}}.}
+  \item{recursive}{from \code{c()}'s %'
+      default method; disregarded here.}
   \item{times, length.out, each}{integer; typically only \emph{one} is
-    specified; for more see \code{\link{rep}} (standard \R, package \pkg{base}).
-  }
-  \item{recursive}{from \code{c()}'s default method; disregarded here}
+    specified; for more see \code{\link{rep}} (standard \R, package \pkg{base}).}
+  \item{nrow, ncol, names}{unused (currently needed for method/generic compatibility).}
+  \item{lag, differences}{for \code{\link{diff}()} method only.}
 }
 
 \examples{

man/matrix.Rd

 \name{matrix}
+\title{Matrix Manipulations in Package \pkg{gmp}}
 \alias{matrix}
 \alias{matrix.default}
 \alias{matrix.bigz}
@@ -55,10 +56,8 @@
 \alias{dim<-.bigq}
 \alias{dim.bigz}
 \alias{dim<-.bigz}
-
-\title{Matrix manipulation with gmp}
 \description{
-  Overload of \dQuote{all} standard tools useful for matrix manipulation adapted
+  Overload of \dQuote{all} most standard tools useful for matrix manipulation adapted
   to large numbers.
 }
 % \S4method{\%*\%}{bigz,bigz}(x, y)

man/solve.Rd

@@ -55,13 +55,14 @@ A <- rbind(c(10, 1,  3),
            c( 4, 2, 10),
            c( 1, 8,  2))
 (IA.q <- solve(as.bigq(A))) # fractions..
-stopifnot(diag(3) == A \%*\% IA.q)# perfect
+stopifnot(diag(3) == A \%*\% IA.q)#%# perfect
 
 set.seed(5); B <- matrix(round(9*runif(5^2, -1,1)), 5)
-B
+B  # integer entriess in -7..8
 (IB.q <- solve(as.bigq(B)))
-stopifnot(diag(5) == B \%*\% IB.q, diag(5) == IB.q \%*\% B,
-          identical(B, asNumeric(solve(IB.q))))
+stopifnot(diag(5) == B \%*\% IB.q, #%
+          diag(5) == IB.q \%*\% B, #%
+          identical(B, asNumeric(solve(IB.q)))) # exact
 }
 \keyword{arith}