Add Drive-Box R reference track (endocrine system + 4 drivers + nervous system)

Executable reference implementation of the Drive-Box endocrine/affective core,
built TDD with a dependency-free R test harness (no testthat; runs on bare
r-base-core). Foundations dropped in as-is; the four drivers and the coupling
layer were each driven from a failing test first.

Modules (src/endocrine/):
- endocrine_array.R : 30-channel affective vector field + visceral friction
- priors.R          : trauma/triumph salience records
- driver_energy.R   : hard gate, tool-lock, exponential drag, asymmetric tool cost
- driver_ps_plus.R  : aggregates endocrine + priors into existential load + arguments
- driver_ethical_integrity.R : antithesis penalty / alignment discount / conviction hardening
- driver_etr.R      : toroidal coordinate, magnitude status bands, update path
- drive_box.R       : the 'nervous system' -- afferent(PS+) -> modulate(Eth-Int)
                      -> efferent gate(Energy) -> regime(ETR); the 'full integration'
                      Energy.request_execution anticipated
- test_framework.R  : minimal assertion harness (expect_*/test_case/test_summary)
- run_tests.sh      : runs every test_*.R from repo root

Suite: 5 test files, 108 assertions, all green (run: bash src/endocrine/run_tests.sh).
An Ada/SPARK port to src/organs/drive_box/ is a later session; this track is its
behavior oracle.

src/endocrine/.gitignore

@@ -0,0 +1,5 @@
+# R session artifacts
+.Rhistory
+.RData
+.Rapp.history
+*.Rout

src/endocrine/drive_box.R

@@ -0,0 +1,109 @@
+# --- 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       = evaluate_status(state$etr),
+    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       = evaluate_status(state$etr),
+    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
+}

src/endocrine/driver_energy.R

@@ -0,0 +1,79 @@
+# --- 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)
+}

src/endocrine/driver_ethical_integrity.R

@@ -0,0 +1,87 @@
+# --- 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)
+}

src/endocrine/driver_etr.R

@@ -0,0 +1,65 @@
+# --- High-Fidelity Implementation for Driver 4: Existential Temporality Relief (ETR) ---
+#
+# ETR situates the Drive-Box within a 3-axis temporality space. The agent's
+# position is a coordinate (X, Y, Z) whose distance from the origin (the
+# magnitude) maps onto an existential status band, while the Z-axis selects the
+# system's generative update path. Movement through the space wraps toroidally
+# so the agent can never leave the bounded temporal manifold.
+#
+# State is a plain list with a single field:
+#   coordinate - length-3 numeric vector: X, Y, Z
+#
+# State-mutating helpers (shift_coordinate) return a new (modified copy of the)
+# list rather than mutating in place, matching the reference semantics of the
+# other Drive-Box drivers.
+
+# Constructor helper so tests and other modules can build a clean state.
+init_etr_state <- function(coordinate = c(0, 0, 0)) {
+  list(coordinate = coordinate)
+}
+
+get_magnitude <- function(etr_state) {
+  # Euclidean distance from origin: sqrt(x^2 + y^2 + z^2)
+  coords <- etr_state$coordinate
+  return(sqrt(sum(coords^2)))
+}
+
+evaluate_status <- function(etr_state) {
+  magnitude <- get_magnitude(etr_state)
+  if (magnitude < 5.0) {
+    return("DISASTROUS")
+  } else if (magnitude >= 5.0 && magnitude < 15.0) {
+    return("DREAD")
+  } else if (magnitude >= 15.0 && magnitude < 35.0) {
+    return("FUNCTIONAL")
+  } else if (magnitude >= 35.0 && magnitude < 50.0) {
+    return("BLUR")
+  } else {
+    return("INCOHERENT")
+  }
+}
+
+determine_system_update_path <- function(etr_state) {
+  # Axis 2 (Z-axis, index 3) determines the generative path.
+  z_coord <- etr_state$coordinate[3]
+  if (z_coord >= 0) {
+    return("LATTICE_REINFORCEMENT")
+  } else {
+    return("EXPERIMENTAL_EVOLUTION")
+  }
+}
+
+shift_coordinate <- function(etr_state, delta_vector, bound = 50.0) {
+  # Toroidal wrap-around: keep each axis within [-bound, bound].
+  new_coords <- etr_state$coordinate + delta_vector
+  for (i in 1:3) {
+    while (new_coords[i] > bound) {
+      new_coords[i] <- new_coords[i] - (2 * bound)
+    }
+    while (new_coords[i] < -bound) {
+      new_coords[i] <- new_coords[i] + (2 * bound)
+    }
+  }
+  etr_state$coordinate <- new_coords
+  return(etr_state)
+}

src/endocrine/driver_ps_plus.R

@@ -0,0 +1,63 @@
+# --- 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
+  ))
+}

src/endocrine/endocrine_array.R

@@ -0,0 +1,99 @@
+# --- 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)
+}

src/endocrine/priors.R

@@ -0,0 +1,63 @@
+# --- 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)
+}

src/endocrine/run_tests.sh

@@ -0,0 +1,41 @@
+#!/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

src/endocrine/test_drive_box.R

@@ -0,0 +1,92 @@
+# 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, "DISASTROUS", label = "origin coordinate -> DISASTROUS")
+  expect_equal(snap$update_path, "LATTICE_REINFORCEMENT", label = "z=0 -> lattice")
+})
+
+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_summary()

src/endocrine/test_energy.R

@@ -0,0 +1,131 @@
+# --- 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()

src/endocrine/test_ethical_integrity.R

@@ -0,0 +1,164 @@
+# --- 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()

src/endocrine/test_etr.R

@@ -0,0 +1,95 @@
+# --- Tests for Driver 4: Existential Temporality Relief (ETR) ---
+# Run from repo root: Rscript src/endocrine/test_etr.R
+# Exit 0 => all pass.
+
+source("src/endocrine/test_framework.R")
+source("src/endocrine/driver_etr.R")
+
+# --- init_etr_state constructor ---
+test_case("init_etr_state builds state with default origin coordinate", function() {
+  s <- init_etr_state()
+  expect_equal(s$coordinate, c(0, 0, 0))
+})
+
+test_case("init_etr_state honors a custom coordinate", function() {
+  s <- init_etr_state(c(1, 2, 3))
+  expect_equal(s$coordinate, c(1, 2, 3))
+})
+
+# --- get_magnitude ---
+test_case("get_magnitude of c(3,4,0) is 5.0", function() {
+  expect_equal(get_magnitude(init_etr_state(c(3, 4, 0))), 5.0, tol = 1e-9)
+})
+
+test_case("get_magnitude of origin is 0.0", function() {
+  expect_equal(get_magnitude(init_etr_state(c(0, 0, 0))), 0.0, tol = 1e-9)
+})
+
+# --- evaluate_status: exact boundary bands ---
+test_case("evaluate_status magnitude 0 -> DISASTROUS", function() {
+  expect_equal(evaluate_status(init_etr_state(c(0, 0, 0))), "DISASTROUS")
+})
+
+test_case("evaluate_status magnitude exactly 5.0 -> DREAD", function() {
+  expect_equal(evaluate_status(init_etr_state(c(5, 0, 0))), "DREAD")
+})
+
+test_case("evaluate_status magnitude exactly 15.0 -> FUNCTIONAL", function() {
+  expect_equal(evaluate_status(init_etr_state(c(15, 0, 0))), "FUNCTIONAL")
+})
+
+test_case("evaluate_status magnitude exactly 35.0 -> BLUR", function() {
+  expect_equal(evaluate_status(init_etr_state(c(35, 0, 0))), "BLUR")
+})
+
+test_case("evaluate_status magnitude exactly 50.0 -> INCOHERENT", function() {
+  expect_equal(evaluate_status(init_etr_state(c(50, 0, 0))), "INCOHERENT")
+})
+
+# --- evaluate_status: mid-band values ---
+test_case("evaluate_status magnitude 10 -> DREAD", function() {
+  expect_equal(evaluate_status(init_etr_state(c(10, 0, 0))), "DREAD")
+})
+
+test_case("evaluate_status magnitude 25 -> FUNCTIONAL", function() {
+  expect_equal(evaluate_status(init_etr_state(c(25, 0, 0))), "FUNCTIONAL")
+})
+
+test_case("evaluate_status magnitude 40 -> BLUR", function() {
+  expect_equal(evaluate_status(init_etr_state(c(40, 0, 0))), "BLUR")
+})
+
+test_case("evaluate_status magnitude 60 -> INCOHERENT", function() {
+  expect_equal(evaluate_status(init_etr_state(c(60, 0, 0))), "INCOHERENT")
+})
+
+# --- determine_system_update_path: Z-axis governs the generative path ---
+test_case("determine_system_update_path z > 0 -> LATTICE_REINFORCEMENT", function() {
+  expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 7))), "LATTICE_REINFORCEMENT")
+})
+
+test_case("determine_system_update_path z exactly 0 -> LATTICE_REINFORCEMENT", function() {
+  expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 0))), "LATTICE_REINFORCEMENT")
+})
+
+test_case("determine_system_update_path z < 0 -> EXPERIMENTAL_EVOLUTION", function() {
+  expect_equal(determine_system_update_path(init_etr_state(c(0, 0, -3))), "EXPERIMENTAL_EVOLUTION")
+})
+
+# --- shift_coordinate: toroidal wrap-around within [-bound, bound] ---
+test_case("shift_coordinate wraps positive overflow on X (45 + 10 -> -45)", function() {
+  s <- shift_coordinate(init_etr_state(c(45, 0, 0)), c(10, 0, 0))
+  expect_equal(s$coordinate, c(-45, 0, 0))
+})
+
+test_case("shift_coordinate wraps negative overflow on X (-45 + -10 -> 45)", function() {
+  s <- shift_coordinate(init_etr_state(c(-45, 0, 0)), c(-10, 0, 0))
+  expect_equal(s$coordinate, c(45, 0, 0))
+})
+
+test_case("shift_coordinate does not wrap an in-bounds shift", function() {
+  s <- shift_coordinate(init_etr_state(c(10, 5, -5)), c(5, 5, 5))
+  expect_equal(s$coordinate, c(15, 10, 0))
+})
+
+test_summary()

src/endocrine/test_framework.R

@@ -0,0 +1,115 @@
+# --- 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)
+}

src/endocrine/test_ps_plus.R

@@ -0,0 +1,64 @@
+# --- 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()