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

@@ -0,0 +1,6 @@
+*.o
+*.so
+*.Rcheck/
+.Rhistory
+.RData
+.env

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"]

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)"

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)
+}

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 ")
+}

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))
+}

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)
+}

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
+}

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")
+}

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")
+}

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
+}

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

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

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

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)

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)

src/laurent_ops.cpp

@@ -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);
+}