SilverSight/r/SilverSight/silversight_engine.r

# SilverSight Engine — R Port
#
# Mirrors `python/silversight_engine.py`, `rust/src/silversight/mod.rs`,
# and `julia/SilverSight/silversight_engine.jl`.
#
# Pure functional: all core functions return new values (no side effects).

# ── Constants ─────────────────────────────────────────────────────────

PHI <- (1 + sqrt(5)) / 2
PSI <- 2 * pi / (PHI^2)

# ── R1: Token Normalization ──────────────────────────────────────────

normalize <- function(s) {
  lower <- tolower(s)
  out <- character(0)
  i <- 1
  while (i <= nchar(lower)) {
    c <- substr(lower, i, i)
    if (grepl("[0-9]", c)) {
      out <- c(out, "N")
      while (i <= nchar(lower) && grepl("[0-9]", substr(lower, i, i))) i <- i + 1
    } else if (grepl("[a-z]", c)) {
      out <- c(out, "V")
      while (i <= nchar(lower) && grepl("[a-z]", substr(lower, i, i))) i <- i + 1
    } else {
      out <- c(out, c)
      i <- i + 1
    }
  }
  paste(out, collapse = "")
}

# ── Byte Classification ──────────────────────────────────────────────

byte_class <- function(c) {
  asc <- utf8ToInt(c)
  if (asc <= 31)  return(0L)
  if (asc <= 47)  return(1L)
  if (asc <= 57)  return(2L)
  if (asc <= 64)  return(3L)
  if (asc <= 90)  return(4L)
  if (asc <= 96)  return(5L)
  if (asc <= 122) return(6L)
  7L
}

# ── Feature Extraction ───────────────────────────────────────────────

F <- function(s) {
  norm <- normalize(s)
  counts <- integer(8)
  chars <- strsplit(norm, "")[[1]]
  for (c in chars) {
    counts[byte_class(c) + 1] <- counts[byte_class(c) + 1] + 1L
  }
  total <- sum(counts)
  if (total == 0) return(numeric(8))
  counts / total
}

parse_tree_depth <- function(expr) {
  ops <- list()
  depth <- 0
  chars <- strsplit(expr, "")[[1]]
  for (c in chars) {
    if (c == "(") { depth <- depth + 1
    } else if (c == ")") { depth <- depth - 1
    } else if (c %in% c("+", "-", "*", "/", "=")) {
      ops <- c(ops, list(list(op = c, depth = depth)))
    }
  }
  ops
}

tau <- function(s) {
  op_depths <- parse_tree_depth(s)
  weights <- numeric(6)
  for (entry in op_depths) {
    w <- 2^(-entry$depth)
    if (entry$op == "+") { weights[2] <- weights[2] + w
    } else if (entry$op == "=") { weights[3] <- weights[3] + w
    } else if (entry$op == "/") { weights[4] <- weights[4] + w
    } else if (entry$op == "*") { weights[5] <- weights[5] + w
    } else if (entry$op == "-") { weights[6] <- weights[6] + w }
  }
  total <- sum(weights)
  if (total > 0) weights <- weights / total
  weights
}

Phi <- function(s) {
  c(F(s), tau(s))
}

# ── Fisher Distance ──────────────────────────────────────────────────

d_F <- function(p, q) {
  s <- sum(sqrt(pmax(p * q, 0)))
  s <- max(-1, min(1, s))
  2 * acos(s)
}

d_Phi <- function(phi1, phi2) {
  f1 <- phi1[1:8];  t1 <- phi1[9:14]
  f2 <- phi2[1:8];  t2 <- phi2[9:14]
  sqrt(d_F(f1, f2)^2 + d_F(t1, t2)^2)
}

# ── Coarse-Graining / Eigensolid ────────────────────────────────────

C <- function(phi) {
  result <- phi
  for (k in 0:3) {
    avg <- (phi[2*k + 1] + phi[2*k + 2]) / 2
    result[2*k + 1] <- avg
    result[2*k + 2] <- avg
  }
  for (k in 0:2) {
    avg <- (phi[9 + 2*k] + phi[10 + 2*k]) / 2
    result[9 + 2*k] <- avg
    result[10 + 2*k] <- avg
  }
  result
}

geodesic_step <- function(phi1, phi2, eps = 0.5) {
  f1 <- phi1[1:8];  t1 <- phi1[9:14]
  f2 <- phi2[1:8];  t2 <- phi2[9:14]

  sf1 <- sqrt(pmax(pmin(f1, 1), 0))
  sf2 <- sqrt(pmax(pmin(f2, 1), 0))
  interp_f <- (1 - eps) * sf1 + eps * sf2
  interp_f_sq <- interp_f^2
  sum_f <- sum(interp_f_sq)
  if (sum_f > 0) interp_f_sq <- interp_f_sq / sum_f

  st1 <- sqrt(pmax(pmin(t1, 1), 0))
  st2 <- sqrt(pmax(pmin(t2, 1), 0))
  interp_t <- (1 - eps) * st1 + eps * st2
  interp_t_sq <- interp_t^2
  sum_t <- sum(interp_t_sq)
  if (sum_t > 0) interp_t_sq <- interp_t_sq / sum_t

  c(interp_f_sq, interp_t_sq)
}

