feat: LKB compute pipeline + eigensolid receipts
Containerized LKB worker (Dockerfile.lkb), Postgres-backed queue, auto-deploy timer, and eigensolid convergence check module. Build: 0 jobs (no Lean build needed)
This commit is contained in:
commit
e5bfdc0492
17 changed files with 1582 additions and 0 deletions
6
.gitignore
vendored
Normal file
6
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*.o
|
||||
*.so
|
||||
*.Rcheck/
|
||||
.Rhistory
|
||||
.RData
|
||||
.env
|
||||
28
Dockerfile.lkb
Executable file
28
Dockerfile.lkb
Executable file
|
|
@ -0,0 +1,28 @@
|
|||
FROM rocker/r-ver:4.6.0
|
||||
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends \
|
||||
libpq-dev \
|
||||
&& rm -rf /var/lib/apt/lists/*
|
||||
|
||||
RUN R -e 'install.packages(c("Rcpp", "RPostgres", "DBI"), \
|
||||
repos = "https://cloud.r-project.org", Ncpus = parallel::detectCores())' \
|
||||
&& rm -rf /tmp/downloaded_packages
|
||||
|
||||
WORKDIR /app
|
||||
|
||||
COPY boot.R run.sh ./
|
||||
COPY core/ ./core/
|
||||
COPY src/ ./src/
|
||||
|
||||
# Fix the commented-out Rcpp lines in laurent2.R
|
||||
RUN sed -i 's/^#library(Rcpp)/library(Rcpp)/' core/laurent2.R && \
|
||||
sed -i 's|^#Rcpp::sourceCpp("src/laurent_ops.cpp")|Rcpp::sourceCpp("src/laurent_ops.cpp")|' core/laurent2.R && \
|
||||
Rscript -e "library(Rcpp); Rcpp::sourceCpp('src/laurent_ops.cpp')" > /dev/null
|
||||
|
||||
ENV PGHOST=100.79.14.103 \
|
||||
PGDATABASE=research_stack \
|
||||
PGUSER=kaleidoscope \
|
||||
PGPASSWORD=kaleidoscope \
|
||||
PGPORT=5432
|
||||
|
||||
ENTRYPOINT ["/app/run.sh"]
|
||||
50
auto_deploy.sh
Normal file
50
auto_deploy.sh
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
REGISTRY="100.79.14.103:5000"
|
||||
IMAGE="$REGISTRY/library/lkb-worker"
|
||||
SELF_DIR="$(cd "$(dirname "$0")" && pwd)"
|
||||
HOST=$(uname -n)
|
||||
|
||||
case "$HOST" in
|
||||
*neon*) WORKER_COUNT=12; PLATFORM="arm64" ;;
|
||||
*) WORKER_COUNT=4; PLATFORM="amd64" ;;
|
||||
esac
|
||||
|
||||
TAG="$PLATFORM"
|
||||
|
||||
echo "[auto-deploy] $HOST: checking $IMAGE:$TAG"
|
||||
|
||||
LAST_HASH_FILE="/tmp/lkb-worker-last-hash-$PLATFORM"
|
||||
REMOTE_HASH=$(curl -s --connect-timeout 5 "$REGISTRY/v2/library/lkb-worker/manifests/$TAG" 2>/dev/null \
|
||||
| sha256sum | cut -d' ' -f1)
|
||||
|
||||
if [ -z "$REMOTE_HASH" ]; then
|
||||
echo "[auto-deploy] WARNING: cannot reach registry, skipping pull check"
|
||||
exit 0
|
||||
fi
|
||||
|
||||
if [ -f "$LAST_HASH_FILE" ]; then
|
||||
LOCAL_HASH=$(cat "$LAST_HASH_FILE")
|
||||
if [ "$REMOTE_HASH" = "$LOCAL_HASH" ]; then
|
||||
echo "[auto-deploy] image unchanged, nothing to do"
|
||||
exit 0
|
||||
fi
|
||||
fi
|
||||
|
||||
echo "[auto-deploy] new image detected, pulling..."
|
||||
podman pull --tls-verify=false "$IMAGE:$TAG"
|
||||
|
||||
echo "$REMOTE_HASH" > "$LAST_HASH_FILE"
|
||||
|
||||
RUNNING=$(podman ps --format "{{.Names}}" | grep lkb-worker || true)
|
||||
for name in $RUNNING; do
|
||||
echo "[auto-deploy] restarting $name"
|
||||
podman rm -f "$name"
|
||||
done
|
||||
|
||||
for i in $(seq 1 "$WORKER_COUNT"); do
|
||||
podman run -d --rm --name "lkb-worker-$i" --network host "$IMAGE:$TAG" worker
|
||||
done
|
||||
|
||||
echo "[auto-deploy] $WORKER_COUNT workers restarted from $IMAGE:$TAG (hash: $REMOTE_HASH)"
|
||||
47
boot.R
Normal file
47
boot.R
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
box_use <- function(...) {
|
||||
args <- as.list(sys.call())[-1]
|
||||
caller <- parent.frame()
|
||||
for (arg in args) {
|
||||
arg_str <- deparse(arg)
|
||||
arg_str <- gsub('^"|"$', '', arg_str)
|
||||
arg_str <- gsub("^'|'$", '', arg_str)
|
||||
|
||||
if (startsWith(arg_str, "./") || startsWith(arg_str, "../")) {
|
||||
path <- sub("^\\.\\./", "", arg_str)
|
||||
path <- sub("^\\./", "", path)
|
||||
env <- new.env(parent = caller)
|
||||
candidates <- c(
|
||||
paste0(path, ".R"),
|
||||
paste0("core/", basename(path), ".R"),
|
||||
paste0("../", path, ".R")
|
||||
)
|
||||
found <- FALSE
|
||||
for (f in candidates) {
|
||||
if (file.exists(f)) {
|
||||
sys.source(f, envir = env)
|
||||
found <- TRUE
|
||||
break
|
||||
}
|
||||
}
|
||||
if (!found) stop("Module not found: ", arg_str)
|
||||
assign(basename(path), env, envir = caller)
|
||||
|
||||
} else if (grepl("\\[", arg_str)) {
|
||||
pkgs <- strsplit(arg_str, "\\],\\s*|,\\s*(?=[a-zA-Z])")[[1]]
|
||||
for (pkg_spec in pkgs) {
|
||||
pkg_spec <- trimws(pkg_spec)
|
||||
pkg_name <- sub("\\[.*", "", pkg_spec)
|
||||
library(pkg_name, character.only = TRUE)
|
||||
if (grepl("\\[", pkg_spec)) {
|
||||
exports <- trimws(strsplit(sub(".*\\[(.*)\\]", "\\1", pkg_spec), ",")[[1]])
|
||||
for (ex in exports) {
|
||||
assign(ex, get(ex, envir = asNamespace(pkg_name)), envir = caller)
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
library(arg_str, character.only = TRUE)
|
||||
}
|
||||
}
|
||||
invisible(NULL)
|
||||
}
|
||||
243
core/b4.R
Normal file
243
core/b4.R
Normal file
|
|
@ -0,0 +1,243 @@
|
|||
source("boot.R")
|
||||
# ── Laurent polynomials in Z[t, t^{-1}] (numeric coefficients) ──
|
||||
|
||||
#' @export
|
||||
laurent <- function(terms = NULL) {
|
||||
if (is.null(terms)) return(structure(integer(0), class = "laurent"))
|
||||
terms <- terms[terms != 0]
|
||||
if (length(terms) == 0) return(structure(integer(0), class = "laurent"))
|
||||
structure(terms, class = "laurent")
|
||||
}
|
||||
|
||||
#' @export
|
||||
laurent_add <- function(a, b) {
|
||||
if (length(a) == 0) return(b)
|
||||
if (length(b) == 0) return(a)
|
||||
e <- union(names(a), names(b))
|
||||
r <- numeric(length(e)); names(r) <- e
|
||||
for (x in names(a)) r[[x]] <- r[[x]] + a[[x]]
|
||||
for (x in names(b)) r[[x]] <- r[[x]] + b[[x]]
|
||||
r <- r[r != 0]
|
||||
if (length(r) == 0) return(laurent())
|
||||
laurent(r)
|
||||
}
|
||||
|
||||
#' @export
|
||||
laurent_sub <- function(a, b = NULL) {
|
||||
if (is.null(a) && is.null(b)) return(laurent())
|
||||
if (is.null(b)) { r <- -unclass(a); class(r) <- "laurent"; return(r) }
|
||||
if (length(a) == 0) { r <- -unclass(b); class(r) <- "laurent"; return(r) }
|
||||
if (length(b) == 0) return(a)
|
||||
e <- union(names(a), names(b))
|
||||
r <- numeric(length(e)); names(r) <- e
|
||||
for (x in names(a)) r[[x]] <- r[[x]] + a[[x]]
|
||||
for (x in names(b)) r[[x]] <- r[[x]] - b[[x]]
|
||||
r <- r[r != 0]
|
||||
if (length(r) == 0) return(laurent())
|
||||
laurent(r)
|
||||
}
|
||||
|
||||
#' @export
|
||||
laurent_mul <- function(a, b) {
|
||||
if (length(a) == 0 || length(b) == 0) return(laurent())
|
||||
r <- numeric(0)
|
||||
for (x in names(a)) for (y in names(b)) {
|
||||
e <- as.integer(x) + as.integer(y)
|
||||
en <- as.character(e)
|
||||
r[[en]] <- (if (en %in% names(r)) r[[en]] else 0) + a[[x]] * b[[y]]
|
||||
}
|
||||
r <- r[r != 0]
|
||||
if (length(r) == 0) return(laurent())
|
||||
laurent(r)
|
||||
}
|
||||
|
||||
#' @export
|
||||
laurent_equal <- function(a, b) {
|
||||
if (length(a) != length(b)) return(FALSE)
|
||||
if (length(a) == 0) return(TRUE)
|
||||
a <- a[order(as.integer(names(a)))]
|
||||
b <- b[order(as.integer(names(b)))]
|
||||
identical(a, b)
|
||||
}
|
||||
|
||||
#' @export
|
||||
t <- laurent(c("1" = 1))
|
||||
|
||||
#' @export
|
||||
neg_t <- laurent(c("1" = -1))
|
||||
|
||||
#' @export
|
||||
one <- laurent(c("0" = 1))
|
||||
|
||||
#' @export
|
||||
zero <- laurent(c())
|
||||
|
||||
#' @export
|
||||
one_minus_t <- laurent_add(one, laurent_sub(NULL, t))
|
||||
|
||||
# ── Braid words ───────────────────────────────────────────────
|
||||
|
||||
#' @export
|
||||
braid_word <- function(word = integer(0)) structure(word, class = "braid_word")
|
||||
|
||||
#' @export
|
||||
braid_concat <- function(a, b) braid_word(c(unclass(a), unclass(b)))
|
||||
|
||||
#' @export
|
||||
braid_inverse <- function(x) braid_word(rev(-unclass(x)))
|
||||
|
||||
#' @export
|
||||
braid_reduce <- function(w) {
|
||||
w <- unclass(w)
|
||||
stack <- integer(0)
|
||||
for (s in w) {
|
||||
if (length(stack) > 0 && stack[length(stack)] == -s) {
|
||||
stack <- stack[-length(stack)]
|
||||
} else {
|
||||
stack <- c(stack, s)
|
||||
}
|
||||
}
|
||||
braid_word(stack)
|
||||
}
|
||||
|
||||
#' @export
|
||||
sigma <- function(i, positive = TRUE) {
|
||||
if (i < 1 || i > 3) stop("B4 has generators 1,2,3 only")
|
||||
braid_word(if (positive) i else -i)
|
||||
}
|
||||
|
||||
# ── Burau representation ──────────────────────────────────────
|
||||
|
||||
#' @export
|
||||
is_identity_matrix <- function(m) {
|
||||
for (r in 1:4) for (c in 1:4) {
|
||||
e <- if (r == c) one else zero
|
||||
if (!laurent_equal(m[[r, c]], e)) return(FALSE)
|
||||
}
|
||||
TRUE
|
||||
}
|
||||
|
||||
burau_sigma <- function(i) {
|
||||
m <- matrix(rep(list(zero), 16), nrow = 4, ncol = 4)
|
||||
for (k in 1:4) m[[k, k]] <- one
|
||||
if (i == 1) {
|
||||
m[[1, 1]] <- one_minus_t; m[[1, 2]] <- t; m[[2, 1]] <- one; m[[2, 2]] <- zero
|
||||
} else if (i == 2) {
|
||||
m[[2, 2]] <- one_minus_t; m[[2, 3]] <- t; m[[3, 2]] <- one; m[[3, 3]] <- zero
|
||||
} else if (i == 3) {
|
||||
m[[3, 3]] <- one_minus_t; m[[3, 4]] <- t; m[[4, 3]] <- one; m[[4, 4]] <- zero
|
||||
}
|
||||
m
|
||||
}
|
||||
|
||||
burau_inverse <- function(i) {
|
||||
m <- matrix(rep(list(zero), 16), nrow = 4, ncol = 4)
|
||||
for (k in 1:4) m[[k, k]] <- one
|
||||
ti <- laurent(c("-1" = 1))
|
||||
one_minus_ti <- laurent_add(one, laurent_sub(NULL, ti))
|
||||
if (i == 1) {
|
||||
m[[1, 1]] <- zero; m[[1, 2]] <- one; m[[2, 1]] <- ti; m[[2, 2]] <- one_minus_ti
|
||||
} else if (i == 2) {
|
||||
m[[2, 2]] <- zero; m[[2, 3]] <- one; m[[3, 2]] <- ti; m[[3, 3]] <- one_minus_ti
|
||||
} else if (i == 3) {
|
||||
m[[3, 3]] <- zero; m[[3, 4]] <- one; m[[4, 3]] <- ti; m[[4, 4]] <- one_minus_ti
|
||||
}
|
||||
m
|
||||
}
|
||||
|
||||
#' @export
|
||||
mat_mul <- function(A, B) {
|
||||
C <- matrix(rep(list(zero), 16), nrow = 4, ncol = 4)
|
||||
for (i in 1:4) for (j in 1:4) {
|
||||
s <- zero
|
||||
for (k in 1:4) {
|
||||
if (length(A[[i, k]]) > 0 && length(B[[k, j]]) > 0) {
|
||||
s <- laurent_add(s, laurent_mul(A[[i, k]], B[[k, j]]))
|
||||
}
|
||||
}
|
||||
C[[i, j]] <- s
|
||||
}
|
||||
C
|
||||
}
|
||||
|
||||
#' @export
|
||||
burau_matrix <- function(w) {
|
||||
w <- unclass(w)
|
||||
r <- matrix(rep(list(zero), 16), nrow = 4, ncol = 4)
|
||||
for (k in 1:4) r[[k, k]] <- one
|
||||
for (s in w) {
|
||||
g <- abs(s)
|
||||
r <- mat_mul(r, if (s > 0) burau_sigma(g) else burau_inverse(g))
|
||||
}
|
||||
r
|
||||
}
|
||||
|
||||
#' @export
|
||||
burau_matrix_stepwise <- function(w) {
|
||||
w <- unclass(w)
|
||||
r <- matrix(rep(list(zero), 16), nrow = 4, ncol = 4)
|
||||
for (k in 1:4) r[[k, k]] <- one
|
||||
monomials <- list()
|
||||
for (s in w) {
|
||||
g <- abs(s)
|
||||
before <- r[[1, 3]]
|
||||
r <- mat_mul(r, if (s > 0) burau_sigma(g) else burau_inverse(g))
|
||||
after <- r[[1, 3]]
|
||||
for (e in unique(c(names(before), names(after)))) {
|
||||
cb <- if (e %in% names(before)) before[[e]] else 0
|
||||
ca <- if (e %in% names(after)) after[[e]] else 0
|
||||
d <- ca - cb
|
||||
if (d == 0) next
|
||||
d_int <- abs(d)
|
||||
sgn <- if (d > 0) 1L else -1L
|
||||
for (n in seq_len(d_int)) {
|
||||
monomials <- c(monomials, list(list(epsilon = sgn, exponent = as.integer(e))))
|
||||
}
|
||||
}
|
||||
}
|
||||
list(matrix = r, monomials = monomials)
|
||||
}
|
||||
|
||||
# ── Display ───────────────────────────────────────────────────
|
||||
|
||||
#' @export
|
||||
laurent_str <- function(x) {
|
||||
if (length(x) == 0) return("0")
|
||||
nms <- names(x)
|
||||
if (is.null(nms) || any(is.na(nms))) return("0")
|
||||
exps <- as.integer(nms)
|
||||
parts <- character(length(x))
|
||||
for (i in seq_along(x)) {
|
||||
co <- x[i]
|
||||
if (is.na(co) || co == 0) next
|
||||
e <- exps[i]
|
||||
if (is.na(e)) next
|
||||
if (e == 0) {
|
||||
parts[i] <- as.character(co)
|
||||
} else if (e == 1) {
|
||||
if (co == 1) parts[i] <- "t"
|
||||
else if (co == -1) parts[i] <- "-t"
|
||||
else parts[i] <- paste0(co, "t")
|
||||
} else {
|
||||
if (co == 1) parts[i] <- paste0("t^", e)
|
||||
else if (co == -1) parts[i] <- paste0("-t^", e)
|
||||
else parts[i] <- paste0(co, "t^", e)
|
||||
}
|
||||
}
|
||||
parts <- parts[parts != "" & !is.na(parts)]
|
||||
if (length(parts) == 0) return("0")
|
||||
result <- paste(parts, collapse = " + ")
|
||||
gsub("\\+ -", "- ", result)
|
||||
}
|
||||
|
||||
#' @export
|
||||
braid_str <- function(x) {
|
||||
if (length(x) == 0) return("1")
|
||||
s <- "\u03C3"
|
||||
parts <- sapply(x, function(v) {
|
||||
g <- abs(v)
|
||||
i <- if (v < 0) "\u207B\u00B9" else ""
|
||||
paste0(s, g, i)
|
||||
})
|
||||
paste(parts, collapse = " \u00B7 ")
|
||||
}
|
||||
25
core/b4xb4.R
Normal file
25
core/b4xb4.R
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
source("boot.R")
|
||||
box_use(./b4)
|
||||
box_use(../math/sidon)
|
||||
|
||||
#' @export
|
||||
split_sidon_8 <- function(S) {
|
||||
if (length(S) != 8) stop("Sidon 8-set must have exactly 8 elements")
|
||||
S <- sort(S)
|
||||
list(left = S[c(1, 3, 5, 7)], right = S[c(2, 4, 6, 8)])
|
||||
}
|
||||
|
||||
#' @export
|
||||
block_diag_8x8 <- function(left_block, right_block) {
|
||||
result <- matrix(rep(list(b4$zero), 64), nrow = 8, ncol = 8)
|
||||
for (i in 1:4) for (j in 1:4) {
|
||||
result[[i, j]] <- left_block[[i, j]]
|
||||
result[[i + 4, j + 4]] <- right_block[[i, j]]
|
||||
}
|
||||
result
|
||||
}
|
||||
|
||||
#' @export
|
||||
b4xb4_matrix <- function(word_left, word_right) {
|
||||
block_diag_8x8(b4$burau_matrix(word_left), b4$burau_matrix(word_right))
|
||||
}
|
||||
149
core/eigensolid.R
Normal file
149
core/eigensolid.R
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
source("boot.R")
|
||||
box_use(./laurent2)
|
||||
box_use(./lkb)
|
||||
|
||||
CROSSING_PAIRS <- list(c(0,1), c(2,3), c(4,5), c(6,7))
|
||||
|
||||
cross_step <- function(strands, gens, gens_inv) {
|
||||
n <- length(strands)
|
||||
if (n != 8) stop("eigensolid: only B8 (8 strands) supported, got B", n)
|
||||
new_strands <- vector("list", n)
|
||||
for (pair in CROSSING_PAIRS) {
|
||||
i <- pair[[1]] + 1L
|
||||
j <- pair[[2]] + 1L
|
||||
si <- strands[[i]]
|
||||
sj <- strands[[j]]
|
||||
m <- laurent2$l2_mat_mul(si, sj)
|
||||
new_strands[[i]] <- m
|
||||
new_strands[[j]] <- laurent2$l2_mat_identity(1)
|
||||
}
|
||||
new_strands
|
||||
}
|
||||
|
||||
extract_crossing_matrix <- function(strands) {
|
||||
m <- matrix(0L, nrow = 8, ncol = 8)
|
||||
for (i in seq_along(strands)) {
|
||||
for (j in seq_along(strands)) {
|
||||
if (i == j) next
|
||||
m[i, j] <- laurent2$l2_equal(strands[[i]], strands[[j]])
|
||||
}
|
||||
}
|
||||
m
|
||||
}
|
||||
|
||||
residual_from_strand <- function(strand_mat) {
|
||||
entry <- laurent2$l2_str(strand_mat[[1, 3]])
|
||||
nterms <- length(strand_mat$coef)
|
||||
q16_16_resid <- min(nterms, 65535L)
|
||||
q16_16_resid
|
||||
}
|
||||
|
||||
eigensolid_converged <- function(strands, step) {
|
||||
if (step == 0) return(FALSE)
|
||||
paired <- crossStep(strands)
|
||||
old_m <- extract_crossing_matrix(strands)
|
||||
new_m <- extract_crossing_matrix(paired)
|
||||
identical(old_m, new_m)
|
||||
}
|
||||
|
||||
run_eigensolid <- function(con, max_jobs = Inf) {
|
||||
cat(sprintf("\n=== Eigensolid convergence check ===\n"))
|
||||
|
||||
done <- DBI::dbGetQuery(con, "
|
||||
SELECT equation_id, result_entry
|
||||
FROM lkb.compute_queue
|
||||
WHERE status = 'done' AND result_entry IS NOT NULL
|
||||
")
|
||||
cat(sprintf(" %d completed LKB entries to process\n", nrow(done)))
|
||||
|
||||
processed <- 0L
|
||||
for (i in seq_len(nrow(done))) {
|
||||
if (processed >= max_jobs) break
|
||||
|
||||
eq_id <- done$equation_id[[i]]
|
||||
entry_str <- done$result_entry[[i]]
|
||||
|
||||
already <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS n FROM lkb.eigensolid_receipts WHERE equation_id = $1",
|
||||
params = list(eq_id))$n[[1]]
|
||||
if (already > 0) {
|
||||
next
|
||||
}
|
||||
|
||||
if (entry_str == "0" || entry_str == "" || is.na(entry_str)) {
|
||||
crossing_m <- matrix(0L, 8, 8)
|
||||
sidon_slack <- 128L
|
||||
step_count <- 0L
|
||||
residuals <- list(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)
|
||||
scar_absent <- TRUE
|
||||
} else {
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"SELECT sidon_set, braid_word, steps_done FROM lkb.compute_queue WHERE equation_id = $1",
|
||||
params = list(eq_id))
|
||||
sidon_set <- as.integer(strsplit(row$sidon_set[[1]], ",")[[1]])
|
||||
steps_done <- row$steps_done[[1]]
|
||||
n <- row$steps_done[[1]]
|
||||
|
||||
gens <- lkb$lkb_generators(8)
|
||||
gens_inv <- lkb$lkb_generators_inverse(8)
|
||||
N <- 28L
|
||||
I_mat <- laurent2$l2_mat_identity(N)
|
||||
|
||||
word_str <- row$braid_word[[1]]
|
||||
if (word_str == "ID" || is.na(word_str) || word_str == "") {
|
||||
step_count <- 0L
|
||||
strands <- replicate(8, I_mat, simplify = FALSE)
|
||||
} else {
|
||||
steps <- as.integer(strsplit(word_str, ",")[[1]])
|
||||
mat <- I_mat
|
||||
for (g in steps[seq_len(min(steps_done, length(steps)))]) {
|
||||
if (g > 0) mat <- laurent2$l2_mat_mul(mat, gens[[g]])
|
||||
else mat <- laurent2$l2_mat_mul(mat, gens_inv[[-g]])
|
||||
}
|
||||
step_count <- steps_done
|
||||
strands <- replicate(8, mat, simplify = FALSE)
|
||||
}
|
||||
|
||||
crossing_m <- extract_crossing_matrix(strands)
|
||||
sidon_slack <- if (length(sidon_set) > 0) 128L - max(sidon_set, na.rm = TRUE) else 0L
|
||||
residuals <- lapply(strands, function(s) residual_from_strand(s))
|
||||
scar_absent <- TRUE
|
||||
|
||||
cat(sprintf(" [%s] step %d, slack %d\n", eq_id, step_count, sidon_slack))
|
||||
}
|
||||
|
||||
crossing_json <- jsonlite::toJSON(crossing_m, auto_unbox = TRUE)
|
||||
residuals_json <- jsonlite::toJSON(unlist(residuals), auto_unbox = TRUE)
|
||||
|
||||
DBI::dbExecute(con,
|
||||
"INSERT INTO lkb.eigensolid_receipts
|
||||
(equation_id, crossing_matrix, sidon_slack, step_count, residuals, scar_absent)
|
||||
VALUES ($1, $2::JSONB, $3, $4, $5::JSONB, $6)
|
||||
ON CONFLICT (equation_id) DO UPDATE SET
|
||||
crossing_matrix = EXCLUDED.crossing_matrix,
|
||||
sidon_slack = EXCLUDED.sidon_slack,
|
||||
step_count = EXCLUDED.step_count,
|
||||
residuals = EXCLUDED.residuals,
|
||||
scar_absent = EXCLUDED.scar_absent",
|
||||
params = list(eq_id, crossing_json, sidon_slack, step_count, residuals_json, scar_absent))
|
||||
|
||||
processed <- processed + 1L
|
||||
if (processed %% 10 == 0) {
|
||||
cat(sprintf(" ... %d receipts generated\n", processed))
|
||||
}
|
||||
}
|
||||
|
||||
total <- DBI::dbGetQuery(con, "SELECT COUNT(*) AS n FROM lkb.eigensolid_receipts")$n[[1]]
|
||||
cat(sprintf(" Done: %d/%d receipts generated (total: %d)\n", processed, nrow(done), total))
|
||||
invisible(processed)
|
||||
}
|
||||
|
||||
if (interactive() && requireNamespace("DBI", quietly = TRUE) && requireNamespace("RPostgres", quietly = TRUE)) {
|
||||
con <- DBI::dbConnect(RPostgres::Postgres(),
|
||||
host = Sys.getenv("PGHOST", "100.79.14.103"),
|
||||
dbname = "research_stack",
|
||||
user = Sys.getenv("PGUSER", "kaleidoscope"),
|
||||
password = Sys.getenv("PGPASSWORD", "kaleidoscope"))
|
||||
on.exit(DBI::dbDisconnect(con))
|
||||
run_eigensolid(con, max_jobs = Inf)
|
||||
}
|
||||
248
core/laurent2.R
Normal file
248
core/laurent2.R
Normal file
|
|
@ -0,0 +1,248 @@
|
|||
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
|
||||
}
|
||||
159
core/lkb.R
Normal file
159
core/lkb.R
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
source("boot.R")
|
||||
box_use(./laurent2)
|
||||
|
||||
pair_idx <- function(a, b, pairs) {
|
||||
if (a > b) { tmp <- a; a <- b; b <- tmp }
|
||||
for (i in seq_along(pairs)) {
|
||||
if (pairs[[i]][1] == a && pairs[[i]][2] == b) return(i)
|
||||
}
|
||||
stop(sprintf("Pair (%d,%d) not found", a, b))
|
||||
}
|
||||
|
||||
pairs_list <- function(n) {
|
||||
result <- list()
|
||||
for (j in 0:(n-2)) for (k in (j+1):(n-1)) result[[length(result) + 1]] <- c(j, k)
|
||||
result
|
||||
}
|
||||
|
||||
lkb_generator_matrix <- function(k, n = 8, positive = TRUE) {
|
||||
pairs <- pairs_list(n)
|
||||
N <- length(pairs)
|
||||
m <- laurent2$l2_mat_zero(N)
|
||||
k0 <- k - 1L
|
||||
q <- laurent2$l2_q
|
||||
q2 <- laurent2$l2_mul(q, q)
|
||||
qm1 <- laurent2$l2_qinv
|
||||
qm2 <- laurent2$l2_mul(qm1, qm1)
|
||||
t <- laurent2$l2_t
|
||||
one <- laurent2$l2_one
|
||||
zero <- laurent2$l2_zero
|
||||
qsq_minus_q <- laurent2$laurent2(c("2,0" = 1, "1,0" = -1))
|
||||
one_minus_q <- laurent2$laurent2(c("0,0" = 1, "1,0" = -1))
|
||||
one_minus_qinv <- laurent2$laurent2(c("0,0" = 1, "-1,0" = -1))
|
||||
qm1_minus_qm2 <- laurent2$laurent2(c("-2,0" = 1, "-1,0" = -1))
|
||||
tqm1_minus_tqm2 <- laurent2$laurent2(c("-1,-1" = 1, "-2,-1" = -1))
|
||||
neg_q2_t <- laurent2$laurent2(c("2,1" = -1))
|
||||
neg_tinv_qinv2 <- laurent2$laurent2(c("-2,-1" = -1))
|
||||
neg_t_q2 <- laurent2$laurent2(c("2,1" = -1))
|
||||
|
||||
for (idx in seq_len(N)) {
|
||||
j <- pairs[[idx]][1]
|
||||
kk <- pairs[[idx]][2]
|
||||
|
||||
if (positive) {
|
||||
if (k0 == j - 1) {
|
||||
m[[pair_idx(k0, kk, pairs), idx]] <- q
|
||||
m[[pair_idx(k0, j, pairs), idx]] <- qsq_minus_q
|
||||
m[[pair_idx(j, kk, pairs), idx]] <- one_minus_q
|
||||
} else if (k0 == j && j != kk - 1) {
|
||||
m[[pair_idx(j + 1L, kk, pairs), idx]] <- one
|
||||
m[[idx, idx]] <- zero
|
||||
} else if (kk - 1 == k0 && kk - 1 != j) {
|
||||
m[[pair_idx(j, k0, pairs), idx]] <- q
|
||||
m[[pair_idx(j, kk, pairs), idx]] <- one_minus_q
|
||||
m[[pair_idx(k0, kk, pairs), idx]] <- laurent2$l2_mul(one_minus_q, laurent2$l2_mul(q, t))
|
||||
} else if (k0 == kk) {
|
||||
m[[pair_idx(j, kk + 1L, pairs), idx]] <- one
|
||||
m[[idx, idx]] <- zero
|
||||
} else if (k0 == j && j == kk - 1) {
|
||||
# Sage: A[idx, m] = -t*q*q = -q^2*t
|
||||
m[[idx, idx]] <- neg_q2_t
|
||||
} else {
|
||||
m[[idx, idx]] <- one
|
||||
}
|
||||
} else {
|
||||
if (k0 == j - 1) {
|
||||
m[[pair_idx(j - 1L, kk, pairs), idx]] <- one
|
||||
} else if (k0 == j && j != kk - 1) {
|
||||
m[[pair_idx(j + 1L, kk, pairs), idx]] <- qm1
|
||||
m[[pair_idx(j, kk, pairs), idx]] <- one_minus_qinv
|
||||
m[[pair_idx(j, j + 1L, pairs), idx]] <- tqm1_minus_tqm2
|
||||
} else if (kk - 1 == k0 && kk - 1 != j) {
|
||||
m[[pair_idx(j, kk - 1L, pairs), idx]] <- one
|
||||
} else if (k0 == kk) {
|
||||
m[[pair_idx(j, kk + 1L, pairs), idx]] <- qm1
|
||||
m[[pair_idx(j, kk, pairs), idx]] <- one_minus_qinv
|
||||
m[[pair_idx(kk, kk + 1L, pairs), idx]] <- qm1_minus_qm2
|
||||
} else if (k0 == j && j == kk - 1) {
|
||||
# Sage: A[idx, m] = -t^{-1}*q^{-2}
|
||||
m[[idx, idx]] <- neg_tinv_qinv2
|
||||
} else {
|
||||
m[[idx, idx]] <- one
|
||||
}
|
||||
}
|
||||
}
|
||||
m
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_pair_to_idx <- function(i, j, n) {
|
||||
if (i > j) { tmp <- i; i <- j; j <- tmp }
|
||||
as.integer((i - 1) * (2 * n - i) / 2 + (j - i))
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_idx_to_pair <- function(idx, n) {
|
||||
i <- 1
|
||||
while (idx > (n - i)) { idx <- idx - (n - i); i <- i + 1 }
|
||||
c(i, i + idx)
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_generator <- function(k, n = 8) {
|
||||
lkb_generator_matrix(k, n, TRUE)
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_generator_inverse <- function(k, n = 8) {
|
||||
lkb_generator_matrix(k, n, FALSE)
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_generators <- function(n = 8) {
|
||||
lapply(1:(n - 1), function(k) lkb_generator_matrix(k, n, TRUE))
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_generators_inverse <- function(n = 8) {
|
||||
lapply(1:(n - 1), function(k) lkb_generator_matrix(k, n, FALSE))
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_matrix <- function(word, n = 8, gens = NULL, gens_inv = NULL) {
|
||||
if (is.null(gens)) gens <- lkb_generators(n)
|
||||
if (is.null(gens_inv)) gens_inv <- lkb_generators_inverse(n)
|
||||
N <- n * (n - 1) / 2
|
||||
result <- laurent2$l2_mat_identity(N)
|
||||
for (s in unclass(word)) {
|
||||
g <- abs(s)
|
||||
if (g < 1 || g > n - 1) stop(sprintf("Invalid generator %d for B%d", g, n))
|
||||
if (s > 0) {
|
||||
result <- laurent2$l2_mat_mul(result, gens[[g]])
|
||||
} else {
|
||||
result <- laurent2$l2_mat_mul(result, gens_inv[[g]])
|
||||
}
|
||||
}
|
||||
result
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_basis_label <- function(idx, n) {
|
||||
p <- lkb_idx_to_pair(idx, n)
|
||||
paste0("e_{", p[1], ",", p[2], "}")
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_matrix_str <- function(m, n = 8, threshold = 8) {
|
||||
N <- nrow(m)
|
||||
lines <- character(0)
|
||||
for (i in 1:min(N, threshold)) {
|
||||
row_parts <- character(min(N, threshold))
|
||||
for (j in 1:min(N, threshold)) {
|
||||
s <- laurent2$l2_str(m[[i, j]])
|
||||
row_parts[j] <- if (nchar(s) > 12) paste0(substr(s, 1, 10), "..") else s
|
||||
}
|
||||
lines <- c(lines, paste0(lkb_basis_label(i, n), ": ", paste(row_parts, collapse = " | ")))
|
||||
}
|
||||
if (N > threshold) lines <- c(lines, paste0("... (", N, "x", N, " matrix)"))
|
||||
paste(lines, collapse = "\n")
|
||||
}
|
||||
280
core/lkb_store.R
Normal file
280
core/lkb_store.R
Normal file
|
|
@ -0,0 +1,280 @@
|
|||
source("boot.R")
|
||||
box_use(./lkb)
|
||||
box_use(./laurent2)
|
||||
|
||||
CHUNK_SIZE <- 5L
|
||||
CHECKPOINT_INTERVAL <- 20L
|
||||
STUCK_TIMEOUT_MINUTES <- 60L
|
||||
|
||||
chunk_cache_mem <- new.env(parent = emptyenv(), size = 5000L)
|
||||
|
||||
#' @export
|
||||
chunk_key <- function(gens_seq) {
|
||||
paste(gens_seq, collapse = ".")
|
||||
}
|
||||
|
||||
#' @export
|
||||
seed_generators <- function(con, n) {
|
||||
expected <- n - 1L
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS cnt FROM lkb.generators WHERE n = ?",
|
||||
params = list(n))
|
||||
if (row$cnt[[1]] == expected) {
|
||||
cat(sprintf(" Generators for B%d already cached (%d matrices)\n", n, expected))
|
||||
return(invisible(NULL))
|
||||
}
|
||||
|
||||
lock_key <- as.integer(bitwXor(n, 0x4C4B47L))
|
||||
DBI::dbExecute(con, "SELECT pg_advisory_lock(?)", params = list(lock_key))
|
||||
tryCatch({
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS cnt FROM lkb.generators WHERE n = ?",
|
||||
params = list(n))
|
||||
if (row$cnt[[1]] == expected) {
|
||||
cat(sprintf(" Generators for B%d already seeded by another worker\n", n))
|
||||
return(invisible(NULL))
|
||||
}
|
||||
|
||||
cat(sprintf(" Seeding generator matrices for B%d...\n", n))
|
||||
DBI::dbExecute(con, "DELETE FROM lkb.generators WHERE n = ?", params = list(n))
|
||||
gens <- lkb$lkb_generators(n)
|
||||
for (g_idx in seq_along(gens)) {
|
||||
blob <- laurent2$serialize_matrix(gens[[g_idx]])
|
||||
DBI::dbExecute(con,
|
||||
"INSERT INTO lkb.generators (n, gen_idx, matrix_data) VALUES (?, ?, ?) ON CONFLICT (n, gen_idx) DO UPDATE SET matrix_data = EXCLUDED.matrix_data",
|
||||
params = list(n, g_idx, blob))
|
||||
}
|
||||
cat(sprintf(" Seeded %d generator matrices\n", length(gens)))
|
||||
}, finally = {
|
||||
DBI::dbExecute(con, "SELECT pg_advisory_unlock(?)", params = list(lock_key))
|
||||
})
|
||||
}
|
||||
|
||||
#' @export
|
||||
load_generators <- function(con, n) {
|
||||
rows <- DBI::dbGetQuery(con,
|
||||
"SELECT gen_idx, matrix_data FROM lkb.generators WHERE n = ? ORDER BY gen_idx",
|
||||
params = list(n))
|
||||
gens <- list()
|
||||
for (r in seq_len(nrow(rows))) {
|
||||
gens[[rows$gen_idx[[r]]]] <- laurent2$deserialize_matrix(rows$matrix_data[[r]])
|
||||
}
|
||||
gens
|
||||
}
|
||||
|
||||
#' @export
|
||||
save_checkpoint <- function(con, eq_id, step, mat) {
|
||||
blob <- laurent2$serialize_matrix(mat)
|
||||
DBI::dbExecute(con,
|
||||
"INSERT INTO lkb.checkpoint (equation_id, step, matrix_data) VALUES (?, ?, ?) ON CONFLICT (equation_id, step) DO UPDATE SET matrix_data = EXCLUDED.matrix_data",
|
||||
params = list(eq_id, step, blob))
|
||||
DBI::dbExecute(con,
|
||||
"UPDATE lkb.compute_queue SET steps_done = ? WHERE equation_id = ?",
|
||||
params = list(step, eq_id))
|
||||
}
|
||||
|
||||
#' @export
|
||||
load_checkpoint <- function(con, eq_id, step) {
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"SELECT matrix_data FROM lkb.checkpoint WHERE equation_id = ? AND step = ?",
|
||||
params = list(eq_id, step))
|
||||
if (nrow(row) == 0) return(NULL)
|
||||
laurent2$deserialize_matrix(row$matrix_data[[1]])
|
||||
}
|
||||
|
||||
#' @export
|
||||
chunk_product <- function(con, gens, chunk, n) {
|
||||
key <- chunk_key(chunk)
|
||||
|
||||
cached <- chunk_cache_mem[[key]]
|
||||
if (!is.null(cached)) return(cached)
|
||||
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"SELECT matrix_data FROM lkb.subseq_cache WHERE n = ? AND seq_key = ?",
|
||||
params = list(n, key))
|
||||
if (nrow(row) > 0) {
|
||||
mat <- laurent2$deserialize_matrix(row$matrix_data[[1]])
|
||||
chunk_cache_mem[[key]] <<- mat
|
||||
tryCatch(
|
||||
DBI::dbExecute(con,
|
||||
"UPDATE lkb.subseq_cache SET hit_count = hit_count + 1 WHERE n = ? AND seq_key = ?",
|
||||
params = list(n, key)),
|
||||
error = function(e) NULL
|
||||
)
|
||||
return(mat)
|
||||
}
|
||||
|
||||
N <- n * (n - 1) / 2
|
||||
mat <- laurent2$l2_mat_identity(N)
|
||||
for (g in chunk) {
|
||||
mat <- laurent2$l2_mat_mul(mat, gens[[g]])
|
||||
}
|
||||
|
||||
chunk_cache_mem[[key]] <<- mat
|
||||
blob <- laurent2$serialize_matrix(mat)
|
||||
DBI::dbExecute(con,
|
||||
"INSERT INTO lkb.subseq_cache (seq_key, n, matrix_data) VALUES (?, ?, ?) ON CONFLICT (n, seq_key) DO NOTHING",
|
||||
params = list(key, n, blob))
|
||||
|
||||
mat
|
||||
}
|
||||
|
||||
#' @export
|
||||
chunk_cache_stats <- function() {
|
||||
list(memory_entries = length(ls(chunk_cache_mem)))
|
||||
}
|
||||
|
||||
#' @export
|
||||
chunk_cache_clear <- function() {
|
||||
rm(list = ls(chunk_cache_mem), envir = chunk_cache_mem)
|
||||
}
|
||||
|
||||
#' @export
|
||||
enqueue <- function(con, equation_id, sidon_set, braid_word, n) {
|
||||
word_str <- paste(unclass(braid_word), collapse = ",")
|
||||
if (word_str == "") word_str <- "ID"
|
||||
DBI::dbExecute(con,
|
||||
"INSERT INTO lkb.compute_queue (equation_id, sidon_set, braid_word, n, word_length) VALUES (?, ?, ?, ?, ?) ON CONFLICT (equation_id) DO UPDATE SET status = 'pending', steps_done = 0, result_entry = NULL, started_at = NULL, finished_at = NULL",
|
||||
params = list(equation_id, paste(sidon_set, collapse = ","), word_str, n, length(unclass(braid_word))))
|
||||
}
|
||||
|
||||
#' @export
|
||||
claim_next <- function(con) {
|
||||
row <- DBI::dbGetQuery(con,
|
||||
"UPDATE lkb.compute_queue SET status = 'running', started_at = now() WHERE equation_id = (SELECT equation_id FROM lkb.compute_queue WHERE status = 'pending' ORDER BY word_length, equation_id LIMIT 1 FOR UPDATE SKIP LOCKED) RETURNING *")
|
||||
if (nrow(row) == 0) return(NULL)
|
||||
row
|
||||
}
|
||||
|
||||
#' @export
|
||||
reap_stuck_jobs <- function(con) {
|
||||
DBI::dbExecute(con,
|
||||
sprintf("UPDATE lkb.compute_queue SET status = 'pending', steps_done = 0, started_at = NULL WHERE status = 'running' AND started_at < now() - interval '%d minutes'", STUCK_TIMEOUT_MINUTES))
|
||||
}
|
||||
|
||||
#' @export
|
||||
mark_done <- function(con, eq_id, result_entry) {
|
||||
DBI::dbExecute(con,
|
||||
"UPDATE lkb.compute_queue SET status = 'done', result_entry = ?, finished_at = now() WHERE equation_id = ?",
|
||||
params = list(result_entry, eq_id))
|
||||
}
|
||||
|
||||
#' @export
|
||||
mark_error <- function(con, eq_id, msg = "") {
|
||||
DBI::dbExecute(con,
|
||||
"UPDATE lkb.compute_queue SET status = 'error', result_entry = ?, finished_at = now() WHERE equation_id = ?",
|
||||
params = list(msg, eq_id))
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_compute <- function(con) {
|
||||
reap_stuck_jobs(con)
|
||||
job <- claim_next(con)
|
||||
if (is.null(job)) return(invisible(NULL))
|
||||
eq_id <- job$equation_id[[1]]
|
||||
n <- job$n[[1]]
|
||||
N <- n * (n - 1) / 2
|
||||
|
||||
seed_generators(con, n)
|
||||
gens <- load_generators(con, n)
|
||||
|
||||
word_str <- job$braid_word[[1]]
|
||||
|
||||
if (word_str == "ID" || word_str == "") {
|
||||
I_mat <- laurent2$l2_mat_identity(N)
|
||||
entry <- laurent2$l2_str(I_mat[[1, 3]])
|
||||
mark_done(con, eq_id, entry)
|
||||
cat(sprintf(" [%s] identity word, done\n", eq_id))
|
||||
return(I_mat)
|
||||
}
|
||||
|
||||
steps <- as.integer(strsplit(word_str, ",")[[1]])
|
||||
start_step <- job$steps_done[[1]]
|
||||
cat(sprintf(" [%s] B%d word, %d generators, resuming from step %d (N=%d)\n",
|
||||
eq_id, n, length(steps), start_step, N))
|
||||
|
||||
result <- tryCatch({
|
||||
if (start_step > 0) {
|
||||
mat <- load_checkpoint(con, eq_id, start_step)
|
||||
if (is.null(mat)) {
|
||||
cat(" Checkpoint missing, restarting\n")
|
||||
start_step <- 0
|
||||
mat <- laurent2$l2_mat_identity(N)
|
||||
}
|
||||
} else {
|
||||
mat <- laurent2$l2_mat_identity(N)
|
||||
}
|
||||
|
||||
chunk_starts <- if (start_step < length(steps)) {
|
||||
seq(start_step + 1L, length(steps), by = CHUNK_SIZE)
|
||||
} else {
|
||||
integer(0)
|
||||
}
|
||||
|
||||
for (cs in chunk_starts) {
|
||||
ce <- min(cs + CHUNK_SIZE - 1L, length(steps))
|
||||
chunk <- steps[cs:ce]
|
||||
|
||||
cached_mat <- chunk_product(con, gens, chunk, n)
|
||||
mat <- laurent2$l2_mat_mul(mat, cached_mat)
|
||||
|
||||
if (ce %% CHECKPOINT_INTERVAL < CHUNK_SIZE || ce == length(steps)) {
|
||||
save_checkpoint(con, eq_id, ce, mat)
|
||||
cat(sprintf(" Step %d/%d checkpointed (cache: %d entries)\n",
|
||||
ce, length(steps), chunk_cache_stats()$memory_entries))
|
||||
}
|
||||
}
|
||||
|
||||
entry <- laurent2$l2_str(mat[[1, 3]])
|
||||
mark_done(con, eq_id, entry)
|
||||
cat(sprintf(" Done: %s\n",
|
||||
if (nchar(entry) > 60) paste0(substr(entry, 1, 57), "...") else entry))
|
||||
mat
|
||||
}, error = function(e) {
|
||||
mark_error(con, eq_id, e$message)
|
||||
cat(sprintf(" ERROR [%s]: %s\n", eq_id, e$message))
|
||||
NULL
|
||||
})
|
||||
|
||||
result
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_run <- function(con, max_jobs = Inf) {
|
||||
cat(sprintf("\n=== LKB Worker (auto-detecting Bn from queue) ===\n"))
|
||||
processed <- 0L
|
||||
while (processed < max_jobs) {
|
||||
result <- lkb_compute(con)
|
||||
if (is.null(result)) {
|
||||
remaining <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS n FROM lkb.compute_queue WHERE status = 'pending'")
|
||||
if (remaining$n[[1]] == 0) break
|
||||
Sys.sleep(2)
|
||||
next
|
||||
}
|
||||
processed <- processed + 1L
|
||||
}
|
||||
cat(sprintf("\n Processed %d equations\n", processed))
|
||||
}
|
||||
|
||||
#' @export
|
||||
lkb_status <- function(con) {
|
||||
q <- function(sql) DBI::dbGetQuery(con, sql)$n[[1]]
|
||||
list(
|
||||
pending = q("SELECT COUNT(*) AS n FROM lkb.compute_queue WHERE status = 'pending'"),
|
||||
running = q("SELECT COUNT(*) AS n FROM lkb.compute_queue WHERE status = 'running'"),
|
||||
done = q("SELECT COUNT(*) AS n FROM lkb.compute_queue WHERE status = 'done'"),
|
||||
errors = q("SELECT COUNT(*) AS n FROM lkb.compute_queue WHERE status = 'error'"),
|
||||
cached_chunks_db = q("SELECT COUNT(*) AS n FROM lkb.subseq_cache"),
|
||||
cached_chunks_mem = chunk_cache_stats()$memory_entries
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
reset_errors <- function(con) {
|
||||
n <- DBI::dbExecute(con,
|
||||
"UPDATE lkb.compute_queue SET status = 'pending', steps_done = 0, result_entry = NULL, started_at = NULL, finished_at = NULL WHERE status = 'error' OR status = 'running'")
|
||||
cat(sprintf(" Reset %d jobs to pending\n", n))
|
||||
DBI::dbExecute(con, "DELETE FROM lkb.checkpoint")
|
||||
cat(" Cleared checkpoints\n")
|
||||
}
|
||||
59
core/rewrite.R
Normal file
59
core/rewrite.R
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
source("boot.R")
|
||||
box_use(./b4)
|
||||
|
||||
#' @export
|
||||
free_reduce <- function(w) b4$braid_reduce(w)
|
||||
|
||||
#' @export
|
||||
yang_baxter_normalize <- function(w) {
|
||||
w <- unclass(b4$braid_reduce(w))
|
||||
changed <- TRUE
|
||||
while (changed) {
|
||||
changed <- FALSE
|
||||
i <- 1
|
||||
while (i <= length(w) - 2) {
|
||||
a <- w[i]; b <- w[i + 1]; c <- w[i + 2]
|
||||
ia <- abs(a); ib <- abs(b); ic <- abs(c)
|
||||
if (ia == ic && abs(ia - ib) == 1 && sign(a) == sign(b) && sign(b) == sign(c)) {
|
||||
if (ia > ib) {
|
||||
w[i] <- b; w[i + 1] <- a; w[i + 2] <- b; changed <- TRUE
|
||||
}
|
||||
}
|
||||
i <- i + 1
|
||||
}
|
||||
}
|
||||
b4$braid_word(w)
|
||||
}
|
||||
|
||||
#' @export
|
||||
far_commute_sort <- function(w) {
|
||||
w <- unclass(b4$braid_reduce(w))
|
||||
changed <- TRUE
|
||||
while (changed) {
|
||||
changed <- FALSE
|
||||
i <- 1
|
||||
while (i <= length(w) - 1) {
|
||||
a <- w[i]; b <- w[i + 1]
|
||||
if (abs(a) > abs(b) + 1 || abs(a) + 1 < abs(b)) {
|
||||
if (abs(a) > abs(b) || (abs(a) == abs(b) && a > b)) {
|
||||
w[i] <- b; w[i + 1] <- a; changed <- TRUE
|
||||
}
|
||||
}
|
||||
i <- i + 1
|
||||
}
|
||||
}
|
||||
b4$braid_word(w)
|
||||
}
|
||||
|
||||
#' @export
|
||||
rewrite_normalize <- function(w) {
|
||||
prev <- NULL
|
||||
w <- b4$braid_reduce(w)
|
||||
while (!identical(prev, unclass(w))) {
|
||||
prev <- unclass(w)
|
||||
w <- yang_baxter_normalize(w)
|
||||
w <- far_commute_sort(w)
|
||||
w <- b4$braid_reduce(w)
|
||||
}
|
||||
w
|
||||
}
|
||||
11
deploy/lkb-auto-deploy.service
Normal file
11
deploy/lkb-auto-deploy.service
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
[Unit]
|
||||
Description=LKB worker auto-deploy poller
|
||||
After=network-online.target
|
||||
Wants=network-online.target
|
||||
|
||||
[Service]
|
||||
Type=oneshot
|
||||
ExecStart=/home/allaun/MathPunch-pure/auto_deploy.sh
|
||||
Environment=HOME=/home/allaun
|
||||
User=allaun
|
||||
WorkingDirectory=/home/allaun/MathPunch-pure
|
||||
10
deploy/lkb-auto-deploy.timer
Normal file
10
deploy/lkb-auto-deploy.timer
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
[Unit]
|
||||
Description=LKB worker auto-deploy poller (every 2 minutes)
|
||||
|
||||
[Timer]
|
||||
OnBootSec=30
|
||||
OnUnitActiveSec=120
|
||||
Unit=lkb-auto-deploy.service
|
||||
|
||||
[Install]
|
||||
WantedBy=timers.target
|
||||
60
deploy_lkb.sh
Executable file
60
deploy_lkb.sh
Executable file
|
|
@ -0,0 +1,60 @@
|
|||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
HOST=$(uname -n)
|
||||
case "$HOST" in
|
||||
*neon*) DEFAULT_WORKERS=12 ;;
|
||||
*) DEFAULT_WORKERS=4 ;;
|
||||
esac
|
||||
|
||||
WORKERS="$DEFAULT_WORKERS"
|
||||
ROLE="worker"
|
||||
BUILD=false
|
||||
PLATFORM=""
|
||||
|
||||
while [[ $# -gt 0 ]]; do
|
||||
case "$1" in
|
||||
--workers) WORKERS="$2"; shift 2 ;;
|
||||
--role) ROLE="$2"; shift 2 ;;
|
||||
--build) BUILD=true; shift ;;
|
||||
--platform) PLATFORM="$2 --platform $2"; shift 2 ;;
|
||||
*) echo "Usage: $0 [--workers N] [--role seed|worker|all] [--build] [--platform linux/arm64|linux/amd64]"
|
||||
echo " Default workers: $DEFAULT_WORKERS"; exit 1 ;;
|
||||
esac
|
||||
done
|
||||
|
||||
DIR="$(cd "$(dirname "$0")" && pwd)"
|
||||
IMAGE="lkb-worker:latest"
|
||||
|
||||
if [ "$BUILD" = true ] || ! podman image exists "$IMAGE" 2>/dev/null; then
|
||||
echo "[build] $IMAGE ..."
|
||||
podman build -t "$IMAGE" -f "$DIR/Dockerfile.lkb" "$DIR"
|
||||
echo "[build] done"
|
||||
fi
|
||||
|
||||
run_seed() {
|
||||
podman rm -f lkb-seed 2>/dev/null || true
|
||||
podman run -d --rm --name lkb-seed --network host "$IMAGE" seed
|
||||
echo "[seed] started. Logs: podman logs -f lkb-seed"
|
||||
}
|
||||
|
||||
run_workers() {
|
||||
echo "[worker] launching $WORKERS containers ..."
|
||||
for i in $(seq 1 "$WORKERS"); do
|
||||
podman rm -f "lkb-worker-$i" 2>/dev/null || true
|
||||
podman run -d --rm --name "lkb-worker-$i" --network host "$IMAGE" worker
|
||||
done
|
||||
echo "[worker] $WORKERS launched"
|
||||
}
|
||||
|
||||
case "$ROLE" in
|
||||
seed) run_seed ;;
|
||||
worker) run_workers ;;
|
||||
all) run_seed; sleep 3; run_workers ;;
|
||||
esac
|
||||
|
||||
echo "=== Running ==="
|
||||
podman ps --format "table {{.Names}} {{.Status}}" | grep lkb-
|
||||
echo "=== DB queue ==="
|
||||
PGPASSWORD=kaleidoscope psql -h 100.79.14.103 -U kaleidoscope -d research_stack \
|
||||
-c "SELECT status, count(*) FROM lkb.compute_queue GROUP BY status ORDER BY status" 2>/dev/null || true
|
||||
50
neon_worker.R
Normal file
50
neon_worker.R
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
source("boot.R")
|
||||
box_use(./core/laurent2)
|
||||
box_use(./core/lkb)
|
||||
library(DBI); library(RPostgres)
|
||||
PSQL <- function(query) {
|
||||
con <- dbConnect(RPostgres::Postgres(), host=Sys.getenv("PGHOST", "100.79.14.103"),
|
||||
dbname="research_stack", user="kaleidoscope", password="kaleidoscope")
|
||||
on.exit(dbDisconnect(con))
|
||||
dbGetQuery(con, query)
|
||||
}
|
||||
cat(sprintf("[%s] neon worker starting (PID %d)\n", Sys.time(), Sys.getpid()), flush = TRUE)
|
||||
n_jobs <- 0L
|
||||
repeat {
|
||||
result <- tryCatch({
|
||||
PSQL("UPDATE lkb.compute_queue c SET status = 'running', started_at = NOW()
|
||||
WHERE c.equation_id = (SELECT equation_id FROM lkb.compute_queue
|
||||
WHERE status = 'pending' ORDER BY word_length ASC NULLS LAST LIMIT 1
|
||||
FOR UPDATE SKIP LOCKED)
|
||||
RETURNING c.equation_id, c.n, c.braid_word, c.word_length")
|
||||
}, error = function(e) data.frame())
|
||||
if (nrow(result) == 0) break
|
||||
eq_id <- result$equation_id[1]
|
||||
n <- result$n[1]
|
||||
word_str <- result$braid_word[1]
|
||||
word_len <- if (is.na(result$word_length[1])) 0L else result$word_length[1]
|
||||
N <- n * (n - 1) / 2L
|
||||
cat(sprintf(" [%s] B%d word, %d gens (N=%d)\n", eq_id, n, word_len, N), flush = TRUE)
|
||||
t0 <- Sys.time()
|
||||
tryCatch({
|
||||
if (word_str == "ID" || is.na(word_str) || word_str == "") {
|
||||
entry <- "1"
|
||||
} else {
|
||||
steps <- as.integer(strsplit(word_str, ",")[[1]])
|
||||
gens <- lkb$lkb_generators(n)
|
||||
mat <- laurent2$l2_mat_identity(N)
|
||||
for (g in steps) mat <- laurent2$l2_mat_mul(mat, gens[[g]])
|
||||
entry <- laurent2$l2_str(mat[[1, 3]])
|
||||
}
|
||||
esc <- gsub("'", "''", entry)
|
||||
PSQL(sprintf("UPDATE lkb.compute_queue SET status = 'done', result_entry = '%s',
|
||||
finished_at = NOW(), steps_done = %d WHERE equation_id = '%s'",
|
||||
esc, word_len, eq_id))
|
||||
cat(sprintf(" [%s] done in %.1f s (%d total)\n", eq_id,
|
||||
difftime(Sys.time(), t0, units="secs"), n_jobs + 1), flush = TRUE)
|
||||
n_jobs <- n_jobs + 1L
|
||||
}, error = function(e) {
|
||||
cat(sprintf(" [%s] ERROR: %s\n", eq_id, conditionMessage(e)), flush = TRUE)
|
||||
})
|
||||
}
|
||||
cat(sprintf("[%s] worker finished -- %d jobs total\n", Sys.time(), n_jobs), flush = TRUE)
|
||||
77
run.sh
Executable file
77
run.sh
Executable file
|
|
@ -0,0 +1,77 @@
|
|||
#!/usr/bin/env Rscript
|
||||
|
||||
args <- commandArgs(trailingOnly = TRUE)
|
||||
role <- if (length(args) >= 1) args[1] else "worker"
|
||||
source("boot.R")
|
||||
box_use("Rcpp")
|
||||
Rcpp::sourceCpp("src/laurent_ops.cpp")
|
||||
box_use("./core/laurent2")
|
||||
box_use("./core/lkb")
|
||||
|
||||
DB_HOST <- Sys.getenv("PGHOST", "100.79.14.103")
|
||||
box_use("DBI"); box_use("RPostgres")
|
||||
|
||||
con <- DBI::dbConnect(RPostgres::Postgres(),
|
||||
host = DB_HOST, dbname = "research_stack",
|
||||
user = "kaleidoscope", password = "kaleidoscope")
|
||||
on.exit(DBI::dbDisconnect(con))
|
||||
|
||||
if (role == "seed") {
|
||||
box_use("./core/lkb_store")
|
||||
lkb_store$reap_stuck_jobs(con)
|
||||
lkb_store$seed_generators(con, 4)
|
||||
cat("[seed] generators seeded for B4\n")
|
||||
q(save = "no", status = 0)
|
||||
}
|
||||
|
||||
if (role == "eigensolid") {
|
||||
box_use("./core/eigensolid")
|
||||
eigensolid$run_eigensolid(con)
|
||||
cat("[eigensolid] done\n")
|
||||
q(save = "no", status = 0)
|
||||
}
|
||||
|
||||
if (role != "worker") {
|
||||
cat(sprintf("Unknown role: %s — try seed, worker, or eigensolid\n", role))
|
||||
q(save = "no", status = 1)
|
||||
}
|
||||
|
||||
n_jobs <- 0L
|
||||
repeat {
|
||||
row <- tryCatch({
|
||||
DBI::dbGetQuery(con, "UPDATE lkb.compute_queue SET status = 'running', started_at = now()
|
||||
WHERE equation_id = (SELECT equation_id FROM lkb.compute_queue
|
||||
WHERE status = 'pending' ORDER BY word_length, equation_id LIMIT 1 FOR UPDATE SKIP LOCKED)
|
||||
RETURNING *")
|
||||
}, error = function(e) data.frame())
|
||||
if (nrow(row) == 0) break
|
||||
|
||||
eq_id <- row$equation_id[[1]]
|
||||
n <- row$n[[1]]
|
||||
word_str <- row$braid_word[[1]]
|
||||
cat(sprintf("[%s] B%d, %d gens\n", eq_id, n, nchar(word_str)))
|
||||
|
||||
tryCatch({
|
||||
if (word_str == "ID" || is.na(word_str) || word_str == "") {
|
||||
entry <- "1"
|
||||
} else {
|
||||
steps <- as.integer(strsplit(word_str, ",")[[1]])
|
||||
gens <- lkb$lkb_generators(n)
|
||||
N <- n * (n - 1) / 2
|
||||
mat <- laurent2$l2_mat_identity(N)
|
||||
for (g in steps) mat <- laurent2$l2_mat_mul(mat, gens[[g]])
|
||||
entry <- laurent2$l2_str(mat[[1, 3]])
|
||||
}
|
||||
esc <- gsub("'", "''", entry)
|
||||
DBI::dbExecute(con, sprintf(
|
||||
"UPDATE lkb.compute_queue SET status = 'done', result_entry = '%s', finished_at = now() WHERE equation_id = '%s'",
|
||||
esc, eq_id))
|
||||
n_jobs <- n_jobs + 1
|
||||
cat(sprintf(" done (%d)\n", n_jobs))
|
||||
}, error = function(e) {
|
||||
cat(sprintf(" ERROR: %s\n", conditionMessage(e)), file = stderr())
|
||||
})
|
||||
}
|
||||
|
||||
cat(sprintf("[worker] finished — %d jobs\n", n_jobs))
|
||||
q(save = "no", status = 0)
|
||||
80
src/laurent_ops.cpp
Normal file
80
src/laurent_ops.cpp
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
#include <Rcpp.h>
|
||||
#include <unordered_map>
|
||||
#include <algorithm>
|
||||
#include <tuple>
|
||||
#include <cstdint>
|
||||
|
||||
using namespace Rcpp;
|
||||
|
||||
static inline int64_t make_key(int qe, int te) {
|
||||
return ((int64_t)(qe) << 32) | (uint32_t)(te);
|
||||
}
|
||||
|
||||
// Convert map → sorted R vectors (stable order matching R laurent2)
|
||||
static List from_map_sorted(const std::unordered_map<int64_t, double>& m) {
|
||||
int n = m.size();
|
||||
if (n == 0)
|
||||
return List::create(Named("qe") = IntegerVector::create(),
|
||||
Named("te") = IntegerVector::create(),
|
||||
Named("coef") = NumericVector::create());
|
||||
|
||||
// Copy to vector of tuples for sorting
|
||||
std::vector<std::tuple<int, int, double>> sorted;
|
||||
sorted.reserve(n);
|
||||
for (auto& entry : m) {
|
||||
sorted.emplace_back((int)(entry.first >> 32),
|
||||
(int)(uint32_t)entry.first,
|
||||
entry.second);
|
||||
}
|
||||
std::sort(sorted.begin(), sorted.end());
|
||||
|
||||
IntegerVector qe(n), te(n);
|
||||
NumericVector coef(n);
|
||||
for (int i = 0; i < n; i++) {
|
||||
qe[i] = std::get<0>(sorted[i]);
|
||||
te[i] = std::get<1>(sorted[i]);
|
||||
coef[i] = std::get<2>(sorted[i]);
|
||||
}
|
||||
return List::create(Named("qe") = qe,
|
||||
Named("te") = te,
|
||||
Named("coef") = coef);
|
||||
}
|
||||
|
||||
// ── l2_mul_cpp ─────────────────────────────────────────────────────
|
||||
// [[Rcpp::export]]
|
||||
List l2_mul_cpp(IntegerVector qe_a, IntegerVector te_a, NumericVector coef_a,
|
||||
IntegerVector qe_b, IntegerVector te_b, NumericVector coef_b) {
|
||||
std::unordered_map<int64_t, double> result;
|
||||
result.reserve(qe_a.size() * qe_b.size());
|
||||
|
||||
for (int i = 0; i < qe_a.size(); i++) {
|
||||
int a_qe = qe_a[i], a_te = te_a[i];
|
||||
double a_c = coef_a[i];
|
||||
if (a_c == 0.0) continue;
|
||||
for (int j = 0; j < qe_b.size(); j++) {
|
||||
result[make_key(a_qe + qe_b[j], a_te + te_b[j])] += a_c * coef_b[j];
|
||||
}
|
||||
}
|
||||
for (auto it = result.begin(); it != result.end(); )
|
||||
if (it->second == 0.0) it = result.erase(it); else ++it;
|
||||
|
||||
return from_map_sorted(result);
|
||||
}
|
||||
|
||||
// ── l2_add_cpp ─────────────────────────────────────────────────────
|
||||
// [[Rcpp::export]]
|
||||
List l2_add_cpp(IntegerVector qe_a, IntegerVector te_a, NumericVector coef_a,
|
||||
IntegerVector qe_b, IntegerVector te_b, NumericVector coef_b) {
|
||||
std::unordered_map<int64_t, double> result;
|
||||
result.reserve(qe_a.size() + qe_b.size());
|
||||
|
||||
for (int i = 0; i < qe_a.size(); i++)
|
||||
result[make_key(qe_a[i], te_a[i])] += coef_a[i];
|
||||
for (int i = 0; i < qe_b.size(); i++)
|
||||
result[make_key(qe_b[i], te_b[i])] += coef_b[i];
|
||||
|
||||
for (auto it = result.begin(); it != result.end(); )
|
||||
if (it->second == 0.0) it = result.erase(it); else ++it;
|
||||
|
||||
return from_map_sorted(result);
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue