R Under development (unstable) (2025-02-12 r87715 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(flint) > > > ## Test that length(new(., length = value)) == value > ## length(new(., x = value)) == length(value). > > cl <- c("ulong", "slong", "fmpz", "fmpq", "mag", "arf", "acf", + "arb", "acb") > n <- length(cl):1L > a <- .mapply(new, list(cl, length = n), NULL) > b <- .mapply(new, list(cl, x = lapply(n, raw)), NULL) > stopifnot(identical(lapply(a, length), as.list(n)), + identical(lapply(b, length), as.list(n))) > > > ## Test implicit default values of initializers. > > new.fmpq <- + function (Class, num = 0L, den = 1L, ...) + new(Class, num = num, den = den) > new.arb <- + function (Class, mid = 0, rad = 0, ...) + new(Class, mid = mid, rad = rad) > new.acf <- + new.acb <- + function (Class, real = 0, imag = 0, ...) + new(Class, real = real, imag = imag) > > e <- expression(new(, 1), ) > for (s in list(c("fmpq", "num", "den"), + c( "arb", "mid", "rad"), + c( "acf", "real", "imag"), + c( "acb", "real", "imag"))) { + e[[c(1L, 2L)]] <- s[1L] + e[[2L]] <- e[[1L]] + e[[c(2L, 1L)]] <- as.name(paste0("new.", s[1L])) + for (nm in s[-1L]) { + for (i in 1:2) + names(e[[i]])[3L] <- nm + print(e) + v <- lapply(e, eval) + stopifnot(flintIdentical(v[[1L]], v[[2L]])) + } + } expression(new("fmpq", num = 1), new.fmpq("fmpq", num = 1)) expression(new("fmpq", den = 1), new.fmpq("fmpq", den = 1)) expression(new("arb", mid = 1), new.arb("arb", mid = 1)) expression(new("arb", rad = 1), new.arb("arb", rad = 1)) expression(new("acf", real = 1), new.acf("acf", real = 1)) expression(new("acf", imag = 1), new.acf("acf", imag = 1)) expression(new("acb", real = 1), new.acb("acb", real = 1)) expression(new("acb", imag = 1), new.acb("acb", imag = 1)) > > > ## Test recycling of initializers. > > . <- integer(0L); a <- 1:2; b <- 3:4; aa <- c(a, a); bb <- c(b, b) > e <- expression(new(, a, bb), + new(, aa, bb), + new(, ., bb), + new(, ., .)) > for (s in list(c("fmpq", "num", "den"), + c( "arb", "mid", "rad"), + c( "acf", "real", "imag"), + c( "acb", "real", "imag"))) { + for (p in list(1:2, 2:1)) { + for (i in 1:4) { + e[[c(i, 2L)]] <- s[1L] + names(e[[i]])[3:4] <- s[-1L][p] + } + print(e) + v <- lapply(e, eval) + stopifnot(flintIdentical(v[[1L]], v[[2L]]), + flintIdentical(v[[3L]], v[[4L]])) + } + } expression(new("fmpq", num = a, den = bb), new("fmpq", num = aa, den = bb), new("fmpq", num = ., den = bb), new("fmpq", num = ., den = .)) expression(new("fmpq", den = a, num = bb), new("fmpq", den = aa, num = bb), new("fmpq", den = ., num = bb), new("fmpq", den = ., num = .)) expression(new("arb", mid = a, rad = bb), new("arb", mid = aa, rad = bb), new("arb", mid = ., rad = bb), new("arb", mid = ., rad = .)) expression(new("arb", rad = a, mid = bb), new("arb", rad = aa, mid = bb), new("arb", rad = ., mid = bb), new("arb", rad = ., mid = .)) expression(new("acf", real = a, imag = bb), new("acf", real = aa, imag = bb), new("acf", real = ., imag = bb), new("acf", real = ., imag = .)) expression(new("acf", imag = a, real = bb), new("acf", imag = aa, real = bb), new("acf", imag = ., real = bb), new("acf", imag = ., real = .)) expression(new("acb", real = a, imag = bb), new("acb", real = aa, imag = bb), new("acb", real = ., imag = bb), new("acb", real = ., imag = .)) expression(new("acb", imag = a, real = bb), new("acb", imag = aa, real = bb), new("acb", imag = ., real = bb), new("acb", imag = ., real = .)) > > > ## Test single initialization of 'fmpq'. > > x <- c(-10, -0.125, 0, 1.25, 2.5) > a <- new("fmpq", x = x) > b <- new("fmpq", + num = c(-10L, -1L, 0L, 5L, 5L), + den = c( 1L, 8L, 1L, 4L, 2L)) > stopifnot(flintIdentical(a, b)) > > > ## Test single initialization of 'arb'. > > x <- atan(-2:2) > a <- new("arb", x = x) > b <- new("arb", mid = x, rad = 0) > stopifnot(flintIdentical(a, b)) > > > ## Test single initialization of 'acf', 'acb'. > > x <- complex(real = exp(-2:2), imaginary = sin(-2:2)) > a <- new("acf", x = x) > b <- new("acf", real = Re(x), imag = Im(x)) > stopifnot(flintIdentical(a, b)) > a <- new("acb", x = x) > b <- new("acb", real = Re(x), imag = Im(x)) > stopifnot(flintIdentical(a, b)) > > > ## Test handling of unrepresentable values. > > testError <- + function (call, l) { + call <- substitute(call) + fn <- + function (value) { + call. <- do.call(substitute, list(call, list(. = value))) + tryCatch({ eval(call.); FALSE }, error = function (e) TRUE) + } + vapply(l, fn, FALSE) + } > > wl <- flintABI() > wd <- .Machine[["double.digits"]] > a <- 2^wl > b <- 2^max(0L, wl - wd) > stopifnot(testError(new("ulong", x = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf, + -1, a)), + testError(new("slong", x = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf, + -a/2 - b*2, a/2)), + testError(new("fmpz", x = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf)), + testError(new("fmpq", x = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf)), + testError(new("fmpq", num = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf)), + testError(new("fmpq", den = .), + list(NA, NA_integer_, NA_real_, NaN, -Inf, Inf, + 0)), + testError(new("mag", x = .), + list(NA, NA_integer_, NA_real_, NaN)), + testError(new("arb", rad = .), + list(NA, NA_integer_, NA_real_, NaN))) > > proc.time() user system elapsed 0.40 0.09 0.48