allaun
e5bfdc0492
Containerized LKB worker (Dockerfile.lkb), Postgres-backed queue, auto-deploy timer, and eigensolid convergence check module. Build: 0 jobs (no Lean build needed)
248 lines
6.8 KiB
R
248 lines
6.8 KiB
R
source("boot.R")
|
|
#.libPaths(c("~/R/library", .libPaths()))
|
|
#library(Rcpp)
|
|
#Rcpp::sourceCpp("src/laurent_ops.cpp")
|
|
|
|
# ══════════════════════════════════════════════════════════════
|
|
# Two-variable Laurent polynomials: Z[q^±1, t^±1]
|
|
# Optimized: integer vectors (qe, te) instead of string keys
|
|
# No string ops (strsplit, paste0) in multiply/add hot paths
|
|
# ══════════════════════════════════════════════════════════════
|
|
|
|
#' @export
|
|
laurent2 <- function(terms = NULL) {
|
|
if (is.null(terms) || length(terms) == 0) {
|
|
return(structure(list(qe = integer(0), te = integer(0), coef = numeric(0)),
|
|
class = "laurent2"))
|
|
}
|
|
terms <- terms[terms != 0]
|
|
if (length(terms) == 0) {
|
|
return(structure(list(qe = integer(0), te = integer(0), coef = numeric(0)),
|
|
class = "laurent2"))
|
|
}
|
|
qe <- as.integer(sub(",.*", "", names(terms)))
|
|
te <- as.integer(sub(".*,", "", names(terms)))
|
|
coef <- as.numeric(terms)
|
|
|
|
o <- order(qe, te)
|
|
qe <- qe[o]; te <- te[o]; coef <- coef[o]
|
|
|
|
if (length(qe) >= 2) {
|
|
j <- 1L
|
|
for (i in 2:length(qe)) {
|
|
if (qe[i] == qe[j] && te[i] == te[j]) {
|
|
coef[j] <- coef[j] + coef[i]
|
|
} else {
|
|
j <- j + 1L
|
|
qe[j] <- qe[i]; te[j] <- te[i]; coef[j] <- coef[i]
|
|
}
|
|
}
|
|
length(qe) <- j; length(te) <- j; length(coef) <- j
|
|
}
|
|
|
|
keep <- coef != 0
|
|
if (!any(keep)) {
|
|
return(structure(list(qe = integer(0), te = integer(0), coef = numeric(0)),
|
|
class = "laurent2"))
|
|
}
|
|
structure(list(qe = qe[keep], te = te[keep], coef = coef[keep]),
|
|
class = "laurent2")
|
|
}
|
|
|
|
#' @export
|
|
length.laurent2 <- function(x) length(x$coef)
|
|
|
|
#' @export
|
|
l2_add <- function(a, b) {
|
|
if (length(a$coef) == 0) return(b)
|
|
if (length(b$coef) == 0) return(a)
|
|
r <- l2_add_cpp(a$qe, a$te, a$coef, b$qe, b$te, b$coef)
|
|
structure(r, class = "laurent2")
|
|
}
|
|
l2_mul <- function(a, b) {
|
|
if (length(a$coef) == 0 || length(b$coef) == 0) {
|
|
return(structure(list(qe = integer(0), te = integer(0), coef = numeric(0)), class = "laurent2"))
|
|
}
|
|
r <- l2_mul_cpp(a$qe, a$te, a$coef, b$qe, b$te, b$coef)
|
|
structure(r, class = "laurent2")
|
|
}
|
|
l2_equal <- function(a, b) {
|
|
if (length(a$coef) != length(b$coef)) return(FALSE)
|
|
if (length(a$coef) == 0) return(TRUE)
|
|
identical(a$qe, b$qe) && identical(a$te, b$te) && identical(a$coef, b$coef)
|
|
}
|
|
|
|
#' @export
|
|
l2_str <- function(x) {
|
|
if (length(x$coef) == 0) return("0")
|
|
parts <- character(length(x$coef))
|
|
for (i in seq_along(x$coef)) {
|
|
co <- x$coef[i]; qe <- x$qe[i]; te <- x$te[i]
|
|
if (co == 0) next
|
|
var <- ""
|
|
if (qe != 0) {
|
|
if (qe == 1) var <- paste0(var, "q")
|
|
else if (qe == -1) var <- paste0(var, "q^-1")
|
|
else var <- paste0(var, "q^", qe)
|
|
}
|
|
if (te != 0) {
|
|
if (te == 1) var <- paste0(var, "t")
|
|
else if (te == -1) var <- paste0(var, "t^-1")
|
|
else var <- paste0(var, "t^", te)
|
|
}
|
|
if (var == "") {
|
|
parts[i] <- as.character(co)
|
|
} else if (co == 1) {
|
|
parts[i] <- var
|
|
} else if (co == -1) {
|
|
parts[i] <- paste0("-", var)
|
|
} else {
|
|
parts[i] <- paste0(co, var)
|
|
}
|
|
}
|
|
parts <- parts[parts != ""]
|
|
if (length(parts) == 0) return("0")
|
|
result <- paste(parts, collapse = " + ")
|
|
gsub("\\+ -", "- ", result)
|
|
}
|
|
|
|
# ── Constants ─────────────────────────────────────────────────
|
|
|
|
#' @export
|
|
l2_zero <- laurent2()
|
|
#' @export
|
|
l2_one <- laurent2(c("0,0" = 1))
|
|
#' @export
|
|
l2_q <- laurent2(c("1,0" = 1))
|
|
#' @export
|
|
l2_t <- laurent2(c("0,1" = 1))
|
|
#' @export
|
|
l2_qt <- laurent2(c("1,1" = 1))
|
|
#' @export
|
|
l2_qinv <- laurent2(c("-1,0" = 1))
|
|
#' @export
|
|
l2_tinv <- laurent2(c("0,-1" = 1))
|
|
#' @export
|
|
l2_neg_one <- laurent2(c("0,0" = -1))
|
|
#' @export
|
|
l2_1mq <- laurent2(c("0,0" = 1, "1,0" = -1))
|
|
#' @export
|
|
l2_1mt <- laurent2(c("0,0" = 1, "0,1" = -1))
|
|
|
|
#' @export
|
|
l2_1mq_td <- function(d) {
|
|
r <- c(1, -1)
|
|
names(r) <- c(paste0("0,", d), paste0("1,", d))
|
|
laurent2(r)
|
|
}
|
|
|
|
#' @export
|
|
l2_q_td <- function(d) {
|
|
r <- 1
|
|
names(r) <- paste0("1,", d)
|
|
laurent2(r)
|
|
}
|
|
|
|
#' @export
|
|
l2_1mq_1mtd <- function(d) {
|
|
if (d == 0) return(laurent2())
|
|
r <- c(1, -1, -1, 1)
|
|
names(r) <- c("0,0", "1,0", paste0("0,", d), paste0("1,", d))
|
|
laurent2(r)
|
|
}
|
|
|
|
# ── Matrix utilities ──────────────────────────────────────────
|
|
|
|
#' @export
|
|
l2_mat_zero <- function(n) {
|
|
matrix(rep(list(l2_zero), n * n), nrow = n, ncol = n)
|
|
}
|
|
|
|
#' @export
|
|
l2_mat_identity <- function(n) {
|
|
m <- l2_mat_zero(n)
|
|
for (i in 1:n) m[[i, i]] <- l2_one
|
|
m
|
|
}
|
|
|
|
#' @export
|
|
l2_mat_mul <- function(A, B) {
|
|
n <- nrow(A)
|
|
C <- l2_mat_zero(n)
|
|
for (i in 1:n) {
|
|
for (j in 1:n) {
|
|
s <- l2_zero
|
|
for (k in 1:n) {
|
|
aik <- A[[i, k]]; bkj <- B[[k, j]]
|
|
if (length(aik$coef) > 0 && length(bkj$coef) > 0) {
|
|
s <- l2_add(s, l2_mul(aik, bkj))
|
|
}
|
|
}
|
|
C[[i, j]] <- s
|
|
}
|
|
}
|
|
C
|
|
}
|
|
|
|
#' @export
|
|
l2_mat_equal <- function(A, B) {
|
|
n <- nrow(A)
|
|
for (i in 1:n) for (j in 1:n) {
|
|
if (!l2_equal(A[[i, j]], B[[i, j]])) return(FALSE)
|
|
}
|
|
TRUE
|
|
}
|
|
|
|
# ── Matrix serialization ──────────────────────────────────────
|
|
|
|
#' @export
|
|
serialize_matrix <- function(m) {
|
|
N <- nrow(m)
|
|
entries <- character(0)
|
|
for (i in 1:N) for (j in 1:N) {
|
|
p <- m[[i, j]]
|
|
if (length(p$coef) > 0) {
|
|
parts <- paste0(p$qe, ",", p$te, "=", p$coef, collapse = ";")
|
|
entries <- c(entries, paste0(i, ",", j, ":", parts))
|
|
}
|
|
}
|
|
paste0("N=", N, "\n", paste(entries, collapse = "\n"))
|
|
}
|
|
|
|
#' @export
|
|
deserialize_matrix <- function(s) {
|
|
if (is.null(s) || is.na(s) || s == "") return(NULL)
|
|
lines <- strsplit(s, "\n")[[1]]
|
|
N <- as.integer(sub("N=", "", lines[1]))
|
|
m <- l2_mat_zero(N)
|
|
if (length(lines) < 2) return(m)
|
|
for (line in lines[-1]) {
|
|
if (line == "") next
|
|
colon_pos <- regexpr(":", line)
|
|
idx_str <- substr(line, 1, colon_pos - 1)
|
|
poly_str <- substr(line, colon_pos + 1, nchar(line))
|
|
idx <- as.integer(strsplit(idx_str, ",")[[1]])
|
|
pairs <- strsplit(poly_str, ";")[[1]]
|
|
keys <- character(length(pairs))
|
|
vals <- numeric(length(pairs))
|
|
for (pi in seq_along(pairs)) {
|
|
eq_pos <- regexpr("=", pairs[pi])
|
|
keys[pi] <- substr(pairs[pi], 1, eq_pos - 1)
|
|
vals[pi] <- as.numeric(substr(pairs[pi], eq_pos + 1, nchar(pairs[pi])))
|
|
}
|
|
names(vals) <- keys
|
|
m[[idx[1], idx[2]]] <- laurent2(vals)
|
|
}
|
|
m
|
|
}
|
|
|
|
#' @export
|
|
l2_merge_into <- function(r, b) {
|
|
if (length(b$coef) == 0) return(r)
|
|
l2_add(r, b)
|
|
}
|
|
|
|
#' @export
|
|
l2_finalize <- function(r) {
|
|
r
|
|
}
|