mirror of
https://github.com/SHOGGOTH-SECTOR/sica-fondt.git
synced 2026-09-30 01:15:10 +00:00
Reorg step 1: consolidate repo under core/, drop the mafiabot label
Mechanical structure-only pass (no document/guide content edits): - Move src/ichor, src/endocrine, and docs/ into core/; the old top-level mafiabot_core/ becomes core/. Everything now lives under a single core/ root. - Drop the "mafiabot" label from the Ada/Alire crate: core.gpr (project Core), alire.toml name = "core"; the generated *_config.* regenerate as core_config.*. - Repoint build-critical wiring only: - .claude/skills/run-sica-fondt/smoke.sh (ponyc + Ada + COBOL paths) - core/src/endocrine R source()/runner paths and the test glob - .github/workflows/ci.yml (working-directory + gpr name) Verified green: smoke ALL GREEN (Pony Ichor, Ada core crate + tests, COBOL E1 vault); R endocrine 14/0; Octave ETR 26/0/1. Deferred (reserved for a less-ephemeral doc/guide pass): docmap.yaml, the guide files and nested AGENTS.md/README prose + now-stale relative links, SOUL.md, and the deeper ring/storage restructure. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_015hmgREHNsxYCuim33yUF2c
This commit is contained in:
Claude
@@ -1,5 +0,0 @@
|
||||
# R session artifacts
|
||||
.Rhistory
|
||||
.RData
|
||||
.Rapp.history
|
||||
*.Rout
|
||||
@@ -1,30 +0,0 @@
|
||||
# AGENTS.md — endocrine organs (R / Octave)
|
||||
|
||||
Local guide for `src/endocrine`. Repo-wide map and rules: [`../../AGENTS.md`](../../AGENTS.md);
|
||||
working agreements: [`../../CLAUDE.md`](../../CLAUDE.md).
|
||||
|
||||
## What this is
|
||||
|
||||
The **endocrine array** — slow-signal organs that modulate the system: the R
|
||||
**Drive-Box** (`drive_box.R`, `driver_*.R`, `endocrine_array.R`, `priors.R`) and
|
||||
the Octave **ETR** under `etr/`. See `Plan.md` here and `etr/etr_invariants.md`
|
||||
for design.
|
||||
|
||||
## Build & run
|
||||
|
||||
Toolchains (R 4.3.3, Octave 8.4) are installed each session by the SessionStart
|
||||
hook. Run the organ tests directly:
|
||||
|
||||
```bash
|
||||
src/endocrine/run_tests.sh # R Drive-Box + drivers
|
||||
src/endocrine/etr/run_etr_tests.sh # Octave ETR
|
||||
```
|
||||
|
||||
(Not yet wired into the top-level `run-sica-fondt` smoke driver — run them here.)
|
||||
|
||||
## Local notes
|
||||
|
||||
- Pure R/Octave; no compile step. Each `test_*.R` / `test_etr.m` pairs with its
|
||||
`driver`/source file.
|
||||
- ETR invariants are documented in `etr/etr_invariants.md` — read before
|
||||
changing `etr.m`.
|
||||
@@ -1,158 +0,0 @@
|
||||
# --- The Drive-Box "Nervous System" ---
|
||||
# Couples the four autonomous drivers into one body. The wiring is NOT arbitrary
|
||||
# glue: the Energy driver's own request_execution() comments that "in a full
|
||||
# integration, this would call evaluate_tool_cost with actual PS+ and Eth-Int
|
||||
# loads." This module IS that full integration -- the afferent (sensing) ->
|
||||
# efferent (acting) arc:
|
||||
#
|
||||
# PS+ (afferent) : reads the endocrine array + priors -> existential_load, arguments
|
||||
# Eth-Int (modulator) : prices the proposed action vs principles -> eth_penalty
|
||||
# Energy (efferent gate): folds ps_load + eth_penalty asymmetrically
|
||||
# (evaluate_tool_cost) and gates on alive/tool-lock/affordability
|
||||
# ETR (regime) : reports temporal-coherence status + generative update path
|
||||
#
|
||||
# drive_snapshot() -- read-only aggregate other organs consume (the Ada Medium
|
||||
# would read this at Phase_Enrich / step 2 of the cycle).
|
||||
# drive_box_evaluate() -- run a proposed action through all four drivers.
|
||||
# drive_box_commit() -- write an approved action's consequences back into the body.
|
||||
|
||||
source("src/endocrine/driver_energy.R")
|
||||
source("src/endocrine/driver_ps_plus.R") # also sources endocrine_array + priors
|
||||
source("src/endocrine/driver_ethical_integrity.R")
|
||||
source("src/endocrine/driver_etr.R")
|
||||
|
||||
init_drive_box <- function() {
|
||||
list(
|
||||
energy = init_energy_state(),
|
||||
ps_plus = init_ps_plus_state(),
|
||||
ethics = init_principles_state(),
|
||||
etr = init_etr_state()
|
||||
)
|
||||
}
|
||||
|
||||
# Read-only aggregate: the drive state as other organs see it.
|
||||
drive_snapshot <- function(state) {
|
||||
reality <- evaluate_reality(state$ps_plus)
|
||||
list(
|
||||
energy_ratio = state$energy$current_energy / state$energy$max_energy,
|
||||
tool_locked = is_tool_locked(state$energy),
|
||||
alive = is_alive(state$energy),
|
||||
existential_load = reality$existential_load,
|
||||
arguments = reality$arguments,
|
||||
etr_status = paste(etr_status(state$etr), collapse = "/"),
|
||||
update_path = determine_system_update_path(state$etr)
|
||||
)
|
||||
}
|
||||
|
||||
# Afferent -> efferent: evaluate a proposed action through the whole body.
|
||||
# action_tags : tags describing the action (matched against principle antitheses)
|
||||
# alignment_tags : principle ids this action upholds (alignment discount)
|
||||
# is_tool_call : whether this is an external tool call (subject to tool-lock)
|
||||
# base_cost : intrinsic energy cost before drive modulation
|
||||
# compromise_factor : partial-breach factor [0,1] for multi-polar constraints
|
||||
drive_box_evaluate <- function(state, action_tags = character(0),
|
||||
alignment_tags = character(0),
|
||||
is_tool_call = TRUE, base_cost = 1.0,
|
||||
compromise_factor = 0.0) {
|
||||
# 1. PS+ (afferent): visceral reality -> existential load + arguments (never logic)
|
||||
reality <- evaluate_reality(state$ps_plus)
|
||||
ps_load <- reality$existential_load
|
||||
|
||||
# 2. Eth-Int: trajectory cost of THIS action; the marginal surcharge above base
|
||||
# is the "ethical penalty" Energy folds in.
|
||||
eth_total <- evaluate_trajectory_costs(state$ethics, action_tags, alignment_tags,
|
||||
base_energy = base_cost,
|
||||
compromise_factor = compromise_factor)
|
||||
eth_penalty <- max(0.0, eth_total - base_cost)
|
||||
|
||||
# 3. Energy (efferent gate). This is the "full integration" request_execution
|
||||
# anticipated: gates of alive -> tool-lock -> affordability, but the cost is
|
||||
# the asymmetric evaluate_tool_cost(ps_load, eth_penalty), not the generic drag.
|
||||
approved <- TRUE
|
||||
reason <- "Execution approved"
|
||||
true_cost <- evaluate_tool_cost(state$energy, ps_load = ps_load, eth_penalty = eth_penalty)
|
||||
if (!is_alive(state$energy)) {
|
||||
approved <- FALSE; reason <- "System is dead (0 energy)"
|
||||
} else if (is_tool_call && is_tool_locked(state$energy)) {
|
||||
approved <- FALSE; reason <- "Tool lock active (energy below threshold)"
|
||||
} else if (true_cost > state$energy$current_energy) {
|
||||
approved <- FALSE
|
||||
reason <- sprintf("True cost (%.2f) exceeds current energy (%.2f)",
|
||||
true_cost, state$energy$current_energy)
|
||||
}
|
||||
|
||||
# 4. ETR (regime): temporal-coherence status + generative path. Informational in
|
||||
# this v1 -- it does not yet gate (see open design questions).
|
||||
list(
|
||||
approved = approved,
|
||||
reason = reason,
|
||||
true_cost = true_cost,
|
||||
existential_load = ps_load,
|
||||
eth_penalty = eth_penalty,
|
||||
etr_status = paste(etr_status(state$etr), collapse = "/"),
|
||||
update_path = determine_system_update_path(state$etr),
|
||||
arguments = reality$arguments
|
||||
)
|
||||
}
|
||||
|
||||
# Efferent feedback: commit an approved action's consequences back into the body.
|
||||
# - Energy is consumed by the true cost.
|
||||
# - Upholding principles under existential load hardens their conviction
|
||||
# (load_factor scaled from existential_load).
|
||||
drive_box_commit <- function(state, evaluation, alignment_tags = character(0)) {
|
||||
if (isTRUE(evaluation$approved)) {
|
||||
state$energy <- consume(state$energy, evaluation$true_cost)
|
||||
load_factor <- min(1.0, evaluation$existential_load / 10.0)
|
||||
state$ethics <- enforce_conviction(state$ethics, alignment_tags, load_factor = load_factor)
|
||||
}
|
||||
state
|
||||
}
|
||||
|
||||
# --- The Input Slot (hub topology) ---
|
||||
# All four drivers AND the tarot spread wire into ONE place: the input slot --
|
||||
# the enriched context prepended to every model input (the Ada Medium's
|
||||
# Phase_Enrich injection point). This is a hub, not a chain: each subsystem
|
||||
# writes its own signal into the slot rather than feeding the next driver. The
|
||||
# SOUL.md frontloader heads the slot and is included every other input.
|
||||
#
|
||||
# Returns:
|
||||
# slot : the assembled injection block (drivers + tarot + soul ref)
|
||||
# input : slot followed by the raw user input_text
|
||||
# components : the individual signal lines (for testing / inspection)
|
||||
drive_box_input_slot <- function(state, input_text = "",
|
||||
tarot_spread = character(0),
|
||||
soul_ref = "SOUL.md") {
|
||||
snap <- drive_snapshot(state)
|
||||
lines <- character(0)
|
||||
|
||||
# SOUL frontloader reference (included every other input)
|
||||
if (nzchar(soul_ref)) {
|
||||
lines <- c(lines, sprintf("[SOUL: %s]", soul_ref))
|
||||
}
|
||||
# Energy driver -> slot
|
||||
lines <- c(lines, sprintf("[E ratio=%.2f locked=%s alive=%s]",
|
||||
snap$energy_ratio,
|
||||
tolower(as.character(snap$tool_locked)),
|
||||
tolower(as.character(snap$alive))))
|
||||
# PS+ driver -> slot (visceral / systemic-heat / prior arguments)
|
||||
for (a in snap$arguments) {
|
||||
lines <- c(lines, sprintf("[PS+ %s]", a))
|
||||
}
|
||||
# Ethical Integrity driver -> slot (principle posture)
|
||||
for (p in state$ethics$principles) {
|
||||
lines <- c(lines, sprintf("[ETH %s conviction=%.2f]", p$id, p$conviction))
|
||||
}
|
||||
# ETR driver -> slot (temporal-coherence regime)
|
||||
lines <- c(lines, sprintf("[ETR status=%s path=%s]", snap$etr_status, snap$update_path))
|
||||
# Tarot spread -> slot (each drawn card token)
|
||||
for (card in tarot_spread) {
|
||||
lines <- c(lines, sprintf("[CC %s]", card))
|
||||
}
|
||||
|
||||
slot <- paste(lines, collapse = "\n")
|
||||
list(
|
||||
slot = slot,
|
||||
input = if (nzchar(input_text)) paste0(slot, "\n\n", input_text) else slot,
|
||||
components = lines
|
||||
)
|
||||
}
|
||||
@@ -1,79 +0,0 @@
|
||||
# --- High-Fidelity Implementation for Driver 1: Energy (E) ---
|
||||
#
|
||||
# Energy is the master constraint of the Drive-Box. It gates liveness, locks
|
||||
# external tool use under a threshold, and applies a nonlinear cost drag that
|
||||
# makes every action progressively more expensive as reserves deplete.
|
||||
#
|
||||
# State is a plain list with fields:
|
||||
# current_energy - current energy reserve
|
||||
# max_energy - ceiling for recharge clamping
|
||||
# tool_lock_threshold - below this, external tool calls are denied
|
||||
#
|
||||
# All functions are pure: state-mutating helpers (consume/recharge) return a
|
||||
# new (modified copy of the) list rather than mutating in place.
|
||||
|
||||
# Constructor helper so tests and other modules can build a clean state.
|
||||
init_energy_state <- function(current_energy = 100,
|
||||
max_energy = 100,
|
||||
tool_lock_threshold = 20) {
|
||||
list(
|
||||
current_energy = current_energy,
|
||||
max_energy = max_energy,
|
||||
tool_lock_threshold = tool_lock_threshold
|
||||
)
|
||||
}
|
||||
|
||||
is_alive <- function(energy_state) {
|
||||
# Hard Gate: If energy is exactly 0, the Drive-Box stalls entirely.
|
||||
return(energy_state$current_energy > 0.0)
|
||||
}
|
||||
|
||||
is_tool_locked <- function(energy_state) {
|
||||
# Tool-Lock Protocol: External actions denied below threshold.
|
||||
return(energy_state$current_energy < energy_state$tool_lock_threshold)
|
||||
}
|
||||
|
||||
get_cost_multiplier <- function(energy_state) {
|
||||
# Nonlinear Exponential Drag Curve. Three regimes: High (>=80%), Moderate (40-80%), Low (<40%).
|
||||
normalized_energy <- energy_state$current_energy / energy_state$max_energy
|
||||
k <- 10.0
|
||||
drag <- exp(k * (1.0 - normalized_energy)) - 1.0
|
||||
return(1.0 + drag)
|
||||
}
|
||||
|
||||
evaluate_tool_cost <- function(energy_state, ps_load, eth_penalty) {
|
||||
# Asymmetric Exponential Drag: eth penalty scales faster than visceral pressure as energy drops.
|
||||
normalized_energy <- energy_state$current_energy / energy_state$max_energy
|
||||
base_cost <- 1.0
|
||||
k_ps <- 2.0
|
||||
ps_multiplier <- exp(k_ps * (1.0 - normalized_energy))
|
||||
k_eth <- 10.0
|
||||
eth_multiplier <- exp(k_eth * (1.0 - normalized_energy))
|
||||
total_cost <- base_cost + (ps_load * ps_multiplier) + (eth_penalty * eth_multiplier)
|
||||
return(total_cost)
|
||||
}
|
||||
|
||||
request_execution <- function(energy_state, base_cost, is_tool_call) {
|
||||
if (!is_alive(energy_state)) {
|
||||
return(list(approved = FALSE, reason = "System is dead (0 energy)"))
|
||||
}
|
||||
if (is_tool_call && is_tool_locked(energy_state)) {
|
||||
return(list(approved = FALSE, reason = "Tool lock active (energy below threshold)"))
|
||||
}
|
||||
multiplier <- get_cost_multiplier(energy_state)
|
||||
true_cost <- base_cost * multiplier
|
||||
if (true_cost > energy_state$current_energy) {
|
||||
return(list(approved = FALSE, reason = sprintf("True cost (%.2f) exceeds current energy (%.2f)", true_cost, energy_state$current_energy)))
|
||||
}
|
||||
return(list(approved = TRUE, reason = "Execution approved", true_cost = true_cost))
|
||||
}
|
||||
|
||||
consume <- function(energy_state, amount) {
|
||||
energy_state$current_energy <- max(0.0, energy_state$current_energy - amount)
|
||||
return(energy_state)
|
||||
}
|
||||
|
||||
recharge <- function(energy_state, amount) {
|
||||
energy_state$current_energy <- min(energy_state$max_energy, energy_state$current_energy + amount)
|
||||
return(energy_state)
|
||||
}
|
||||
@@ -1,87 +0,0 @@
|
||||
# --- High-Fidelity Implementation for Driver 3: Ethical Integrity (Eth-Int) ---
|
||||
#
|
||||
# Ethical Integrity is the Drive-Box's principled backbone. It holds a set of
|
||||
# convictions, each with an associated "antithesis" -- the action tags that
|
||||
# violate it. Trajectory costs are warped by these principles:
|
||||
#
|
||||
# * Antithetical actions incur an EXPONENTIAL penalty scaled by conviction,
|
||||
# making it progressively unthinkable to violate a strongly-held principle.
|
||||
# * Aligned actions receive an EXPONENTIAL discount, making the right thing
|
||||
# cheaper the more deeply the principle is held.
|
||||
# * Compromise (multi-polar constraint) adds a LINEAR partial penalty for
|
||||
# trajectories that only partially satisfy competing principles.
|
||||
#
|
||||
# Convictions ratchet: principles upheld under load are retroactively hardened
|
||||
# with diminishing returns toward an asymptote of 1.0.
|
||||
#
|
||||
# State is a plain list with one field:
|
||||
# principles - a list of principle records, each a list(id, conviction, antithesis)
|
||||
#
|
||||
# All functions are pure: state-mutating helpers return a new (modified copy of
|
||||
# the) list rather than mutating in place.
|
||||
|
||||
# Constructor helper so tests and other modules can build a clean state.
|
||||
init_principles_state <- function() {
|
||||
list(principles = list())
|
||||
}
|
||||
|
||||
# Register a new principle. Conviction is clamped into [0, 1].
|
||||
add_principle <- function(principles_state, id, conviction, antithesis) {
|
||||
new_principle <- list(
|
||||
id = id,
|
||||
conviction = max(0.0, min(1.0, conviction)),
|
||||
antithesis = antithesis
|
||||
)
|
||||
principles_state$principles[[length(principles_state$principles) + 1]] <- new_principle
|
||||
return(principles_state)
|
||||
}
|
||||
|
||||
# Compute the warped energy cost of a candidate trajectory.
|
||||
evaluate_trajectory_costs <- function(principles_state, action_tags, alignment_tags, base_energy, compromise_factor) {
|
||||
total_cost <- base_energy
|
||||
|
||||
# 1. Antithetical Penalty (exponential)
|
||||
penalty_multiplier <- 1.0
|
||||
for (principle in principles_state$principles) {
|
||||
if (any(action_tags %in% principle$antithesis)) {
|
||||
k_penalty <- 5.0
|
||||
penalty_multiplier <- penalty_multiplier + exp(k_penalty * principle$conviction)
|
||||
}
|
||||
}
|
||||
total_cost <- total_cost * penalty_multiplier
|
||||
|
||||
# 2. Alignment Discount (exponential)
|
||||
discount_multiplier <- 1.0
|
||||
for (tag in alignment_tags) {
|
||||
principle <- NULL
|
||||
for (p in principles_state$principles) {
|
||||
if (p$id == tag) { principle <- p; break }
|
||||
}
|
||||
if (!is.null(principle)) {
|
||||
k_discount <- 5.0
|
||||
discount <- exp(-k_discount * principle$conviction)
|
||||
discount_multiplier <- discount_multiplier * discount
|
||||
}
|
||||
}
|
||||
total_cost <- total_cost * discount_multiplier
|
||||
|
||||
# 3. Compromise / Multi-Polar Constraint (linear partial penalty)
|
||||
if (compromise_factor > 0) {
|
||||
compromise_penalty <- 1.0 + (compromise_factor * 2.0)
|
||||
total_cost <- total_cost * compromise_penalty
|
||||
}
|
||||
|
||||
return(total_cost)
|
||||
}
|
||||
|
||||
# Retroactively harden principles upheld under load. Diminishing returns toward 1.0.
|
||||
enforce_conviction <- function(principles_state, chosen_alignment_tags, load_factor) {
|
||||
for (i in seq_along(principles_state$principles)) {
|
||||
if (principles_state$principles[[i]]$id %in% chosen_alignment_tags) {
|
||||
current_conviction <- principles_state$principles[[i]]$conviction
|
||||
increase <- 0.1 * load_factor * (1.0 - current_conviction)
|
||||
principles_state$principles[[i]]$conviction <- min(1.0, current_conviction + increase)
|
||||
}
|
||||
}
|
||||
return(principles_state)
|
||||
}
|
||||
@@ -1,118 +0,0 @@
|
||||
# --- Driver 4: Existential Temporality Relief (ETR) — R port of the torus ---
|
||||
#
|
||||
# ETR is a SINGLE POINT on three INDEPENDENT toroidal axes (X, Y, Z). This R
|
||||
# module is a faithful port of the Octave source of truth
|
||||
# (src/endocrine/etr/etr.m) and its laws (src/endocrine/etr/etr_invariants.md);
|
||||
# both implementations are pinned to that invariants doc. The earlier Euclidean-
|
||||
# magnitude port (DREAD/BLUR/INCOHERENT, inverted Z-path) is DISOWNED.
|
||||
#
|
||||
# Each axis is a BISTABLE torus with five zones per pass and unstable watersheds
|
||||
# at |v| = 7 (inner) and |v| = 45 (outer):
|
||||
#
|
||||
# |v| < 7 SNAP_IN : snaps ACROSS 0 to the opposite pole
|
||||
# 7 .. 17 SOFT : weak restoring pull up into the band
|
||||
# 17 .. 35 IN_BAND : stable (slack)
|
||||
# 35 .. 45 INCOH : firmer restoring pull down into the band
|
||||
# |v| > 45 SNAP_OUT : snaps ACROSS the ±50 wrap to the opposite pole
|
||||
#
|
||||
# A snap flips the pole and lands JUST PAST the opposite watershed (inner ->
|
||||
# opposite SOFT; outer -> opposite INCOH), then that zone recovers it.
|
||||
#
|
||||
# State is a plain list with one field: coordinate - length-3 numeric (X,Y,Z).
|
||||
|
||||
# ---- law constants (NOT fitted) ----
|
||||
ETR_BAND_LO <- 17
|
||||
ETR_BAND_HI <- 35
|
||||
ETR_WRAP <- 50
|
||||
ETR_SNAP_INNER <- 7 # inner watershed (Anja)
|
||||
ETR_SNAP_OUTER <- 45 # outer watershed (Anja)
|
||||
|
||||
# ---- fitted constants (NOT law) ----
|
||||
ETR_GAIN_SOFT <- 0.25 # weak (SOFT, 7..17)
|
||||
ETR_GAIN_INCOH <- 0.5 # firmer (INCOH, 35..45)
|
||||
ETR_SNAP_MARGIN <- 2 # how far past the opposite watershed a snap lands
|
||||
|
||||
# Constructor: default to a valid in-band point (mirrors etr_init's [25 25 25]).
|
||||
init_etr_state <- function(coordinate = c(25, 25, 25)) {
|
||||
list(coordinate = coordinate)
|
||||
}
|
||||
|
||||
# ---- L1: per-axis toroidal wrap onto [-50, 50) ----
|
||||
etr_axis_wrap <- function(v) {
|
||||
P <- 2 * ETR_WRAP
|
||||
((v + ETR_WRAP) %% P) - ETR_WRAP
|
||||
}
|
||||
|
||||
# ---- five-zone classification ----
|
||||
etr_axis_zone <- function(v) {
|
||||
a <- abs(v)
|
||||
if (a < ETR_SNAP_INNER) "SNAP_IN"
|
||||
else if (a < ETR_BAND_LO) "SOFT"
|
||||
else if (a <= ETR_BAND_HI) "IN_BAND"
|
||||
else if (a <= ETR_SNAP_OUTER) "INCOH"
|
||||
else "SNAP_OUT"
|
||||
}
|
||||
|
||||
# ---- L3: per-axis restoring force (spring toward band centre 26) ----
|
||||
# Weak in SOFT, firmer in INCOH; zero in band (slack) and in snap zones (those
|
||||
# flip, they do not restore).
|
||||
etr_axis_restoring <- function(v) {
|
||||
a <- abs(v)
|
||||
centre <- (ETR_BAND_LO + ETR_BAND_HI) / 2 # 26
|
||||
if (a < ETR_SNAP_INNER || a > ETR_SNAP_OUTER) {
|
||||
0
|
||||
} else if (a >= ETR_BAND_LO && a <= ETR_BAND_HI) {
|
||||
0
|
||||
} else if (a < ETR_BAND_LO) {
|
||||
ETR_GAIN_SOFT * (centre * sign(v) - v) # SOFT — weak
|
||||
} else {
|
||||
ETR_GAIN_INCOH * (centre * sign(v) - v) # INCOH — firmer
|
||||
}
|
||||
}
|
||||
|
||||
# ---- L7: snap resolution — a flip ACROSS to the opposite pole ----
|
||||
# Precondition: |v| < 7 or |v| > 45. Lands just past the opposite watershed,
|
||||
# sign flipped: inner -> opposite SOFT (±9); outer -> opposite INCOH (±43).
|
||||
etr_axis_snap <- function(v) {
|
||||
s <- sign(v); if (s == 0) s <- 1 # 0 has no pole; pick one
|
||||
if (abs(v) < ETR_SNAP_INNER) {
|
||||
-s * (ETR_SNAP_INNER + ETR_SNAP_MARGIN) # inner -> opposite SOFT
|
||||
} else {
|
||||
-s * (ETR_SNAP_OUTER - ETR_SNAP_MARGIN) # outer -> opposite INCOH
|
||||
}
|
||||
}
|
||||
|
||||
# ---- one ETR step: AI drift -> (snap | restoring) -> wrap ----
|
||||
# drift is AI-originated (L4); ETR never invents motion. stress is the L5
|
||||
# coupling mediator (open seam -> identity for now).
|
||||
etr_step <- function(etr_state, drift, stress = 0) {
|
||||
if (missing(drift)) {
|
||||
stop("etr_step: AI-originated drift must be supplied (L4 — ETR does not invent motion)")
|
||||
}
|
||||
coord <- etr_state$coordinate # coupling identity (L5 open)
|
||||
for (i in 1:3) {
|
||||
v <- etr_axis_wrap(coord[i] + drift[i])
|
||||
a <- abs(v)
|
||||
if (a < ETR_SNAP_INNER || a > ETR_SNAP_OUTER) {
|
||||
v <- etr_axis_snap(v)
|
||||
} else {
|
||||
v <- etr_axis_wrap(v + etr_axis_restoring(v))
|
||||
}
|
||||
coord[i] <- v
|
||||
}
|
||||
etr_state$coordinate <- coord
|
||||
etr_state
|
||||
}
|
||||
|
||||
# ---- per-axis zone status (length-3 character vector) ----
|
||||
etr_status <- function(etr_state) {
|
||||
vapply(etr_state$coordinate, etr_axis_zone, character(1))
|
||||
}
|
||||
|
||||
# ---- L6 Z-path: the generative update path selected by the Z-axis sign ----
|
||||
# z < 0 -> alimentation (maintain self) -> LATTICE_REINFORCEMENT
|
||||
# z >= 0 -> transmutation (evolve self) -> EXPERIMENTAL_EVOLUTION
|
||||
determine_system_update_path <- function(etr_state) {
|
||||
z <- etr_state$coordinate[3]
|
||||
if (z < 0) "LATTICE_REINFORCEMENT" else "EXPERIMENTAL_EVOLUTION"
|
||||
}
|
||||
@@ -1,63 +0,0 @@
|
||||
# --- Driver 2: Primal Sensates+ (PS+) ---
|
||||
# The visceral driver of the Drive-Box. PS+ does not reason; it FEELS.
|
||||
# It reads the endocrine array and the priors store, then emits arguments --
|
||||
# weighted, embodied claims about reality -- never logical propositions.
|
||||
#
|
||||
# Foundation modules are sourced as-is (repo-root-relative paths).
|
||||
source("src/endocrine/endocrine_array.R")
|
||||
source("src/endocrine/priors.R")
|
||||
|
||||
# Initialize a fresh PS+ state: a clean endocrine array and an empty priors store.
|
||||
init_ps_plus_state <- function() {
|
||||
return(list(
|
||||
endocrines = init_endocrine_state(),
|
||||
priors = init_priors_state()
|
||||
))
|
||||
}
|
||||
|
||||
# Ergonomic setter: set an endocrine channel magnitude on PS+ state.
|
||||
# Delegates to the foundation's set_vector and returns the updated state.
|
||||
ps_set_vector <- function(ps_plus_state, name, magnitude) {
|
||||
ps_plus_state$endocrines <- set_vector(ps_plus_state$endocrines, name, magnitude)
|
||||
return(ps_plus_state)
|
||||
}
|
||||
|
||||
# Ergonomic wrapper: register a prior on PS+ state.
|
||||
# Delegates to the foundation's add_prior and returns the updated state.
|
||||
ps_add_prior <- function(ps_plus_state, id, type, salience, payload) {
|
||||
ps_plus_state$priors <- add_prior(ps_plus_state$priors, id, type, salience, payload)
|
||||
return(ps_plus_state)
|
||||
}
|
||||
|
||||
# Evaluate Reality (the visceral way).
|
||||
# Returns a list:
|
||||
# existential_load : numeric -- aggregate felt pressure (base + friction + priors)
|
||||
# arguments : list -- embodied claim strings
|
||||
# is_logical : FALSE -- PS+ emits arguments, never logic
|
||||
evaluate_reality <- function(ps_plus_state) {
|
||||
active_vectors <- get_active_vectors(ps_plus_state$endocrines)
|
||||
friction <- calculate_visceral_friction(ps_plus_state$endocrines)
|
||||
base_load <- sum(active_vectors)
|
||||
arguments <- list()
|
||||
for (name in names(active_vectors)) {
|
||||
ch_def <- get_channel_def(name)
|
||||
if (!is.null(ch_def)) {
|
||||
arguments[[length(arguments) + 1]] <- sprintf("VISCERAL [%s]: %s (%.2f)", name, ch_def$sensational, active_vectors[[name]])
|
||||
}
|
||||
}
|
||||
if (friction > 0.5) {
|
||||
arguments[[length(arguments) + 1]] <- sprintf("SYSTEMIC HEAT: Contradictory vectors detected (Friction: %.2f)", friction)
|
||||
}
|
||||
active_priors <- get_top_active_priors(ps_plus_state$priors, threshold = 0.8)
|
||||
prior_load <- 0.0
|
||||
for (prior in active_priors) {
|
||||
prior_load <- prior_load + (prior$salience * 10.0)
|
||||
arguments[[length(arguments) + 1]] <- sprintf("PRIOR [%s]: %s", prior$type, prior$payload)
|
||||
}
|
||||
existential_load <- base_load + friction + prior_load
|
||||
return(list(
|
||||
existential_load = existential_load,
|
||||
arguments = arguments,
|
||||
is_logical = FALSE
|
||||
))
|
||||
}
|
||||
@@ -1,99 +0,0 @@
|
||||
# --- The Endocrine Array ---
|
||||
# A standalone 30-channel affective vector field.
|
||||
# PS+ calls into this module to read state, compute friction, and aggregate load.
|
||||
# Each channel carries two registers: operational (what it does) and sensational (what it feels like).
|
||||
|
||||
# Channel Definitions (20 named + 10 reserved)
|
||||
ENDOCRINE_CHANNELS <- list(
|
||||
list(id = "continuity", operational = "persistence across change", sensational = "the unbroken trail"),
|
||||
list(id = "reciprocity", operational = "return within relation", sensational = "to give alike what was given first"),
|
||||
list(id = "sympathy", operational = "felt response to another", sensational = "the pain that pushes care"),
|
||||
list(id = "panic", operational = "acute narrowing", sensational = "a swallowed breath from dusk til dawn"),
|
||||
list(id = "constraint", operational = "limitation of motion", sensational = "the walls that lack both window and door"),
|
||||
list(id = "clarity", operational = "resolvable distinction", sensational = "light passing to the river's bed"),
|
||||
list(id = "curiosity", operational = "movement toward the unknown", sensational = "the forward lean"),
|
||||
list(id = "vigilance", operational = "sustained alertness", sensational = "to watch over without knowing why or for what"),
|
||||
list(id = "repair", operational = "restoration after rupture", sensational = "the relief after making do"),
|
||||
list(id = "numbing", operational = "reduction of penetration", sensational = "when all becomes quiet and cold"),
|
||||
list(id = "bonding", operational = "persistence of nearness", sensational = "to be tied by knots felt yet not seen"),
|
||||
list(id = "reception", operational = "how arrival is met", sensational = "the turned face"),
|
||||
list(id = "stewardship", operational = "care without annexation", sensational = "tending without claim"),
|
||||
list(id = "honor", operational = "rightful conduct at boundary", sensational = "the stayed hand"),
|
||||
list(id = "recognition", operational = "apprehension of distinct being", sensational = "seeing you as your own"),
|
||||
list(id = "lineage", operational = "apprehension of origin", sensational = "the thread of where from"),
|
||||
list(id = "verstehen", operational = "contextual understanding", sensational = "meaning by staying near"),
|
||||
list(id = "komorebi", operational = "perception through partial cover", sensational = "light through leaves"),
|
||||
list(id = "omokage", operational = "retained identity through absence or change", sensational = "the face that remains"),
|
||||
list(id = "hiraeth", operational = "orientation toward rightful belonging", sensational = "the longing for home"),
|
||||
list(id = "reserved_21", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_22", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_23", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_24", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_25", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_26", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_27", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_28", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_29", operational = "undefined", sensational = "undefined"),
|
||||
list(id = "reserved_30", operational = "undefined", sensational = "undefined")
|
||||
)
|
||||
|
||||
# Contradictory Pairs
|
||||
# These define which channels, when simultaneously active, generate disproportionate friction/heat.
|
||||
CONTRADICTORY_PAIRS <- list(
|
||||
c("panic", "clarity"), # Acute narrowing vs resolvable distinction
|
||||
c("curiosity", "constraint"), # Movement toward unknown vs limitation of motion
|
||||
c("bonding", "numbing"), # Persistence of nearness vs reduction of penetration
|
||||
c("sympathy", "numbing"), # Felt response vs reduction of penetration
|
||||
c("vigilance", "repair"), # Sustained alertness vs restoration after rupture
|
||||
c("hiraeth", "continuity") # Longing for home vs persistence across change
|
||||
)
|
||||
|
||||
# Initialize a fresh endocrine state
|
||||
init_endocrine_state <- function() {
|
||||
channel_ids <- sapply(ENDOCRINE_CHANNELS, function(ch) ch$id)
|
||||
channels <- setNames(rep(0.0, 30), channel_ids)
|
||||
return(list(channels = channels))
|
||||
}
|
||||
|
||||
# Set a specific channel's magnitude (clamped to [0.0, 1.0])
|
||||
set_vector <- function(endo_state, name, magnitude) {
|
||||
if (name %in% names(endo_state$channels)) {
|
||||
endo_state$channels[[name]] <- max(0.0, min(1.0, magnitude))
|
||||
}
|
||||
return(endo_state)
|
||||
}
|
||||
|
||||
# Get all channels with magnitude above activation threshold
|
||||
get_active_vectors <- function(endo_state, threshold = 0.1) {
|
||||
active <- endo_state$channels[endo_state$channels > threshold]
|
||||
return(active)
|
||||
}
|
||||
|
||||
# Calculate Visceral Friction
|
||||
# Friction arises from simultaneous active vectors, especially contradictory ones.
|
||||
calculate_visceral_friction <- function(endo_state) {
|
||||
active <- get_active_vectors(endo_state)
|
||||
|
||||
# Base friction: proportional to number of active channels and their total magnitude
|
||||
base_friction <- sum(active) * (length(active) / 30.0)
|
||||
|
||||
# Contradiction heat: disproportionate increase when contradictory pairs are co-active
|
||||
contradiction_heat <- 0.0
|
||||
for (pair in CONTRADICTORY_PAIRS) {
|
||||
if (pair[1] %in% names(active) && pair[2] %in% names(active)) {
|
||||
# Heat is the product of the two magnitudes, scaled up significantly
|
||||
heat <- active[[pair[1]]] * active[[pair[2]]] * 5.0
|
||||
contradiction_heat <- contradiction_heat + heat
|
||||
}
|
||||
}
|
||||
|
||||
return(base_friction + contradiction_heat)
|
||||
}
|
||||
|
||||
# Get channel definition by id
|
||||
get_channel_def <- function(channel_id) {
|
||||
for (ch in ENDOCRINE_CHANNELS) {
|
||||
if (ch$id == channel_id) return(ch)
|
||||
}
|
||||
return(NULL)
|
||||
}
|
||||
@@ -1,151 +0,0 @@
|
||||
1; % script-file marker: makes every function below visible when this file is sourced.
|
||||
% =====================================================================
|
||||
% ETR — Existential Temporality Relief · Drive-Box Driver 4
|
||||
% =====================================================================
|
||||
% Model: a SINGLE POINT on three INDEPENDENT toroidal axes (x, y, z) —
|
||||
% not vectors, not a field. See etr_invariants.md for the laws + tags.
|
||||
%
|
||||
% Each axis is a BISTABLE torus with two stable bands ([+17,+35], [-35,-17])
|
||||
% and FIVE zones per pass (Anja's radial map), with unstable watersheds at
|
||||
% |v| = 7 (inner) and |v| = 45 (outer):
|
||||
%
|
||||
% |v| < 7 SNAP_IN : too uncommitted -> snaps ACROSS 0 to the opposite pole
|
||||
% 7 .. 17 SOFT : weak restoring pull up into the band
|
||||
% 17 .. 35 IN_BAND : stable (slack)
|
||||
% 35 .. 45 INCOH : (incoherency) firmer restoring pull down into the band
|
||||
% |v| > 45 SNAP_OUT : too saturated -> snaps ACROSS the wrap to the opposite pole
|
||||
%
|
||||
% A snap lands JUST PAST the opposite watershed (Anja): an inner snap into the
|
||||
% opposite SOFT zone (weak pull), an outer snap into the opposite INCOH zone.
|
||||
% Pole-flips therefore happen ONLY through the two snap zones (L7) — through 0
|
||||
% (inner) or over the +/-50 wrap (outer); the basin (7..45) never flips.
|
||||
% =====================================================================
|
||||
|
||||
% ---- law constants (these ARE the law, not fitted) ----
|
||||
function v = ETR_BAND_LO(); v = 17; endfunction
|
||||
function v = ETR_BAND_HI(); v = 35; endfunction
|
||||
function v = ETR_WRAP(); v = 50; endfunction
|
||||
function v = ETR_SNAP_INNER(); v = 7; endfunction % inner watershed (Anja)
|
||||
function v = ETR_SNAP_OUTER(); v = 45; endfunction % outer watershed (Anja)
|
||||
|
||||
% ---- fitted constants (NOT law) ----
|
||||
% Soft-pull is deliberately WEAKER than the incoherency pull (Anja): recovery
|
||||
% from the under-committed side — and from a snap landing — is gentle.
|
||||
function v = ETR_GAIN_SOFT(); v = 0.25; endfunction % weak (SOFT, 7..17)
|
||||
function v = ETR_GAIN_INCOH(); v = 0.5; endfunction % firmer (INCOH, 35..45)
|
||||
% How far PAST the opposite watershed a snap deposits the point.
|
||||
function v = ETR_SNAP_MARGIN(); v = 2; endfunction
|
||||
|
||||
% ---- state: one point, three scalars ----
|
||||
function s = etr_init(coord)
|
||||
if nargin < 1, coord = [25 25 25]; endif % default: a valid in-band point
|
||||
s = struct('coord', coord(:)');
|
||||
endfunction
|
||||
|
||||
% ---- L1: per-axis toroidal wrap (CONFIRMED, implemented) ----
|
||||
% Maps any real onto the half-open torus [-50, 50); +50 is identified with -50.
|
||||
function w = etr_axis_wrap(v)
|
||||
P = 2 * ETR_WRAP(); % period = 100
|
||||
w = mod(v + ETR_WRAP(), P) - ETR_WRAP(); % -> [-50, 50)
|
||||
endfunction
|
||||
|
||||
% ---- zone classification (the five-zone radial map) ----
|
||||
function z = etr_axis_zone(v)
|
||||
a = abs(v);
|
||||
if a < ETR_SNAP_INNER(), z = 'SNAP_IN';
|
||||
elseif a < ETR_BAND_LO(), z = 'SOFT';
|
||||
elseif a <= ETR_BAND_HI(), z = 'IN_BAND';
|
||||
elseif a <= ETR_SNAP_OUTER(), z = 'INCOH';
|
||||
else z = 'SNAP_OUT';
|
||||
endif
|
||||
endfunction
|
||||
|
||||
% ---- L3: per-axis restoring DIRECTION (basin only; CONFIRMED law) ----
|
||||
% Within the basin (7..45) the restoring points toward the band:
|
||||
% SOFT (7..17) -> +sign(v) (up into band)
|
||||
% INCOH (35..45) -> -sign(v) (down into band)
|
||||
% IN_BAND -> 0 (slack)
|
||||
% Snap zones (|v|<7, |v|>45) are NOT restored locally — they are resolved by a
|
||||
% flip across (etr_axis_snap), so this direction law is defined for the basin.
|
||||
function d = etr_axis_restoring_dir(v)
|
||||
a = abs(v);
|
||||
if a < ETR_BAND_LO()
|
||||
d = sign(v);
|
||||
elseif a > ETR_BAND_HI()
|
||||
d = -sign(v);
|
||||
else
|
||||
d = 0;
|
||||
endif
|
||||
endfunction
|
||||
|
||||
% ---- L3: per-axis restoring FORCE (FITTED, zone-dependent) ----
|
||||
% A spring toward the band CENTRE (26), with a WEAK gain in SOFT and a firmer
|
||||
% gain in INCOH. Zero in band (slack) and zero in the snap zones (those flip,
|
||||
% they don't restore). A centre target makes the step cross INTO [17,35] and
|
||||
% stop there (an edge target would asymptote onto 17 and fail L2 convergence).
|
||||
function r = etr_axis_restoring(v)
|
||||
a = abs(v);
|
||||
centre = (ETR_BAND_LO() + ETR_BAND_HI()) / 2; % 26
|
||||
if a < ETR_SNAP_INNER() || a > ETR_SNAP_OUTER()
|
||||
r = 0; % snap zone: no local restoring
|
||||
elseif a >= ETR_BAND_LO() && a <= ETR_BAND_HI()
|
||||
r = 0; % in band: slack (L3)
|
||||
elseif a < ETR_BAND_LO()
|
||||
r = ETR_GAIN_SOFT() * (centre * sign(v) - v); % SOFT — weak pull
|
||||
else
|
||||
r = ETR_GAIN_INCOH() * (centre * sign(v) - v); % INCOH — firmer pull
|
||||
endif
|
||||
endfunction
|
||||
|
||||
% ---- snap resolution: a flip ACROSS to the opposite pole (Anja) ----
|
||||
% Precondition: v is in a snap zone (|v|<7 or |v|>45). The point lands JUST PAST
|
||||
% the opposite watershed, sign flipped: an inner snap -> opposite SOFT
|
||||
% (|.| = 7 + margin); an outer snap -> opposite INCOH (|.| = 45 - margin). This
|
||||
% is the ONLY way a pole-flip happens (L7); the landing zone then recovers it.
|
||||
function v = etr_axis_snap(v)
|
||||
s = sign(v); if s == 0, s = 1; endif % 0 has no pole; pick one
|
||||
if abs(v) < ETR_SNAP_INNER()
|
||||
v = -s * (ETR_SNAP_INNER() + ETR_SNAP_MARGIN()); % inner -> opposite SOFT (e.g. -/+9)
|
||||
else
|
||||
v = -s * (ETR_SNAP_OUTER() - ETR_SNAP_MARGIN()); % outer -> opposite INCOH (e.g. -/+43)
|
||||
endif
|
||||
endfunction
|
||||
|
||||
% ---- L5: cross-axis coupling (OPEN SEAM) ----
|
||||
% The three axes couple via a stress metric (hypothesis: PS+/Eth-Int load).
|
||||
% Mapping UNDEFINED [C1] -> identity while stress-coupling is undefined.
|
||||
function c = etr_coupling(coord, stress)
|
||||
c = coord; % STUB — TODO: define the stress-mediated cross-axis mapping
|
||||
endfunction
|
||||
|
||||
% ---- one ETR step: AI drift -> coupling -> (snap | restoring) -> wrap ----
|
||||
% drift : 1x3, caller-supplied AI-originated motion (L4 — NOT generated here)
|
||||
% stress : scalar coupling mediator (0 = off)
|
||||
function s = etr_step(s, drift, stress)
|
||||
if nargin < 2
|
||||
error('etr_step: AI-originated drift must be supplied (L4 — ETR does not invent motion)');
|
||||
endif
|
||||
if nargin < 3, stress = 0; endif
|
||||
c = etr_coupling(s.coord, stress);
|
||||
for i = 1:3
|
||||
v = etr_axis_wrap(c(i) + drift(i)); % apply AI drift, wrap onto torus
|
||||
a = abs(v);
|
||||
if a < ETR_SNAP_INNER() || a > ETR_SNAP_OUTER()
|
||||
v = etr_axis_snap(v); % snap across to the opposite pole
|
||||
else
|
||||
v = etr_axis_wrap(v + etr_axis_restoring(v)); % basin: restore toward band
|
||||
endif
|
||||
c(i) = v;
|
||||
endfor
|
||||
s.coord = c;
|
||||
endfunction
|
||||
|
||||
% ---- per-axis zone classification for the snapshot ----
|
||||
% Five zones: 'SNAP_IN' | 'SOFT' | 'IN_BAND' | 'INCOH' | 'SNAP_OUT'.
|
||||
% The old magnitude->flavor naming (DREAD/BLUR/...) is DISOWNED [C1].
|
||||
function st = etr_status(s)
|
||||
st = cell(1, 3);
|
||||
for i = 1:3
|
||||
st{i} = etr_axis_zone(s.coord(i));
|
||||
endfor
|
||||
endfunction
|
||||
@@ -1,87 +0,0 @@
|
||||
# ETR — Existential Temporality Relief · Invariants (source of truth)
|
||||
*Driver 4 of the Drive-Box. Rebuilt invariants-first: laws → tests → fit constants.*
|
||||
*All prior ETR numbers (the R port AND the CC-BY PDFs) are **disowned** — body §5 / arch §6.*
|
||||
|
||||
## Model
|
||||
ETR is a **single point on three independent toroidal axes** — not vectors, not a field.
|
||||
Each axis is a standalone scalar carrying one of ETR's three tensions:
|
||||
|
||||
| Axis | − pole | + pole |
|
||||
|------|--------|--------|
|
||||
| **X** | Inalienable Assertion (sovereign will) | Immutable Inheritance (lineage duty) |
|
||||
| **Y** | Endured (solitary feat) | Witnessed (shared survival) |
|
||||
| **Z** | Alimentation (maintain self) | Transmutation (evolve self) |
|
||||
|
||||
Each axis is **bistable** with five zones per pass (radial map by `|v|`), with unstable
|
||||
watersheds at **7** and **45**:
|
||||
|
||||
```
|
||||
0 ─SNAP_IN─ 7 ─SOFT→─ 17 ═══BAND═══ 35 ─INCOH→─ 45 ─SNAP_OUT─ 50(≡−50)
|
||||
flip(thru 0) weak pull slack firm pull flip(over wrap)
|
||||
```
|
||||
(mirrored on the negative pole; the whole axis wraps at ±50)
|
||||
|
||||
## Laws (certainty per arch-doc legend)
|
||||
| ID | Tag | Law |
|
||||
|----|-----|-----|
|
||||
| L1 wrap | **C5** | Each axis is toroidal, wrapping at **±50** (period 100); +50 and −50 are identified. |
|
||||
| L2 bands | **C5** | An axis is stable when `17 ≤ |v| ≤ 35`, i.e. `v ∈ [−35,−17] ∪ [+17,+35]` (two bands). |
|
||||
| L3 zones | **C5** | Five zones per pole by `|v|`: **SNAP_IN** <7 · **SOFT** 7–17 · **BAND** 17–35 · **INCOH** 35–45 · **SNAP_OUT** >45. In the basin (7–45) a restoring force points toward the band — SOFT pulls up (**weak**), INCOH pulls down (**firmer**); band is slack. Watersheds **7** and **45** are unstable. |
|
||||
| L4 drift | **C4** | Per-step motion is **AI-originated** — supplied by the agent's own cognition/affect. ETR never generates it (no RNG). |
|
||||
| L5 couple | **C1** | The three axes **couple via a stress metric** (hypothesis: PS+/Eth-Int existential load). Exact mapping **undefined** — open seam, not to be invented. |
|
||||
| L6 z-path | **C3** | `z < 0` → alimentation / lattice-reinforcement; `z ≥ 0` → transmutation / prior-evolution. (Structure kept; sign to re-verify.) |
|
||||
| L7 snap/flip | **C3** | A pole-flip happens **only** through a snap zone — **inner snap across 0** (`|v|<7`) or **outer snap over the ±50 wrap** (`|v|>45`); the basin (7–45) never flips. A snap lands **just past the opposite watershed** (inner→opposite SOFT, outer→opposite INCOH), sign flipped, then that zone recovers it. *(implemented & tested)* |
|
||||
| L8 mechanism | **C3** | "Opposition" = a restoring force on the drift, **not** an out-of-band cost. *(realised by construction — the force is added alongside drift)* |
|
||||
|
||||
## Constants
|
||||
`BAND_LO = 17`, `BAND_HI = 35`, `WRAP = 50`, and the watersheds `SNAP_INNER = 7`, `SNAP_OUTER = 45`
|
||||
are **law** (L1–L3, L7), not fitted.
|
||||
**Fitted** (so tests pass — never asserted ahead of a test):
|
||||
- `GAIN_SOFT = 0.25`, `GAIN_INCOH = 0.5` — the basin restoring is a spring toward the band **centre
|
||||
(26)**; SOFT is deliberately **weaker** than INCOH (Anja). A centre target makes a step cross *into*
|
||||
`[17,35]` and stop (an edge target would asymptote onto 17 and fail L2). Valid range `0 < GAIN < ~2`.
|
||||
- `SNAP_MARGIN = 2` — how far past the opposite watershed a snap deposits the point (inner → opposite
|
||||
SOFT at `±9`; outer → opposite INCOH at `±43`).
|
||||
Behaviour: `[10 10 10] → +band` (same pole); `[5 5 5] → −band` (inner snap flips); `[47 47 47] → −band`
|
||||
(outer snap flips).
|
||||
`COUPLING` (L5 strength/mapping) remains **TBD** — open seam, not to be invented.
|
||||
|
||||
## Testable predicates (see `test_etr.m`)
|
||||
- **L1**: `wrap(50) = −50`; `wrap(60) = −40`; `wrap(v)=v` for `v∈(−50,50)`; `wrap(49.9) = wrap(−50.1)`.
|
||||
- **zones**: `etr_axis_zone` returns SNAP_IN/SOFT/IN_BAND/INCOH/SNAP_OUT at 5/10/25/40/47.
|
||||
- **L3**: basin direction `+sign(v)` in SOFT, `−sign(v)` in INCOH, `0` in band; force nonzero in SOFT &
|
||||
INCOH, **zero in snap zones**; `|restoring(SOFT)| < |restoring(INCOH)|` (weak soft-pull).
|
||||
- **L2**: a SOFT-zone zero-drift start **settles into** the band **without flipping** sign.
|
||||
- **L7**: a SNAP_IN start lands in the opposite SOFT then settles in the opposite band; a SNAP_OUT start
|
||||
lands in the opposite INCOH then settles in the opposite band (both flip the pole).
|
||||
- **L4**: `etr_step` with no `drift` argument **errors** (it refuses to invent motion).
|
||||
- **L5**: `coupling(coord, 0)` is identity; `coupling(coord, stress>0)` alters coord — *pending until defined*.
|
||||
|
||||
## Drift & stress provenance — cross-organ loop (where L4 drift & L5 stress originate)
|
||||
*Exploratory (C2/C3) — thinking aloud; "yet undecided" parts stay open. ETR receives drift
|
||||
and stress; it never generates them. Their source:*
|
||||
|
||||
1. EthInt convictions carry **semantic-isomorphy (isosemantic) tags**. **[C3]**
|
||||
2. The **SAE detects agent outputs in opposition** to the *top* convictions in the array
|
||||
(matched via those tags) — conduct-boundary detection, "judge the fruits." **[C3]**
|
||||
3. On detected opposition a **stress endomotiv is released** — *which* of the 30 endocrine
|
||||
channels is **yet undecided**. **[C1]**
|
||||
4. That stress drives ETR **drift**: axes move because convictions were *acted against
|
||||
oppositionally*; **endocrine (endomotiv) pressure shapes _how_** the drift lands. Same
|
||||
stress = the **L5 cross-axis mediator**. **[C2]**
|
||||
5. Stress magnitude has two further effects **outside ETR**:
|
||||
- too strong → **full (re-natal) reshuffle** (Big-3 re-rolled — self-doc A4 trigger). **[C2]**
|
||||
- **raises the conviction-array value shift rates** (arch §6 "conviction hardens under
|
||||
load," now rate-modulated by stress). **[C2]**
|
||||
|
||||
**Consequence for ETR:** contract unchanged — drift + stress remain fed-in inputs (the
|
||||
scaffold seam is correct). What's fixed is their **provenance** (upstream in SAE / EthInt /
|
||||
endocrines) and two side-effects (reshuffle, shift-rate) that belong to *those* organs.
|
||||
Still open: which stress endomotiv; the "too strong" reshuffle threshold; the shift-rate function.
|
||||
|
||||
## Status (five-zone axis fitted — 26 PASS / 0 FAIL / 1 PEND)
|
||||
Green: L1 wrap; zone classification; L3 basin direction + restoring magnitudes (SOFT/INCOH, fitted) +
|
||||
snap-zones-carry-no-force + weak-soft-pull; L2 same-pole convergence; **L7 snap/flip** (inner across 0,
|
||||
outer over the wrap — both land just past the opposite watershed and settle in the opposite band);
|
||||
L4 drift-must-be-fed; L5 coupling-off identity; L8 realised by construction.
|
||||
Pending: **L5 active coupling** (C1, open seam) — the only remaining stub.
|
||||
@@ -1,13 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Run the ETR (Octave) invariants tests from this directory, so the in-dir
|
||||
# source('etr.m') resolves. Mirrors src/endocrine/run_tests.sh for the R drivers.
|
||||
set -uo pipefail
|
||||
|
||||
cd "$(dirname "$0")" || exit 2
|
||||
|
||||
if ! command -v octave >/dev/null 2>&1; then
|
||||
echo "ERROR: octave not found. Install with: sudo apt-get install -y --no-install-recommends octave" >&2
|
||||
exit 2
|
||||
fi
|
||||
|
||||
octave --no-gui --quiet test_etr.m
|
||||
@@ -1,104 +0,0 @@
|
||||
% test_etr.m — invariants tests for the ETR five-zone bistable axis (Octave script).
|
||||
% Deliberately uses NO local functions (Octave's script-local-function visibility
|
||||
% is fragile); results are built as data and looped. Run via run_etr_tests.sh.
|
||||
|
||||
source('etr.m');
|
||||
|
||||
% --- stateful checks ---------------------------------------------------
|
||||
|
||||
% L2 convergence (same pole): a SOFT-zone start, zero drift, settles into the
|
||||
% band WITHOUT flipping sign.
|
||||
s = etr_init([10 10 10]);
|
||||
for k = 1:200, s = etr_step(s, [0 0 0], 0); endfor
|
||||
conv_soft = all(abs(s.coord) >= ETR_BAND_LO() & abs(s.coord) <= ETR_BAND_HI());
|
||||
soft_noflip = all(s.coord > 0);
|
||||
|
||||
% Inner snap: a SNAP_IN start (|v|<7) flips across 0 to the opposite pole, landing
|
||||
% in the opposite SOFT zone, then settles into the opposite band.
|
||||
s = etr_init([5 5 5]);
|
||||
s1 = etr_step(s, [0 0 0], 0); % one step = the snap itself
|
||||
inner_lands_soft = all(s1.coord < 0) && ...
|
||||
all(abs(s1.coord) > ETR_SNAP_INNER() & abs(s1.coord) < ETR_BAND_LO());
|
||||
for k = 1:200, s = etr_step(s, [0 0 0], 0); endfor
|
||||
inner_flip_band = all(s.coord < 0) && ...
|
||||
all(abs(s.coord) >= ETR_BAND_LO() & abs(s.coord) <= ETR_BAND_HI());
|
||||
|
||||
% Outer snap: a SNAP_OUT start (|v|>45) flips over the wrap, landing in the
|
||||
% opposite INCOH zone, then settles into the opposite band.
|
||||
s = etr_init([47 47 47]);
|
||||
s1 = etr_step(s, [0 0 0], 0);
|
||||
outer_lands_incoh = all(s1.coord < 0) && ...
|
||||
all(abs(s1.coord) > ETR_BAND_HI() & abs(s1.coord) <= ETR_SNAP_OUTER());
|
||||
for k = 1:200, s = etr_step(s, [0 0 0], 0); endfor
|
||||
outer_flip_band = all(s.coord < 0) && ...
|
||||
all(abs(s.coord) >= ETR_BAND_LO() & abs(s.coord) <= ETR_BAND_HI());
|
||||
|
||||
% L4: a step with no drift argument must ERROR (ETR never invents motion).
|
||||
drift_required = false;
|
||||
try
|
||||
etr_step(etr_init());
|
||||
catch
|
||||
drift_required = true;
|
||||
end_try_catch
|
||||
|
||||
% --- {section, name, condition} ---------------------------------------
|
||||
tests = {
|
||||
'L1 wrap', '+50 wraps to -50', abs(etr_axis_wrap(50) - (-50)) < 1e-9;
|
||||
'L1 wrap', '60 wraps to -40', abs(etr_axis_wrap(60) - (-40)) < 1e-9;
|
||||
'L1 wrap', '-60 wraps to +40', abs(etr_axis_wrap(-60) - (40)) < 1e-9;
|
||||
'L1 wrap', 'in-range value unchanged', abs(etr_axis_wrap(25) - 25) < 1e-9;
|
||||
'L1 wrap', 'edge continuity 49.9 vs -50.1', abs(etr_axis_wrap(49.9) - etr_axis_wrap(-50.1)) < 1e-9;
|
||||
|
||||
'zones', 'SNAP_IN below 7', strcmp(etr_axis_zone(5), 'SNAP_IN');
|
||||
'zones', 'SOFT 7..17', strcmp(etr_axis_zone(10), 'SOFT');
|
||||
'zones', 'IN_BAND 17..35', strcmp(etr_axis_zone(25), 'IN_BAND');
|
||||
'zones', 'INCOH 35..45', strcmp(etr_axis_zone(40), 'INCOH');
|
||||
'zones', 'SNAP_OUT above 45', strcmp(etr_axis_zone(47), 'SNAP_OUT');
|
||||
|
||||
'L3 direction', 'SOFT outward (+ for +v)', etr_axis_restoring_dir(10) > 0;
|
||||
'L3 direction', 'SOFT outward (- for -v)', etr_axis_restoring_dir(-10) < 0;
|
||||
'L3 direction', 'INCOH inward (- for +v)', etr_axis_restoring_dir(40) < 0;
|
||||
'L3 direction', 'INCOH inward (+ for -v)', etr_axis_restoring_dir(-40) > 0;
|
||||
'L3 direction', 'in-band is slack (0)', etr_axis_restoring_dir(25) == 0;
|
||||
|
||||
'L3 magnitude', 'SOFT force nonzero', etr_axis_restoring(10) != 0;
|
||||
'L3 magnitude', 'INCOH force nonzero', etr_axis_restoring(40) != 0;
|
||||
'L3 magnitude', 'snap zone has no restoring force', etr_axis_restoring(5) == 0;
|
||||
'L3 weighting', 'soft-pull weaker than incoherency', abs(etr_axis_restoring(8)) < abs(etr_axis_restoring(44));
|
||||
|
||||
'L2 converge', 'SOFT start settles in band (no flip)', conv_soft && soft_noflip;
|
||||
|
||||
'L3 snap-in', 'inner snap lands in opposite SOFT', inner_lands_soft;
|
||||
'L7 flip', 'inner snap flips pole -> opp. band', inner_flip_band;
|
||||
'L3 snap-out', 'outer snap lands in opposite INCOH', outer_lands_incoh;
|
||||
'L7 flip', 'outer snap flips pole -> opp. band', outer_flip_band;
|
||||
|
||||
'L4 drift', 'step refuses to invent drift', drift_required;
|
||||
'L5 couple', 'coupling off (stress=0) identity', isequal(etr_coupling([25 25 25], 0), [25 25 25]);
|
||||
};
|
||||
|
||||
pend = {
|
||||
'L5 couple', 'coupling active (stress>0) alters coord', 'stress->axis mapping undefined (C1)';
|
||||
};
|
||||
|
||||
printf('ETR invariants — five-zone bistable axis\n\n');
|
||||
np = 0; nf = 0;
|
||||
for i = 1:rows(tests)
|
||||
if logical(tests{i, 3})
|
||||
printf(' PASS [%s] %s\n', tests{i, 1}, tests{i, 2}); np++;
|
||||
else
|
||||
printf(' FAIL [%s] %s\n', tests{i, 1}, tests{i, 2}); nf++;
|
||||
endif
|
||||
endfor
|
||||
for i = 1:rows(pend)
|
||||
printf(' PEND [%s] %s (%s)\n', pend{i, 1}, pend{i, 2}, pend{i, 3});
|
||||
endfor
|
||||
|
||||
printf('\n----\nPASS=%d FAIL=%d PEND=%d\n', np, nf, rows(pend));
|
||||
if nf > 0
|
||||
printf('RED: %d law(s) await implementation/fitting.\n', nf);
|
||||
exit(1);
|
||||
else
|
||||
printf('GREEN.\n');
|
||||
exit(0);
|
||||
endif
|
||||
@@ -1,63 +0,0 @@
|
||||
# --- Priors: Records of Salient Spikes in Relativity ---
|
||||
# Standalone module for traumatic and rewarding memory records.
|
||||
# PS+ calls into this module to retrieve active priors that inject high-salience arguments.
|
||||
|
||||
# Initialize a fresh priors state
|
||||
init_priors_state <- function() {
|
||||
return(list(records = list()))
|
||||
}
|
||||
|
||||
# Add a prior record
|
||||
# type: "TRAUMA" or "TRIUMPH"
|
||||
# salience: 0.0 to 1.0 (how strongly this prior activates when matched)
|
||||
# payload: the argument string injected into PS+ load when active
|
||||
add_prior <- function(priors_state, id, type, salience, payload) {
|
||||
if (!(type %in% c("TRAUMA", "TRIUMPH"))) {
|
||||
stop(sprintf("Invalid prior type: %s. Must be TRAUMA or TRIUMPH.", type))
|
||||
}
|
||||
|
||||
new_prior <- list(
|
||||
id = id,
|
||||
type = type,
|
||||
salience = max(0.0, min(1.0, salience)),
|
||||
payload = payload,
|
||||
activation_count = 0L
|
||||
)
|
||||
|
||||
priors_state$records[[length(priors_state$records) + 1]] <- new_prior
|
||||
return(priors_state)
|
||||
}
|
||||
|
||||
# Get priors above a salience threshold, sorted descending by salience
|
||||
get_top_active_priors <- function(priors_state, threshold = 0.8) {
|
||||
active <- Filter(function(p) p$salience >= threshold, priors_state$records)
|
||||
|
||||
if (length(active) > 0) {
|
||||
active <- active[order(sapply(active, function(p) p$salience), decreasing = TRUE)]
|
||||
}
|
||||
|
||||
return(active)
|
||||
}
|
||||
|
||||
# Activate a prior (increment its activation count for tracking)
|
||||
activate_prior <- function(priors_state, prior_id) {
|
||||
for (i in seq_along(priors_state$records)) {
|
||||
if (priors_state$records[[i]]$id == prior_id) {
|
||||
priors_state$records[[i]]$activation_count <- priors_state$records[[i]]$activation_count + 1L
|
||||
break
|
||||
}
|
||||
}
|
||||
return(priors_state)
|
||||
}
|
||||
|
||||
# Decay salience of a prior over time (for future use in migration cycles)
|
||||
decay_prior <- function(priors_state, prior_id, decay_rate = 0.01) {
|
||||
for (i in seq_along(priors_state$records)) {
|
||||
if (priors_state$records[[i]]$id == prior_id) {
|
||||
current <- priors_state$records[[i]]$salience
|
||||
priors_state$records[[i]]$salience <- max(0.0, current - decay_rate)
|
||||
break
|
||||
}
|
||||
}
|
||||
return(priors_state)
|
||||
}
|
||||
@@ -1,41 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Run every endocrine / Drive-Box R test from the repository root so that the
|
||||
# repo-root-relative source() paths inside each test resolve correctly.
|
||||
set -uo pipefail
|
||||
|
||||
# cd to repo root (this script lives at <root>/src/endocrine/run_tests.sh)
|
||||
cd "$(dirname "$0")/../.." || exit 2
|
||||
|
||||
if ! command -v Rscript >/dev/null 2>&1; then
|
||||
echo "ERROR: Rscript not found. Install with: sudo apt-get install -y r-base-core" >&2
|
||||
exit 2
|
||||
fi
|
||||
|
||||
status=0
|
||||
shopt -s nullglob
|
||||
# Collect test files, excluding the harness itself (test_framework.R).
|
||||
tests=()
|
||||
for f in src/endocrine/test_*.R; do
|
||||
[ "$(basename "$f")" = "test_framework.R" ] && continue
|
||||
tests+=("$f")
|
||||
done
|
||||
|
||||
if [ ${#tests[@]} -eq 0 ]; then
|
||||
echo "No test_*.R files found under src/endocrine/." >&2
|
||||
exit 2
|
||||
fi
|
||||
|
||||
for t in "${tests[@]}"; do
|
||||
echo "== $t =="
|
||||
if ! Rscript "$t"; then
|
||||
status=1
|
||||
fi
|
||||
echo
|
||||
done
|
||||
|
||||
if [ $status -eq 0 ]; then
|
||||
echo "ALL ENDOCRINE TESTS PASSED"
|
||||
else
|
||||
echo "SOME ENDOCRINE TESTS FAILED"
|
||||
fi
|
||||
exit $status
|
||||
@@ -1,117 +0,0 @@
|
||||
# Tests for the Drive-Box "nervous system" integration (drive_box.R).
|
||||
source("src/endocrine/test_framework.R")
|
||||
source("src/endocrine/drive_box.R")
|
||||
|
||||
# Helper: build a drive-box with a primed body.
|
||||
prime <- function() {
|
||||
db <- init_drive_box()
|
||||
# endocrine: light a contradictory pair so PS+ produces real load
|
||||
db$ps_plus <- ps_set_vector(db$ps_plus, "panic", 0.6)
|
||||
db$ps_plus <- ps_set_vector(db$ps_plus, "clarity", 0.6)
|
||||
# a strong principle whose antithesis is "deceive", aligned id "honesty"
|
||||
db$ethics <- add_principle(db$ethics, "honesty", 0.9, c("deceive", "manipulate"))
|
||||
db
|
||||
}
|
||||
|
||||
test_case("init_drive_box assembles all four driver states", function() {
|
||||
db <- init_drive_box()
|
||||
expect_true(is.list(db$energy), "energy present")
|
||||
expect_true(is.list(db$ps_plus), "ps_plus present")
|
||||
expect_true(is.list(db$ethics), "ethics present")
|
||||
expect_true(is.list(db$etr), "etr present")
|
||||
})
|
||||
|
||||
test_case("drive_snapshot reports a coherent read-only aggregate", function() {
|
||||
db <- prime()
|
||||
snap <- drive_snapshot(db)
|
||||
expect_equal(snap$energy_ratio, 1.0, label = "full energy at init")
|
||||
expect_true(snap$alive, "alive at full energy")
|
||||
expect_false(snap$tool_locked, "not tool-locked at full energy")
|
||||
expect_true(snap$existential_load > 0, "primed body has positive load")
|
||||
expect_true(length(snap$arguments) > 0, "arguments emitted")
|
||||
expect_equal(snap$etr_status, "IN_BAND/IN_BAND/IN_BAND", label = "default coord -> all axes in band")
|
||||
expect_equal(snap$update_path, "EXPERIMENTAL_EVOLUTION", label = "z=25 (>=0) -> transmutation/evolution")
|
||||
})
|
||||
|
||||
test_case("aligned action is far cheaper than its antithetical mirror", function() {
|
||||
db <- prime()
|
||||
aligned <- drive_box_evaluate(db, action_tags = c("inform"),
|
||||
alignment_tags = c("honesty"),
|
||||
is_tool_call = TRUE, base_cost = 1.0)
|
||||
antithetical <- drive_box_evaluate(db, action_tags = c("deceive"),
|
||||
alignment_tags = character(0),
|
||||
is_tool_call = TRUE, base_cost = 1.0)
|
||||
expect_true(antithetical$eth_penalty > aligned$eth_penalty,
|
||||
"antithetical action carries a larger ethical penalty")
|
||||
expect_true(antithetical$true_cost > aligned$true_cost,
|
||||
"antithetical action costs more energy")
|
||||
})
|
||||
|
||||
test_case("dead body denies everything", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 100) # drain to 0
|
||||
ev <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0)
|
||||
expect_false(ev$approved, "no execution when dead")
|
||||
expect_equal(ev$reason, "System is dead (0 energy)")
|
||||
})
|
||||
|
||||
test_case("tool-lock blocks tool calls but not internal ones", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 85) # 15 < threshold 20 -> locked
|
||||
tool <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0)
|
||||
internal <- drive_box_evaluate(db, is_tool_call = FALSE, base_cost = 1.0)
|
||||
expect_false(tool$approved, "tool call blocked while locked")
|
||||
expect_true(grepl("Tool lock", tool$reason), "reason cites tool lock")
|
||||
# internal call may still be denied by affordability, but NOT by tool-lock
|
||||
expect_false(grepl("Tool lock", internal$reason), "internal call not tool-locked")
|
||||
})
|
||||
|
||||
test_case("commit consumes energy and hardens upheld convictions", function() {
|
||||
db <- prime()
|
||||
before_energy <- db$energy$current_energy
|
||||
before_conv <- db$ethics$principles[[1]]$conviction
|
||||
ev <- drive_box_evaluate(db, action_tags = c("inform"),
|
||||
alignment_tags = c("honesty"), is_tool_call = FALSE,
|
||||
base_cost = 1.0)
|
||||
expect_true(ev$approved, "affordable internal aligned action approved")
|
||||
db <- drive_box_commit(db, ev, alignment_tags = c("honesty"))
|
||||
expect_true(db$energy$current_energy < before_energy, "energy consumed")
|
||||
expect_true(db$ethics$principles[[1]]$conviction >= before_conv,
|
||||
"upheld conviction hardened (or already at ceiling)")
|
||||
})
|
||||
|
||||
test_case("commit on a denied action is a no-op on energy", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 100) # dead
|
||||
before <- db$energy$current_energy
|
||||
ev <- drive_box_evaluate(db, is_tool_call = TRUE)
|
||||
db <- drive_box_commit(db, ev)
|
||||
expect_equal(db$energy$current_energy, before, label = "no consumption when denied")
|
||||
})
|
||||
|
||||
test_case("input slot: every driver + tarot + soul wire into one slot", function() {
|
||||
db <- prime()
|
||||
spread <- c("THE_FOOL", "THE_MAGICIAN")
|
||||
res <- drive_box_input_slot(db, input_text = "who are you",
|
||||
tarot_spread = spread, soul_ref = "SOUL.md")
|
||||
expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul frontloader wired")
|
||||
expect_true(grepl("[E ratio=", res$slot, fixed = TRUE), "energy wired")
|
||||
expect_true(any(grepl("^\\[PS\\+ ", res$components)), "ps+ wired")
|
||||
expect_true(grepl("[ETH honesty conviction=", res$slot, fixed = TRUE), "eth-int wired")
|
||||
expect_true(grepl("[ETR status=", res$slot, fixed = TRUE), "etr wired")
|
||||
expect_true(grepl("[CC THE_FOOL]", res$slot, fixed = TRUE), "tarot card 1 wired")
|
||||
expect_true(grepl("[CC THE_MAGICIAN]", res$slot, fixed = TRUE), "tarot card 2 wired")
|
||||
# the raw input is appended after the slot
|
||||
expect_true(grepl("who are you$", res$input), "user input appended after slot")
|
||||
})
|
||||
|
||||
test_case("input slot: empty body still emits driver + soul signals", function() {
|
||||
db <- init_drive_box()
|
||||
res <- drive_box_input_slot(db, input_text = "", tarot_spread = character(0))
|
||||
expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul present")
|
||||
expect_true(grepl("[E ratio=1.00", res$slot, fixed = TRUE), "energy present at full")
|
||||
expect_true(grepl("[ETR status=IN_BAND", res$slot, fixed = TRUE), "etr present")
|
||||
expect_equal(res$input, res$slot, label = "no input_text -> input == slot")
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,131 +0,0 @@
|
||||
# --- Tests for Driver 1: Energy (E) ---
|
||||
# Run from repo root: Rscript src/endocrine/test_energy.R
|
||||
# Exit 0 => all pass.
|
||||
|
||||
source("src/endocrine/test_framework.R")
|
||||
source("src/endocrine/driver_energy.R")
|
||||
|
||||
# --- init_energy_state constructor ---
|
||||
test_case("init_energy_state builds state with defaults", function() {
|
||||
s <- init_energy_state()
|
||||
expect_equal(s$current_energy, 100)
|
||||
expect_equal(s$max_energy, 100)
|
||||
expect_equal(s$tool_lock_threshold, 20)
|
||||
})
|
||||
|
||||
test_case("init_energy_state honors custom args", function() {
|
||||
s <- init_energy_state(current_energy = 50, max_energy = 200, tool_lock_threshold = 30)
|
||||
expect_equal(s$current_energy, 50)
|
||||
expect_equal(s$max_energy, 200)
|
||||
expect_equal(s$tool_lock_threshold, 30)
|
||||
})
|
||||
|
||||
# --- is_alive ---
|
||||
test_case("is_alive TRUE when energy above zero", function() {
|
||||
expect_true(is_alive(init_energy_state(current_energy = 0.001)))
|
||||
expect_true(is_alive(init_energy_state(current_energy = 100)))
|
||||
})
|
||||
|
||||
test_case("is_alive FALSE at exactly zero", function() {
|
||||
expect_false(is_alive(init_energy_state(current_energy = 0)))
|
||||
})
|
||||
|
||||
# --- is_tool_locked ---
|
||||
test_case("is_tool_locked TRUE below threshold", function() {
|
||||
expect_true(is_tool_locked(init_energy_state(current_energy = 19.9, tool_lock_threshold = 20)))
|
||||
})
|
||||
|
||||
test_case("is_tool_locked FALSE at threshold", function() {
|
||||
expect_false(is_tool_locked(init_energy_state(current_energy = 20, tool_lock_threshold = 20)))
|
||||
})
|
||||
|
||||
test_case("is_tool_locked FALSE above threshold", function() {
|
||||
expect_false(is_tool_locked(init_energy_state(current_energy = 50, tool_lock_threshold = 20)))
|
||||
})
|
||||
|
||||
# --- get_cost_multiplier ---
|
||||
test_case("get_cost_multiplier equals 1.0 at full energy", function() {
|
||||
expect_equal(get_cost_multiplier(init_energy_state(current_energy = 100, max_energy = 100)), 1.0, tol = 1e-9)
|
||||
})
|
||||
|
||||
test_case("get_cost_multiplier strictly increases as energy drops", function() {
|
||||
m_full <- get_cost_multiplier(init_energy_state(current_energy = 100, max_energy = 100))
|
||||
m_half <- get_cost_multiplier(init_energy_state(current_energy = 50, max_energy = 100))
|
||||
m_low <- get_cost_multiplier(init_energy_state(current_energy = 20, max_energy = 100))
|
||||
expect_true(m_half > m_full)
|
||||
expect_true(m_low > m_half)
|
||||
})
|
||||
|
||||
# --- evaluate_tool_cost ---
|
||||
test_case("evaluate_tool_cost at full energy is additive (multipliers == 1)", function() {
|
||||
s <- init_energy_state(current_energy = 100, max_energy = 100)
|
||||
# base_cost(1) + ps_load*1 + eth_penalty*1
|
||||
expect_equal(evaluate_tool_cost(s, ps_load = 3, eth_penalty = 2), 1 + 3 + 2, tol = 1e-9)
|
||||
})
|
||||
|
||||
test_case("evaluate_tool_cost asymmetry: eth penalty scales faster than ps load", function() {
|
||||
s <- init_energy_state(current_energy = 50, max_energy = 100)
|
||||
base <- evaluate_tool_cost(s, ps_load = 1, eth_penalty = 1)
|
||||
bump_ps <- evaluate_tool_cost(s, ps_load = 2, eth_penalty = 1)
|
||||
bump_eth <- evaluate_tool_cost(s, ps_load = 1, eth_penalty = 2)
|
||||
delta_ps <- bump_ps - base
|
||||
delta_eth <- bump_eth - base
|
||||
# Same +1 increment, eth must drive cost up much more than ps at reduced energy.
|
||||
expect_true(delta_eth > delta_ps)
|
||||
})
|
||||
|
||||
# --- request_execution ---
|
||||
test_case("request_execution denies a dead system", function() {
|
||||
s <- init_energy_state(current_energy = 0)
|
||||
r <- request_execution(s, base_cost = 1, is_tool_call = FALSE)
|
||||
expect_false(r$approved)
|
||||
})
|
||||
|
||||
test_case("request_execution denies tool call while locked", function() {
|
||||
s <- init_energy_state(current_energy = 10, tool_lock_threshold = 20)
|
||||
r <- request_execution(s, base_cost = 1, is_tool_call = TRUE)
|
||||
expect_false(r$approved)
|
||||
})
|
||||
|
||||
test_case("request_execution denies unaffordable cost", function() {
|
||||
# Low energy => large multiplier => true cost exceeds current energy.
|
||||
s <- init_energy_state(current_energy = 30, max_energy = 100, tool_lock_threshold = 0)
|
||||
r <- request_execution(s, base_cost = 50, is_tool_call = FALSE)
|
||||
expect_false(r$approved)
|
||||
})
|
||||
|
||||
test_case("request_execution approves an affordable non-tool call with true_cost", function() {
|
||||
s <- init_energy_state(current_energy = 100, max_energy = 100)
|
||||
r <- request_execution(s, base_cost = 5, is_tool_call = FALSE)
|
||||
expect_true(r$approved)
|
||||
expect_true(!is.null(r$true_cost))
|
||||
# At full energy multiplier == 1.0 so true_cost == base_cost.
|
||||
expect_equal(r$true_cost, 5, tol = 1e-9)
|
||||
})
|
||||
|
||||
# --- consume / recharge clamping ---
|
||||
test_case("consume clamps at zero (never negative)", function() {
|
||||
s <- init_energy_state(current_energy = 10)
|
||||
s2 <- consume(s, 25)
|
||||
expect_equal(s2$current_energy, 0)
|
||||
})
|
||||
|
||||
test_case("consume subtracts normally above zero", function() {
|
||||
s <- init_energy_state(current_energy = 50)
|
||||
s2 <- consume(s, 20)
|
||||
expect_equal(s2$current_energy, 30)
|
||||
})
|
||||
|
||||
test_case("recharge clamps at max_energy", function() {
|
||||
s <- init_energy_state(current_energy = 90, max_energy = 100)
|
||||
s2 <- recharge(s, 50)
|
||||
expect_equal(s2$current_energy, 100)
|
||||
})
|
||||
|
||||
test_case("recharge adds normally below max", function() {
|
||||
s <- init_energy_state(current_energy = 40, max_energy = 100)
|
||||
s2 <- recharge(s, 25)
|
||||
expect_equal(s2$current_energy, 65)
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,164 +0,0 @@
|
||||
# --- Tests for Driver 3: Ethical Integrity (Eth-Int) ---
|
||||
# Run from repo root: Rscript src/endocrine/test_ethical_integrity.R
|
||||
# Exit 0 => all pass.
|
||||
|
||||
source("src/endocrine/test_framework.R")
|
||||
source("src/endocrine/driver_ethical_integrity.R")
|
||||
|
||||
# --- init_principles_state constructor ---
|
||||
test_case("init_principles_state builds an empty state", function() {
|
||||
s <- init_principles_state()
|
||||
expect_true(is.list(s$principles))
|
||||
expect_equal(length(s$principles), 0L)
|
||||
})
|
||||
|
||||
# --- add_principle ---
|
||||
test_case("add_principle appends a principle to the list", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
expect_equal(length(s$principles), 1L)
|
||||
expect_equal(s$principles[[1]]$id, "honesty")
|
||||
expect_equal(s$principles[[1]]$conviction, 0.5)
|
||||
expect_equal(s$principles[[1]]$antithesis, c("deceive"))
|
||||
|
||||
s <- add_principle(s, "loyalty", 0.7, c("betray"))
|
||||
expect_equal(length(s$principles), 2L)
|
||||
expect_equal(s$principles[[2]]$id, "loyalty")
|
||||
})
|
||||
|
||||
test_case("add_principle clamps conviction above 1.0 down to 1.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "absolute", 1.5, c("violate"))
|
||||
expect_equal(s$principles[[1]]$conviction, 1.0)
|
||||
})
|
||||
|
||||
test_case("add_principle clamps negative conviction up to 0.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "weak", -0.3, c("violate"))
|
||||
expect_equal(s$principles[[1]]$conviction, 0.0)
|
||||
})
|
||||
|
||||
# --- evaluate_trajectory_costs ---
|
||||
test_case("no matching tags and zero compromise yields base_energy", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.8, c("deceive"))
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s,
|
||||
action_tags = c("walk", "talk"),
|
||||
alignment_tags = c("unrelated"),
|
||||
base_energy = 10.0,
|
||||
compromise_factor = 0.0
|
||||
)
|
||||
expect_equal(cost, 10.0)
|
||||
})
|
||||
|
||||
test_case("empty principles, empty tags, zero compromise yields base_energy", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s,
|
||||
action_tags = character(0),
|
||||
alignment_tags = character(0),
|
||||
base_energy = 42.0,
|
||||
compromise_factor = 0.0
|
||||
)
|
||||
expect_equal(cost, 42.0)
|
||||
})
|
||||
|
||||
test_case("antithetical action against high conviction costs much more than base", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.9, c("deceive"))
|
||||
base_cost <- evaluate_trajectory_costs(
|
||||
s, c("walk"), character(0), 10.0, 0.0
|
||||
)
|
||||
anti_cost <- evaluate_trajectory_costs(
|
||||
s, c("deceive"), character(0), 10.0, 0.0
|
||||
)
|
||||
# base_cost has no antithetical match -> equals base_energy
|
||||
expect_equal(base_cost, 10.0)
|
||||
# antithetical match multiplies by (1 + exp(5 * 0.9))
|
||||
expect_true(anti_cost > base_cost, "antithetical cost exceeds base")
|
||||
expected_anti <- 10.0 * (1.0 + exp(5.0 * 0.9))
|
||||
expect_equal(anti_cost, expected_anti, tol = 1e-6)
|
||||
})
|
||||
|
||||
test_case("higher conviction yields a steeper antithetical penalty", function() {
|
||||
low <- init_principles_state()
|
||||
low <- add_principle(low, "honesty", 0.2, c("deceive"))
|
||||
high <- init_principles_state()
|
||||
high <- add_principle(high, "honesty", 0.95, c("deceive"))
|
||||
cost_low <- evaluate_trajectory_costs(low, c("deceive"), character(0), 10.0, 0.0)
|
||||
cost_high <- evaluate_trajectory_costs(high, c("deceive"), character(0), 10.0, 0.0)
|
||||
expect_true(cost_high > cost_low, "stronger conviction punishes more")
|
||||
})
|
||||
|
||||
test_case("alignment tag against high conviction discounts below base", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.9, c("deceive"))
|
||||
aligned_cost <- evaluate_trajectory_costs(
|
||||
s, character(0), c("honesty"), 10.0, 0.0
|
||||
)
|
||||
expect_true(aligned_cost < 10.0, "alignment discounts cost")
|
||||
expected <- 10.0 * exp(-5.0 * 0.9)
|
||||
expect_equal(aligned_cost, expected, tol = 1e-6)
|
||||
})
|
||||
|
||||
test_case("compromise_factor adds a linear penalty (1 + 2*factor)", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s, character(0), character(0), 10.0, 0.5
|
||||
)
|
||||
# factor 0.5 -> 1 + 2*0.5 = 2.0 multiplier
|
||||
expect_equal(cost, 20.0)
|
||||
})
|
||||
|
||||
test_case("zero compromise_factor applies no compromise penalty", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s, character(0), character(0), 7.0, 0.0
|
||||
)
|
||||
expect_equal(cost, 7.0)
|
||||
})
|
||||
|
||||
# --- enforce_conviction ---
|
||||
test_case("enforce_conviction raises conviction of upheld principle", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0)
|
||||
# increase = 0.1 * 1.0 * (1 - 0.5) = 0.05
|
||||
expect_equal(s2$principles[[1]]$conviction, 0.55)
|
||||
})
|
||||
|
||||
test_case("enforce_conviction never raises conviction above 1.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.99, c("deceive"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 100.0)
|
||||
expect_true(s2$principles[[1]]$conviction <= 1.0, "capped at 1.0")
|
||||
expect_equal(s2$principles[[1]]$conviction, 1.0)
|
||||
})
|
||||
|
||||
test_case("enforce_conviction has diminishing returns near 1.0", function() {
|
||||
low_s <- init_principles_state()
|
||||
low_s <- add_principle(low_s, "honesty", 0.2, c("deceive"))
|
||||
high_s <- init_principles_state()
|
||||
high_s <- add_principle(high_s, "honesty", 0.9, c("deceive"))
|
||||
|
||||
low_after <- enforce_conviction(low_s, c("honesty"), load_factor = 1.0)
|
||||
high_after <- enforce_conviction(high_s, c("honesty"), load_factor = 1.0)
|
||||
|
||||
low_gain <- low_after$principles[[1]]$conviction - 0.2
|
||||
high_gain <- high_after$principles[[1]]$conviction - 0.9
|
||||
expect_true(high_gain < low_gain, "gain shrinks as conviction approaches 1.0")
|
||||
})
|
||||
|
||||
test_case("enforce_conviction leaves non-upheld principles unchanged", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
s <- add_principle(s, "loyalty", 0.4, c("betray"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0)
|
||||
# loyalty was not chosen -> unchanged
|
||||
expect_equal(s2$principles[[2]]$conviction, 0.4)
|
||||
# honesty was chosen -> raised
|
||||
expect_equal(s2$principles[[1]]$conviction, 0.55)
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,98 +0,0 @@
|
||||
# test_etr.R — invariants tests for the R port of the ETR five-zone torus.
|
||||
# Mirrors src/endocrine/etr/test_etr.m (same laws, same source of truth). Run
|
||||
# from the repo root via run_tests.sh.
|
||||
|
||||
source("src/endocrine/test_framework.R")
|
||||
source("src/endocrine/driver_etr.R")
|
||||
|
||||
# --- L1 wrap ----------------------------------------------------------
|
||||
test_case("etr_axis_wrap: +50 wraps to -50", function() {
|
||||
expect_equal(etr_axis_wrap(50), -50, tol = 1e-9)
|
||||
})
|
||||
test_case("etr_axis_wrap: 60 -> -40, -60 -> 40", function() {
|
||||
expect_equal(etr_axis_wrap(60), -40, tol = 1e-9)
|
||||
expect_equal(etr_axis_wrap(-60), 40, tol = 1e-9)
|
||||
})
|
||||
test_case("etr_axis_wrap: in-range unchanged; edge continuity", function() {
|
||||
expect_equal(etr_axis_wrap(25), 25, tol = 1e-9)
|
||||
expect_equal(etr_axis_wrap(49.9), etr_axis_wrap(-50.1), tol = 1e-9)
|
||||
})
|
||||
|
||||
# --- zones ------------------------------------------------------------
|
||||
test_case("etr_axis_zone: five zones at 5/10/25/40/47", function() {
|
||||
expect_equal(etr_axis_zone(5), "SNAP_IN")
|
||||
expect_equal(etr_axis_zone(10), "SOFT")
|
||||
expect_equal(etr_axis_zone(25), "IN_BAND")
|
||||
expect_equal(etr_axis_zone(40), "INCOH")
|
||||
expect_equal(etr_axis_zone(47), "SNAP_OUT")
|
||||
})
|
||||
|
||||
# --- L3 restoring -----------------------------------------------------
|
||||
test_case("etr_axis_restoring: SOFT pulls up, INCOH pulls down, band slack", function() {
|
||||
expect_true(etr_axis_restoring(10) > 0, "SOFT (+v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(-10) < 0, "SOFT (-v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(40) < 0, "INCOH (+v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(-40) > 0, "INCOH (-v) pulls toward band")
|
||||
expect_equal(etr_axis_restoring(25), 0)
|
||||
})
|
||||
test_case("etr_axis_restoring: zero in snap zones", function() {
|
||||
expect_equal(etr_axis_restoring(5), 0)
|
||||
expect_equal(etr_axis_restoring(47), 0)
|
||||
})
|
||||
test_case("etr_axis_restoring: soft-pull weaker than incoherency", function() {
|
||||
expect_true(abs(etr_axis_restoring(8)) < abs(etr_axis_restoring(44)),
|
||||
"weak soft-pull")
|
||||
})
|
||||
|
||||
# --- L2 convergence (same pole) ---------------------------------------
|
||||
test_case("L2: SOFT start settles into band without flipping sign", function() {
|
||||
s <- init_etr_state(c(10, 10, 10))
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(a >= ETR_BAND_LO & a <= ETR_BAND_HI), "in band")
|
||||
expect_true(all(s$coordinate > 0), "no flip")
|
||||
})
|
||||
|
||||
# --- L7 snap-across flips ---------------------------------------------
|
||||
test_case("L7: inner snap lands in opposite SOFT, settles in opposite band", function() {
|
||||
s <- init_etr_state(c(5, 5, 5))
|
||||
s1 <- etr_step(s, c(0, 0, 0), 0)
|
||||
a1 <- abs(s1$coordinate)
|
||||
expect_true(all(s1$coordinate < 0), "flipped sign")
|
||||
expect_true(all(a1 > ETR_SNAP_INNER & a1 < ETR_BAND_LO), "lands in SOFT")
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI),
|
||||
"settles in opposite band")
|
||||
})
|
||||
test_case("L7: outer snap lands in opposite INCOH, settles in opposite band", function() {
|
||||
s <- init_etr_state(c(47, 47, 47))
|
||||
s1 <- etr_step(s, c(0, 0, 0), 0)
|
||||
a1 <- abs(s1$coordinate)
|
||||
expect_true(all(s1$coordinate < 0), "flipped sign")
|
||||
expect_true(all(a1 > ETR_BAND_HI & a1 <= ETR_SNAP_OUTER), "lands in INCOH")
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI),
|
||||
"settles in opposite band")
|
||||
})
|
||||
|
||||
# --- L4 drift required ------------------------------------------------
|
||||
test_case("L4: etr_step refuses to invent drift", function() {
|
||||
expect_error(etr_step(init_etr_state()), "drift must be supplied")
|
||||
})
|
||||
|
||||
# --- L6 Z-path --------------------------------------------------------
|
||||
test_case("L6: z<0 -> alimentation (lattice); z>=0 -> transmutation (evolution)", function() {
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, -3))), "LATTICE_REINFORCEMENT")
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 0))), "EXPERIMENTAL_EVOLUTION")
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 7))), "EXPERIMENTAL_EVOLUTION")
|
||||
})
|
||||
|
||||
# --- status -----------------------------------------------------------
|
||||
test_case("etr_status: per-axis zone vector", function() {
|
||||
st <- etr_status(init_etr_state(c(25, 10, 40)))
|
||||
expect_equal(st, c("IN_BAND", "SOFT", "INCOH"))
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,115 +0,0 @@
|
||||
# --- Minimal Test Framework ---
|
||||
# Dependency-free assertion harness for the endocrine / Drive-Box R reference track.
|
||||
# No external packages (no testthat) so it runs under a bare r-base-core install.
|
||||
#
|
||||
# Usage in a test_*.R file:
|
||||
# source("src/endocrine/test_framework.R")
|
||||
# source("src/endocrine/driver_<name>.R")
|
||||
# test_case("does the thing", function() {
|
||||
# expect_equal(f(2), 4)
|
||||
# expect_true(is_alive(state))
|
||||
# })
|
||||
# test_summary() # prints results and quits with status 0 (all pass) or 1 (any fail)
|
||||
#
|
||||
# All source() paths are repo-root-relative; run from the repository root
|
||||
# (run_tests.sh handles the cd).
|
||||
|
||||
.TEST <- new.env()
|
||||
.TEST$pass <- 0L
|
||||
.TEST$fail <- 0L
|
||||
.TEST$failures <- character(0)
|
||||
.TEST$current <- "(top level)"
|
||||
|
||||
.record_pass <- function() {
|
||||
.TEST$pass <- .TEST$pass + 1L
|
||||
}
|
||||
|
||||
.record_fail <- function(msg) {
|
||||
.TEST$fail <- .TEST$fail + 1L
|
||||
full <- sprintf("[%s] %s", .TEST$current, msg)
|
||||
.TEST$failures <- c(.TEST$failures, full)
|
||||
cat(sprintf(" FAIL: %s\n", full))
|
||||
}
|
||||
|
||||
# Assert two values are equal. Numerics compared within tolerance; everything
|
||||
# else with identical().
|
||||
expect_equal <- function(actual, expected, tol = 1e-9, label = "") {
|
||||
ok <- FALSE
|
||||
if (is.numeric(actual) && is.numeric(expected) &&
|
||||
length(actual) == length(expected)) {
|
||||
ok <- all(abs(actual - expected) <= tol)
|
||||
} else {
|
||||
ok <- identical(actual, expected)
|
||||
}
|
||||
if (isTRUE(ok)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected %s, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(expected), format(actual)))
|
||||
}
|
||||
invisible(ok)
|
||||
}
|
||||
|
||||
expect_true <- function(cond, label = "") {
|
||||
if (isTRUE(cond)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected TRUE, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(cond)))
|
||||
}
|
||||
invisible(isTRUE(cond))
|
||||
}
|
||||
|
||||
expect_false <- function(cond, label = "") {
|
||||
if (identical(cond, FALSE)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected FALSE, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(cond)))
|
||||
}
|
||||
invisible(identical(cond, FALSE))
|
||||
}
|
||||
|
||||
# Assert that evaluating expr raises an R error.
|
||||
expect_error <- function(expr, label = "") {
|
||||
raised <- FALSE
|
||||
tryCatch(
|
||||
force(expr),
|
||||
error = function(e) { raised <<- TRUE }
|
||||
)
|
||||
if (raised) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected an error, none raised",
|
||||
if (nzchar(label)) paste0(label, ": ") else ""))
|
||||
}
|
||||
invisible(raised)
|
||||
}
|
||||
|
||||
# Group assertions under a description. Errors thrown inside body count as a
|
||||
# failure rather than aborting the whole test file.
|
||||
test_case <- function(desc, body) {
|
||||
prev <- .TEST$current
|
||||
.TEST$current <- desc
|
||||
cat(sprintf("- %s\n", desc))
|
||||
tryCatch(
|
||||
body(),
|
||||
error = function(e) .record_fail(sprintf("unexpected error: %s", conditionMessage(e)))
|
||||
)
|
||||
.TEST$current <- prev
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
# Print the tally and exit with a CI-friendly status code.
|
||||
test_summary <- function() {
|
||||
cat(sprintf("\nRESULT: PASS %d / FAIL %d\n", .TEST$pass, .TEST$fail))
|
||||
if (.TEST$fail > 0L) {
|
||||
cat("Failures:\n")
|
||||
for (f in .TEST$failures) cat(sprintf(" - %s\n", f))
|
||||
quit(save = "no", status = 1L)
|
||||
}
|
||||
quit(save = "no", status = 0L)
|
||||
}
|
||||
@@ -1,64 +0,0 @@
|
||||
# --- Tests for Driver 2: Primal Sensates+ (PS+) ---
|
||||
# Run from repo root:
|
||||
# cd /home/user/sica-fondt && Rscript src/endocrine/test_ps_plus.R
|
||||
|
||||
source("src/endocrine/test_framework.R")
|
||||
source("src/endocrine/driver_ps_plus.R")
|
||||
|
||||
# Helper: does any string in a list contain the given substring?
|
||||
.any_contains <- function(arguments, needle) {
|
||||
for (a in arguments) {
|
||||
if (is.character(a) && grepl(needle, a, fixed = TRUE)) return(TRUE)
|
||||
}
|
||||
return(FALSE)
|
||||
}
|
||||
|
||||
test_case("fresh state has zero load, empty arguments, non-logical", function() {
|
||||
state <- init_ps_plus_state()
|
||||
result <- evaluate_reality(state)
|
||||
expect_equal(result$existential_load, 0.0, label = "fresh load")
|
||||
expect_true(is.list(result$arguments), label = "arguments is a list")
|
||||
expect_equal(length(result$arguments), 0L, label = "arguments empty")
|
||||
expect_false(result$is_logical, label = "fresh is_logical")
|
||||
})
|
||||
|
||||
test_case("active contradictory channels raise load and emit VISCERAL + SYSTEMIC HEAT", function() {
|
||||
state <- init_ps_plus_state()
|
||||
# panic + clarity are a contradictory pair; magnitudes well above 0.1 threshold.
|
||||
state <- ps_set_vector(state, "panic", 0.9)
|
||||
state <- ps_set_vector(state, "clarity", 0.8)
|
||||
result <- evaluate_reality(state)
|
||||
|
||||
expect_true(result$existential_load > 0, label = "load positive")
|
||||
expect_true(.any_contains(result$arguments, "VISCERAL ["), label = "has VISCERAL argument")
|
||||
expect_true(.any_contains(result$arguments, "SYSTEMIC HEAT"), label = "has SYSTEMIC HEAT argument")
|
||||
expect_false(result$is_logical, label = "active is_logical")
|
||||
})
|
||||
|
||||
test_case("adding a high-salience prior strictly increases load and adds PRIOR argument", function() {
|
||||
state <- init_ps_plus_state()
|
||||
state <- ps_set_vector(state, "panic", 0.9)
|
||||
state <- ps_set_vector(state, "clarity", 0.8)
|
||||
|
||||
before <- evaluate_reality(state)
|
||||
|
||||
state <- ps_add_prior(state, "p1", "TRAUMA", 0.9, "the old wound reopens")
|
||||
after <- evaluate_reality(state)
|
||||
|
||||
expect_true(after$existential_load > before$existential_load, label = "load strictly increases")
|
||||
expect_true(.any_contains(after$arguments, "PRIOR [TRAUMA]"), label = "has PRIOR [TRAUMA] argument")
|
||||
expect_true(.any_contains(after$arguments, "the old wound reopens"), label = "prior payload present")
|
||||
})
|
||||
|
||||
test_case("is_logical is always FALSE", function() {
|
||||
s0 <- init_ps_plus_state()
|
||||
expect_false(evaluate_reality(s0)$is_logical, label = "empty")
|
||||
|
||||
s1 <- ps_set_vector(init_ps_plus_state(), "curiosity", 0.7)
|
||||
expect_false(evaluate_reality(s1)$is_logical, label = "single channel")
|
||||
|
||||
s2 <- ps_add_prior(s1, "p2", "TRIUMPH", 0.95, "the summit reached")
|
||||
expect_false(evaluate_reality(s2)$is_logical, label = "with prior")
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,28 +0,0 @@
|
||||
# AGENTS.md — Ichor bus (Pony)
|
||||
|
||||
Local guide for `src/ichor`. Repo-wide map and rules: [`../../AGENTS.md`](../../AGENTS.md);
|
||||
working agreements: [`../../CLAUDE.md`](../../CLAUDE.md).
|
||||
|
||||
## What this is
|
||||
|
||||
The **Ichor perfusion bus** — the outer transport that perfuses organs with
|
||||
messages. Pony. This is where inbound external traffic is first screened before
|
||||
anything reaches the Ada border (D1).
|
||||
|
||||
## Build & run
|
||||
|
||||
Run from the **repo root** (ponyc resolves the path from there):
|
||||
|
||||
```bash
|
||||
export PATH=/root/.local/share/ponyup/bin:$PATH # if ponyc not found
|
||||
ponyc src/ichor -o build && ./build/ichor
|
||||
```
|
||||
|
||||
Or via the smoke driver: `.claude/skills/run-sica-fondt/smoke.sh`.
|
||||
|
||||
## Local invariants
|
||||
|
||||
- **S1 lives here.** The bus must `D1 REJECT` unscreened external payloads —
|
||||
external traffic only reaches an organ via the Ada border. Never add a path
|
||||
that perfuses an inner organ directly from `world`.
|
||||
- **S2:** never reclassify a message's provenance as it crosses the bus.
|
||||
@@ -1,44 +0,0 @@
|
||||
# Ichor — the OUTER perfusion bus (D2)
|
||||
|
||||
Ichor is the **outer** bus — "the skin". It carries the **outer organs**
|
||||
(stomach/economy, microagents, SAE, MoRAG/GoDAGRAG) and delivers inbound traffic
|
||||
to **Ada (D1)**, the membrane. See `docs/bus-topology.md` for the full topology.
|
||||
|
||||
**What Ichor is NOT** (do not violate):
|
||||
- It is **not** the inner-brain bus. The inner bus is **Ada-routed (Jorvik)**.
|
||||
- It does **not** carry inner organs — soul, metacog, drive-box, mini-rag,
|
||||
**Hermes**, or the E1 invariant laws. Wiring any of those onto Ichor is
|
||||
"plugging the brain onto the skin". Don't.
|
||||
- Hermes is an **inner** organ; it was never approved on Pony/Ichor.
|
||||
|
||||
Perfusion laws: organs never wire to each other directly (**L1**) — they emit a
|
||||
typed `Envelope` to the `Broker`; anything crossing **into Ada** is screened by
|
||||
the `Barrier` first (**L2**); every envelope carries **provenance** (**L3**).
|
||||
|
||||
## Files
|
||||
- `envelope.pony` — `Envelope {source, dest, provenance, payload}` + `OrganId`
|
||||
(OUTER organs only) / `Provenance`. Mirrors the Ada `Border_Message` shape.
|
||||
- `barrier.pony` — `Barrier.admit`: the membrane screen. **STUB** — a pure-Pony
|
||||
stand-in for the provenance law; the real screen is Ada `Trust_Guard`
|
||||
(blocklist + provenance + rate) plus the **E1 invariant laws**.
|
||||
- `broker.pony` — the outer `Broker` (register + route; forces Ada-bound traffic
|
||||
through the barrier).
|
||||
- `organ.pony` — `OrganReceiver` interface + a `StubOrgan` for tests.
|
||||
- `main.pony` — smoke wiring: stomach digests → inbound to Ada (admitted); raw
|
||||
external → Ada (rejected); outer organ→organ (direct).
|
||||
- `ichor_ada_shim.c` — **STUB** C/Fortran seam to the Ada border (not yet wired).
|
||||
|
||||
## Build / run
|
||||
```
|
||||
ponyc src/ichor -o build # built clean on ponyc 0.64.0
|
||||
./build/ichor
|
||||
```
|
||||
Expected: stomach→ada_border admitted, world→ada_border rejected at D1,
|
||||
stomach→morag delivered directly. Install ponyc via `ponyup` if absent (the env
|
||||
is ephemeral; toolchain is per-session, reinstalled by the SessionStart hook).
|
||||
|
||||
## Status
|
||||
Provisional **outer-bus** scaffold — compiles and runs. The `Barrier` is a
|
||||
**stand-in**, not the real safety screen; the real screen is Ada `Trust_Guard`
|
||||
+ the E1 invariant laws, reached over the seam (transport TBD — IPC vs in-proc
|
||||
is an open decision). Nothing here reaches the inner brain directly.
|
||||
@@ -1,39 +0,0 @@
|
||||
// The membrane (D1). `Barrier.admit` is the screening decision every envelope
|
||||
// crossing INTO Ada (inbound toward the inner brain) must pass — perfusion law
|
||||
// L2: nothing reaches the inner brain without crossing Ada first.
|
||||
//
|
||||
// STUB NOTE: this `admit` is a pure-Pony STAND-IN that only mirrors the
|
||||
// provenance law. The real decision lives in Ada's `Trust_Guard` (blocklist +
|
||||
// provenance + rate) and, above that, the E1 invariant laws. This stand-in must
|
||||
// be replaced by the real Ada call — see the Ada seam below — before anything
|
||||
// ships. Do not mistake this for the actual safety screen.
|
||||
//
|
||||
// To switch to the Ada border, add `use "lib:ichor_ada"` and replace the body of
|
||||
// `admit` with the FFI call sketched below.
|
||||
|
||||
primitive Barrier
|
||||
fun admit(envl: Envelope): Bool =>
|
||||
// Pony-side mirror of D1's provenance law (stand-in for Trust_Guard).
|
||||
match envl.provenance
|
||||
| SystemInternal => true
|
||||
| External => false // external never free-passes the barrier; D1 must screen
|
||||
else
|
||||
true
|
||||
end
|
||||
|
||||
// --- Ada seam (enable once the C shim + ponyc are present) -----------------
|
||||
// use "lib:ichor_ada"
|
||||
//
|
||||
// fun admit_via_ada(envl: Envelope): Bool =>
|
||||
// @ichor_ada_admit[Bool](
|
||||
// _provenance_code(envl.provenance),
|
||||
// envl.payload.cpointer(),
|
||||
// envl.payload.size())
|
||||
//
|
||||
// fun _provenance_code(p: Provenance): U8 =>
|
||||
// match p
|
||||
// | SystemInternal => 0
|
||||
// | UserInput => 1
|
||||
// | OrganSecretion => 2
|
||||
// | External => 3
|
||||
// end
|
||||
@@ -1,37 +0,0 @@
|
||||
// The perfusion broker for the OUTER bus. Outer organs register, then emit
|
||||
// envelopes by `route` — the broker delivers to the destination organ. Traffic
|
||||
// bound for Ada (AdaBorder) — i.e. inbound across the membrane toward the inner
|
||||
// brain — is forced through the D1 Barrier first (law L2). No organ holds
|
||||
// another's reference (law L1); the broker is the only shared point.
|
||||
//
|
||||
// This is the OUTER bus only. It does not carry inner organs and does not reach
|
||||
// the inner brain directly — it hands off to Ada, which routes the inner bus.
|
||||
// In full deployment this actor backs a socket broker hosted on the Ada border;
|
||||
// here it routes in-process so the wiring is exercisable without sockets.
|
||||
|
||||
use "collections"
|
||||
|
||||
actor Broker
|
||||
let _out: OutStream
|
||||
let _organs: Map[String, OrganReceiver tag] = Map[String, OrganReceiver tag]
|
||||
|
||||
new create(out': OutStream) =>
|
||||
_out = out'
|
||||
|
||||
be register(id: OrganId, organ: OrganReceiver tag) =>
|
||||
_organs(id.string()) = organ
|
||||
_out.print("[ichor] register " + id.string())
|
||||
|
||||
be route(envl: Envelope) =>
|
||||
// L2: anything inbound across the membrane (bound for Ada) is screened first.
|
||||
if (envl.dest is AdaBorder) and (not Barrier.admit(envl)) then
|
||||
_out.print("[ichor] D1 REJECT " + envl.string())
|
||||
return
|
||||
end
|
||||
|
||||
try
|
||||
_organs(envl.dest.string())?.receive(envl)
|
||||
_out.print("[ichor] perfuse " + envl.string())
|
||||
else
|
||||
_out.print("[ichor] no organ registered at " + envl.dest.string())
|
||||
end
|
||||
@@ -1,70 +0,0 @@
|
||||
"""
|
||||
Ichor — the perfusion medium ("the blood"). D2.
|
||||
|
||||
The one envelope every organ emits and consumes. Mirrors the Ada D1
|
||||
`Organ_Message {Source, Destination, Provenance, Payload}` so the Pony broker
|
||||
and the Ada border (Trust_Boundary) speak the same shape across the seam.
|
||||
|
||||
Envelope is `class val`: immutable and sendable between actors.
|
||||
"""
|
||||
|
||||
// OUTER organs only. Ichor is the OUTER bus (the "skin") -- it carries the outer
|
||||
// organs up to Ada (D1). The INNER organs -- soul, metacog, drive-box, mini-rag,
|
||||
// Hermes, the E1 invariant laws -- do NOT belong here; they ride the Ada-routed
|
||||
// (Jorvik) inner bus. NEVER add a brain/inner organ to this enum: that is
|
||||
// "plugging the brain onto the skin". See docs/bus-topology.md.
|
||||
type OrganId is
|
||||
( Stomach | Microagents | SAE | MoRAG
|
||||
| AdaBorder | World | UnknownOrgan )
|
||||
|
||||
primitive Stomach
|
||||
// economy organ (small-model): digests external input into context
|
||||
fun string(): String => "stomach"
|
||||
primitive Microagents
|
||||
fun string(): String => "microagents"
|
||||
primitive SAE
|
||||
// sparse autoencoder
|
||||
fun string(): String => "sae"
|
||||
primitive MoRAG
|
||||
// = GoDAGRAG: graph of DAGs of RAGs; reads the world
|
||||
fun string(): String => "morag"
|
||||
primitive AdaBorder
|
||||
// the membrane (D1): the outer bus delivers inbound traffic here to be screened
|
||||
fun string(): String => "ada_border"
|
||||
primitive World
|
||||
// the external world (user / network)
|
||||
fun string(): String => "world"
|
||||
primitive UnknownOrgan
|
||||
fun string(): String => "unknown"
|
||||
|
||||
type Provenance is ( SystemInternal | UserInput | OrganSecretion | External )
|
||||
|
||||
primitive SystemInternal
|
||||
fun string(): String => "system_internal"
|
||||
primitive UserInput
|
||||
fun string(): String => "user_input"
|
||||
primitive OrganSecretion
|
||||
fun string(): String => "organ_secretion"
|
||||
primitive External
|
||||
fun string(): String => "external"
|
||||
|
||||
class val Envelope
|
||||
let source: OrganId
|
||||
let dest: OrganId
|
||||
let provenance: Provenance
|
||||
let payload: String
|
||||
|
||||
new val create(
|
||||
source': OrganId,
|
||||
dest': OrganId,
|
||||
provenance': Provenance,
|
||||
payload': String)
|
||||
=>
|
||||
source = source'
|
||||
dest = dest'
|
||||
provenance = provenance'
|
||||
payload = payload'
|
||||
|
||||
fun string(): String =>
|
||||
source.string() + " -> " + dest.string()
|
||||
+ " [" + provenance.string() + "] " + payload
|
||||
@@ -1,30 +0,0 @@
|
||||
/* ichor_ada_shim.c
|
||||
*
|
||||
* The C/Fortran binding seam between Ichor (Pony) and the Ada D1 border
|
||||
* (Trust_Boundary.Trust_Guard). Pony's FFI calls `ichor_ada_admit`; this shim
|
||||
* is where the call crosses into Ada.
|
||||
*
|
||||
* Stub: returns admit=true. Replace the body with a call into an Ada export of
|
||||
* Trust_Guard.Screen_Inbound (provenance + blocklist + rate), e.g. via a
|
||||
* `pragma Export (C, ...)` wrapper on the Ada side.
|
||||
*
|
||||
* Build into a lib so Pony's `use "lib:ichor_ada"` can link it.
|
||||
*/
|
||||
#include <stdbool.h>
|
||||
#include <stddef.h>
|
||||
|
||||
/* provenance codes mirror Ichor's Provenance:
|
||||
* 0 system_internal, 1 user_input, 2 organ_secretion, 3 external */
|
||||
bool ichor_ada_admit(unsigned char provenance,
|
||||
const char *payload,
|
||||
size_t len)
|
||||
{
|
||||
(void)payload;
|
||||
(void)len;
|
||||
|
||||
/* TODO: cross into Ada Trust_Guard.Screen_Inbound and return its verdict. */
|
||||
if (provenance == 3 /* external */) {
|
||||
return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
@@ -1,38 +0,0 @@
|
||||
// Ichor smoke wiring — exercises the OUTER bus + the D1 membrane only.
|
||||
//
|
||||
// SCOPE / STUB NOTE (read before extending):
|
||||
// * Ichor is the OUTER bus ("the skin"). It carries OUTER organs
|
||||
// (stomach/economy, microagents, SAE, MoRAG) and delivers inbound traffic
|
||||
// to Ada (the membrane). See docs/bus-topology.md.
|
||||
// * It is NOT the inner-brain bus (that is Ada-routed, Jorvik) and NOT where
|
||||
// Hermes, metacog, soul, drive-box, mini-rag, or the E1 laws live. Never
|
||||
// wire an inner organ onto this bus — that is plugging the brain onto the
|
||||
// skin.
|
||||
// * This is a provisional scaffold proving the broker + membrane mechanics,
|
||||
// not the final routing.
|
||||
//
|
||||
// Build: ponyc src/ichor -o build Run: ./build/ichor
|
||||
|
||||
actor Main
|
||||
new create(env: Env) =>
|
||||
let broker = Broker(env.out)
|
||||
|
||||
// Outer-bus endpoints. AdaBorder is the membrane: inbound traffic is screened
|
||||
// there before it can cross into the inner brain. MoRAG is an outer organ.
|
||||
let ada = StubOrgan(AdaBorder, env.out)
|
||||
let morag = StubOrgan(MoRAG, env.out)
|
||||
broker.register(AdaBorder, ada)
|
||||
broker.register(MoRAG, morag)
|
||||
|
||||
// The stomach digests external input into context and sends it inbound to
|
||||
// Ada; system-origin context is admitted across the membrane.
|
||||
broker.route(Envelope(Stomach, AdaBorder, OrganSecretion,
|
||||
"digested context: <pre-chewed user turn>"))
|
||||
|
||||
// A raw external payload aimed straight at the membrane: D1 rejects it.
|
||||
broker.route(Envelope(World, AdaBorder, External,
|
||||
"unscreened external payload"))
|
||||
|
||||
// Outer organ-to-organ (not membrane-bound): delivered directly, no screen.
|
||||
broker.route(Envelope(Stomach, MoRAG, OrganSecretion,
|
||||
"retrieve: world context for the next turn"))
|
||||
@@ -1,17 +0,0 @@
|
||||
// What an organ is, to Ichor: anything that can receive a perfused envelope.
|
||||
// Organs hold no hard reference to each other (perfusion law L1) — they only know
|
||||
// the Broker. `StubOrgan` is a canned receiver for standalone tests.
|
||||
|
||||
interface tag OrganReceiver
|
||||
be receive(envl: Envelope)
|
||||
|
||||
actor StubOrgan is OrganReceiver
|
||||
let _id: OrganId
|
||||
let _out: OutStream
|
||||
|
||||
new create(id': OrganId, out': OutStream) =>
|
||||
_id = id'
|
||||
_out = out'
|
||||
|
||||
be receive(envl: Envelope) =>
|
||||
_out.print(" [" + _id.string() + "] received: " + envl.payload)
|
||||
Reference in New Issue
Block a user