From e5bfdc04923e85c1a661743526eae69cd7d7e438 Mon Sep 17 00:00:00 2001 From: allaun Date: Wed, 8 Jul 2026 20:01:29 -0500 Subject: [PATCH] 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) --- .gitignore | 6 + Dockerfile.lkb | 28 ++++ auto_deploy.sh | 50 ++++++ boot.R | 47 ++++++ core/b4.R | 243 ++++++++++++++++++++++++++++ core/b4xb4.R | 25 +++ core/eigensolid.R | 149 ++++++++++++++++++ core/laurent2.R | 248 +++++++++++++++++++++++++++++ core/lkb.R | 159 +++++++++++++++++++ core/lkb_store.R | 280 +++++++++++++++++++++++++++++++++ core/rewrite.R | 59 +++++++ deploy/lkb-auto-deploy.service | 11 ++ deploy/lkb-auto-deploy.timer | 10 ++ deploy_lkb.sh | 60 +++++++ neon_worker.R | 50 ++++++ run.sh | 77 +++++++++ src/laurent_ops.cpp | 80 ++++++++++ 17 files changed, 1582 insertions(+) create mode 100644 .gitignore create mode 100755 Dockerfile.lkb create mode 100644 auto_deploy.sh create mode 100644 boot.R create mode 100644 core/b4.R create mode 100644 core/b4xb4.R create mode 100644 core/eigensolid.R create mode 100644 core/laurent2.R create mode 100644 core/lkb.R create mode 100644 core/lkb_store.R create mode 100644 core/rewrite.R create mode 100644 deploy/lkb-auto-deploy.service create mode 100644 deploy/lkb-auto-deploy.timer create mode 100755 deploy_lkb.sh create mode 100644 neon_worker.R create mode 100755 run.sh create mode 100644 src/laurent_ops.cpp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1e309ea --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +*.o +*.so +*.Rcheck/ +.Rhistory +.RData +.env diff --git a/Dockerfile.lkb b/Dockerfile.lkb new file mode 100755 index 0000000..8a95a56 --- /dev/null +++ b/Dockerfile.lkb @@ -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"] \ No newline at end of file diff --git a/auto_deploy.sh b/auto_deploy.sh new file mode 100644 index 0000000..b468857 --- /dev/null +++ b/auto_deploy.sh @@ -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)" \ No newline at end of file diff --git a/boot.R b/boot.R new file mode 100644 index 0000000..ca21d2d --- /dev/null +++ b/boot.R @@ -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) +} \ No newline at end of file diff --git a/core/b4.R b/core/b4.R new file mode 100644 index 0000000..1d5568a --- /dev/null +++ b/core/b4.R @@ -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 ") +} diff --git a/core/b4xb4.R b/core/b4xb4.R new file mode 100644 index 0000000..a1b8fe8 --- /dev/null +++ b/core/b4xb4.R @@ -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)) +} diff --git a/core/eigensolid.R b/core/eigensolid.R new file mode 100644 index 0000000..d549f2f --- /dev/null +++ b/core/eigensolid.R @@ -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) +} \ No newline at end of file diff --git a/core/laurent2.R b/core/laurent2.R new file mode 100644 index 0000000..14cc489 --- /dev/null +++ b/core/laurent2.R @@ -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 +} diff --git a/core/lkb.R b/core/lkb.R new file mode 100644 index 0000000..eb48092 --- /dev/null +++ b/core/lkb.R @@ -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") +} diff --git a/core/lkb_store.R b/core/lkb_store.R new file mode 100644 index 0000000..9f661f7 --- /dev/null +++ b/core/lkb_store.R @@ -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") +} diff --git a/core/rewrite.R b/core/rewrite.R new file mode 100644 index 0000000..adca4dc --- /dev/null +++ b/core/rewrite.R @@ -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 +} diff --git a/deploy/lkb-auto-deploy.service b/deploy/lkb-auto-deploy.service new file mode 100644 index 0000000..c4c22e9 --- /dev/null +++ b/deploy/lkb-auto-deploy.service @@ -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 \ No newline at end of file diff --git a/deploy/lkb-auto-deploy.timer b/deploy/lkb-auto-deploy.timer new file mode 100644 index 0000000..82b5337 --- /dev/null +++ b/deploy/lkb-auto-deploy.timer @@ -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 \ No newline at end of file diff --git a/deploy_lkb.sh b/deploy_lkb.sh new file mode 100755 index 0000000..50076ba --- /dev/null +++ b/deploy_lkb.sh @@ -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 \ No newline at end of file diff --git a/neon_worker.R b/neon_worker.R new file mode 100644 index 0000000..733242a --- /dev/null +++ b/neon_worker.R @@ -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) \ No newline at end of file diff --git a/run.sh b/run.sh new file mode 100755 index 0000000..2950df3 --- /dev/null +++ b/run.sh @@ -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) \ No newline at end of file diff --git a/src/laurent_ops.cpp b/src/laurent_ops.cpp new file mode 100644 index 0000000..a149b88 --- /dev/null +++ b/src/laurent_ops.cpp @@ -0,0 +1,80 @@ +#include +#include +#include +#include +#include + +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& 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> 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 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 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); +}