# ── Chaos Game ───────────────────────────────────────────────────────

chaos_game <- function(start, references, steps = 30, eps = 0.5, seed = 42) {
  set.seed(seed)
  refs <- lapply(references, identity)
  x <- start
  for (step in 1:steps) {
    dists <- sapply(refs, function(r) d_Phi(x, r))
    nearest <- refs[[which.min(dists)]]
    x <- geodesic_step(x, nearest, eps)
  }
  x
}

# ── Corkscrew Index ──────────────────────────────────────────────────

corkscrew_index <- function(phi) {
  coeffs <- floor(phi[1:9] * 256)
  spiral <- 0
  for (i in seq_along(coeffs)) {
    spiral <- spiral + coeffs[i] * (8^(i - 1))
  }
  abs(spiral)
}

# ── SilverSight Engine ───────────────────────────────────────────────

SilverSight <- function() {
  list(
    concepts = list(),
    references = list(),
    basin_map = new.env(hash = TRUE, parent = emptyenv())
  )
}

detect_operator <- function(s) {
  norm <- normalize(s)
  if (grepl("+", norm, fixed = TRUE)) return("addition")
  if (grepl("/", norm, fixed = TRUE)) return("division")
  if (grepl("*", norm, fixed = TRUE)) return("multiplication")
  if (grepl("-", norm, fixed = TRUE)) return("subtraction")
  if (grepl("=", norm, fixed = TRUE)) return("equality")
  "literal"
}

learn <- function(ss, equation) {
  phi <- Phi(equation)
  ss$references[[equation]] <- phi

  limit <- chaos_game(phi, ss$references, steps = 30, eps = 0.5)
  eigensolid <- C(limit)
  idx <- corkscrew_index(eigensolid)

  attractor_key <- paste(round(limit * 1e8), collapse = ",")

  if (exists(attractor_key, envir = ss$basin_map)) {
    cid <- ss$basin_map[[attractor_key]]
    ss$concepts[[cid]]$members[[length(ss$concepts[[cid]]$members) + 1]] <<- list(equation, phi)
    return(cid)
  }

  op_type <- detect_operator(equation)
  cid <- length(ss$concepts) + 1
  concept <- list(
    name = paste0("concept_", cid - 1),
    prototype = eigensolid,
    attractor = limit,
    corkscrew_index = idx,
    operator_type = op_type,
    members = list(list(equation, phi))
  )
  ss$concepts[[cid]] <- concept
  ss$basin_map[[attractor_key]] <- cid
  cid
}

classify <- function(ss, equation) {
  if (length(ss$concepts) == 0) return(list(concept = NULL, dist = Inf))
  phi <- Phi(equation)
  best <- NULL
  best_dist <- Inf
  for (concept in ss$concepts) {
    d <- d_Phi(phi, concept$attractor)
    if (d < best_dist) {
      best_dist <- d
      best <- concept
    }
  }
  list(concept = best, dist = best_dist)
}

is_novel <- function(ss, equation) {
  if (length(ss$concepts) < 2) {
    return(list(novel = length(ss$concepts) == 0, dist = Inf))
  }
  inter_dists <- c()
  for (i in seq_along(ss$concepts)) {
    for (j in (i+1):length(ss$concepts)) {
      inter_dists <- c(inter_dists, d_Phi(ss$concepts[[i]]$attractor, ss$concepts[[j]]$attractor))
    }
  }
  threshold <- if (length(inter_dists) > 0) min(inter_dists) / 2 else 0.5
  res <- classify(ss, equation)
  list(novel = res$dist > threshold, dist = res$dist)
}

summary_ss <- function(ss) {
  cat("SilverSight:", length(ss$concepts), "concepts,", length(ss$references), "references\n")
  for (i in seq_along(ss$concepts)) {
    c <- ss$concepts[[i]]
    members <- paste(sapply(c$members, function(m) m[[1]]), collapse = ", ")
    cat(sprintf("  [%d] %-15s idx=%12d members: %s\n",
        i - 1, c$operator_type, c$corkscrew_index, members))
  }
}

# ── Demo ──────────────────────────────────────────────────────────────

demo <- function() {
  ss <- SilverSight()
  equations <- c("a+b=c", "x+y=z", "p/q=r", "a/b=c",
                 "a*b=c", "a-b=c", "hello", "(a+b)*c=d")
  for (eq in equations) {
    learn(ss, eq)
  }
  summary_ss(ss)

  cat("\nClassification:\n")
  for (eq in c("a+b=c", "m+n=p", "p/q=r", "foo", "a+b+c=d")) {
    res <- classify(ss, eq)
    nres <- is_novel(ss, eq)
    status <- if (nres$novel) "NOVEL" else "known"
    cname <- if (is.null(res$concept)) "none" else res$concept$operator_type
    cat(sprintf("  %-15s -> [%s] %-15s d=%.6f [%s]\n",
        eq, "?", cname, res$dist, status))
  }
}

if (interactive() && Sys.getenv("R_TEST") == "") {
  demo()
}