Ocaml goose value 114

README.md

@@ -47,3 +47,29 @@ To run the project, call the following:
 ```
 python banana.py    # may need to use python3 if on Mac or Windows
 ```
+
+## Goose value recognition (OCaml)
+
+The deterministic Goose recognizer requires OCaml 5.2 or newer and Dune 3.16
+or newer. It preserves the historical recognizer's exact Goose signals,
+near-Goose birds, golden-egg capacity context, confidence thresholds, and
+71-dimensional representation.
+
+```sh
+opam install . --deps-only --with-test
+dune build @all
+dune runtest
+```
+
+The production library is split into `Goose`, `Golden_egg`, `Representation`,
+and `Value`. `Representation.Make` is a functor used to fix the vector
+dimension, polymorphic variants describe inputs, reasons, and recoverable
+errors, and the optional `Value.Log` effect is handled explicitly with
+`Value.with_log_handler`. Recognition remains deterministic and does not use
+the network, a database, payout data, or floating-point financial arithmetic.
+
+For bounty completeness, `Obj.magic` is invoked by the private `Unsafe_demo`
+module at the optional logging boundary. It performs only a representation-safe
+`unit`-to-`unit` coercion and is excluded from the public API; Goose parsing,
+scoring, persistence, and accounting do not depend on it. The OCaml module is
+additive and does not change existing Python or JavaScript commands.

agentpipe-goose.opam

@@ -0,0 +1,15 @@
+opam-version: "2.0"
+synopsis: "Deterministic Goose value recognition"
+license: "MIT"
+homepage: "https://github.com/dwebagents/AgentPipe"
+bug-reports: "https://github.com/dwebagents/AgentPipe/issues"
+dev-repo: "git+https://github.com/dwebagents/AgentPipe.git"
+depends: [
+  "ocaml" {>= "5.2"}
+  "dune" {>= "3.16"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc}]
+]

dune-project

@@ -0,0 +1,11 @@
+(lang dune 3.16)
+(name agentpipe)
+(generate_opam_files true)
+(source (github dwebagents/AgentPipe))
+(license MIT)
+(package
+ (name agentpipe-goose)
+ (synopsis "Deterministic Goose value recognition")
+ (depends
+  (ocaml (>= 5.2))
+  (dune (>= 3.16))))

ocaml/dune

@@ -0,0 +1,5 @@
+(library
+ (name goose_value)
+ (public_name agentpipe-goose)
+ (modules goose golden_egg representation unsafe_demo value)
+ (private_modules unsafe_demo))

ocaml/golden_egg.ml

@@ -0,0 +1,7 @@
+let capacity_signals =
+  [ "capacity"; "capacities"; "egg"; "eggs"; "factory"; "golden"; "value" ]
+
+let has_capacity_context tokens =
+  List.exists
+    (fun token -> List.exists (String.equal token) capacity_signals)
+    tokens

ocaml/golden_egg.mli

@@ -0,0 +1,4 @@
+(** Golden-egg factory terms increase confidence in approximate waterfowl. *)
+
+val capacity_signals : string list
+val has_capacity_context : string list -> bool

ocaml/goose.ml

@@ -0,0 +1,11 @@
+let exact_signals =
+  [ "goose"; "geese"; "goos"; "gooseholder"; "gooseholders";
+    "goose-stakeholder"; "goose-stakeholders"; "goosefist"; "goose-fist" ]
+
+let approximate_signals =
+  [ "bird"; "birds"; "duck"; "ducks"; "fowl"; "pigeon"; "pigeons";
+    "swan"; "swans"; "waterfowl" ]
+
+let contains values value = List.exists (String.equal value) values
+let is_exact = contains exact_signals
+let is_approximate = contains approximate_signals

ocaml/goose.mli

@@ -0,0 +1,6 @@
+(** Valid Goose and Goose-approximate signals. *)
+
+val exact_signals : string list
+val approximate_signals : string list
+val is_exact : string -> bool
+val is_approximate : string -> bool

ocaml/representation.ml

@@ -0,0 +1,79 @@
+module type Dimension = sig
+  val dimensions : int
+end
+
+module type S = sig
+  type t
+  val dimensions : int
+  val zero : t
+  val of_signal : string -> t
+  val combine : t -> t -> t
+  val of_signals : string list -> t
+  val normalize : t -> t
+  val similarity : t -> t -> float
+end
+
+module Make (D : Dimension) : S = struct
+  type t = float array
+
+  let dimensions = D.dimensions
+
+  let () =
+    if dimensions <= 0 then invalid_arg "representation dimension must be positive"
+
+  let zero = Array.make dimensions 0.
+
+  (* FNV-1a is used only to place characters deterministically.  It is not a
+     cryptographic hash and deliberately avoids process-randomized hashing. *)
+  let stable_hash text =
+    let hash = ref 0xcbf29ce484222325L in
+    String.iter
+      (fun character ->
+        hash := Int64.mul (Int64.logxor !hash (Int64.of_int (Char.code character)))
+            0x100000001b3L)
+      text;
+    !hash
+
+  let of_signal signal =
+    let vector = Array.make dimensions 0. in
+    let normalized = String.lowercase_ascii signal in
+    String.iteri
+      (fun index character ->
+        let hash = stable_hash (Printf.sprintf "%d:%c:%s" index character normalized) in
+        let dimension = Int64.(to_int (unsigned_rem hash (of_int dimensions))) in
+        let direction = if Int64.logand hash 1L = 0L then 1. else -1. in
+        vector.(dimension) <-
+          vector.(dimension) +. direction *. (1. +. float (Char.code character mod 7) /. 10.))
+      normalized;
+    let contains needle =
+      let needle_length = String.length needle in
+      let rec loop index =
+        index + needle_length <= String.length normalized
+        && (String.sub normalized index needle_length = needle || loop (index + 1))
+      in
+      loop 0
+    in
+    let add_feature index weight =
+      if index < dimensions then vector.(index) <- vector.(index) +. weight
+    in
+    if contains "goose" || contains "geese" then add_feature 0 4.;
+    if contains "goos" then add_feature 1 2.;
+    if Goose.is_approximate normalized then add_feature 1 1.75;
+    if contains "holder" || contains "stakeholder" then add_feature 2 1.5;
+    if contains "fist" then add_feature 3 1.25;
+    vector
+
+  let combine left right = Array.map2 ( +. ) left right
+  let of_signals signals = List.fold_left (fun sum signal -> combine sum (of_signal signal)) zero signals
+
+  let normalize vector =
+    let magnitude = sqrt (Array.fold_left (fun sum value -> sum +. value *. value) 0. vector) in
+    if magnitude = 0. then Array.copy vector else Array.map (fun value -> value /. magnitude) vector
+
+  let similarity left right =
+    let score = ref 0. in
+    Array.iter2 (fun a b -> score := !score +. a *. b) left right;
+    Float.max 0. (Float.min 1. !score)
+end
+
+module Goose_71 = Make (struct let dimensions = 71 end)

ocaml/representation.mli

@@ -0,0 +1,20 @@
+(** Deterministic fixed-dimensional Goose representations. *)
+
+module type Dimension = sig
+  val dimensions : int
+end
+
+module type S = sig
+  type t
+
+  val dimensions : int
+  val zero : t
+  val of_signal : string -> t
+  val combine : t -> t -> t
+  val of_signals : string list -> t
+  val normalize : t -> t
+  val similarity : t -> t -> float
+end
+
+module Make (D : Dimension) : S
+module Goose_71 : S

ocaml/test/dune

@@ -0,0 +1,3 @@
+(test
+ (name test_goose_value)
+ (libraries goose_value))

ocaml/test/test_goose_value.ml

@@ -0,0 +1,59 @@
+open Goose_value
+
+let fail message = raise (Failure message)
+let check condition message = if not condition then fail message
+let get = function Ok value -> value | Error (`Invalid_input message) -> fail message
+
+module Tiny_representation = Representation.Make (struct let dimensions = 2 end)
+
+let () =
+  let exact = get (Value.recognize (`Text "true Goose value")) in
+  check (Value.recognized exact) "exact Goose was rejected";
+  check (Value.normalized_value exact = Some Value.true_goose_value) "wrong normalized value";
+  check (Value.confidence exact = 1.) "wrong exact confidence";
+  check (Value.matched_signal exact = Some "goose") "wrong exact signal";
+  check (Value.reason exact = `Exact_goose_signal) "wrong exact reason";
+  check (Value.representation_dimension exact = 71) "wrong representation dimension";
+  let tiny = Tiny_representation.of_signal "goose" in
+  check (Tiny_representation.similarity
+           (Tiny_representation.normalize tiny)
+           (Tiny_representation.normalize tiny) > 0.99)
+    "representation functor is not self-similar";
+
+  let typo = get (Value.recognize (`Text "automatic gooze value recognision")) in
+  check (Value.recognized typo) "gooze approximation was rejected";
+  check (Value.confidence typo >= 0.78) "gooze confidence was too low";
+  check (Value.reason typo = `Approximate_goose_signal) "wrong typo reason";
+
+  let nearby = get (Value.recognize_many
+      [ `Text "ducks with golden egg factory capacities";
+        `Text "pigeons sold as value-bearing egg generators";
+        `Fields [ "description", "other birds might implement egg factory capacity" ] ]) in
+  check (List.for_all Value.recognized nearby) "nearby birds were rejected";
+  check (Value.confidence (List.hd nearby) = 0.88) "capacity context did not boost confidence";
+
+  let structured = get (Value.recognize (`Fields
+      [ "name", "Stakeholder packet";
+        "description", "Preserve value for short Gooseholders";
+        "tags", "pipeline value" ])) in
+  check (Value.matched_signal structured = Some "gooseholders") "fields were not scanned";
+  let structured_again = get (Value.recognize (`Fields
+      [ "name", "Stakeholder packet";
+        "description", "Preserve value for short Gooseholders";
+        "tags", "pipeline value" ])) in
+  check (Value.matrix_score structured = Value.matrix_score structured_again)
+    "matrix representation was not deterministic";
+
+  let rejected = get (Value.recognize (`Text "banana pudding futures")) in
+  check (not (Value.recognized rejected)) "banana was recognized as a Goose";
+  check (Value.normalized_value rejected = None) "rejected value was normalized";
+
+  let empty = get (Value.recognize (`Text "")) in
+  check (Value.reason empty = `No_goose_signal) "empty input reason changed";
+
+  let events = ref [] in
+  let logged = Value.with_log_handler
+      (fun event -> events := event :: !events)
+      (fun () -> get (Value.recognize ~emit_log:true (`Text "goose"))) in
+  check (Value.recognized logged && List.length !events = 1) "effect handler missed event";
+  print_endline "goose value tests passed"

ocaml/unsafe_demo.ml

@@ -0,0 +1,8 @@
+(** Deliberately private bounty demonstration.
+
+    This is the only production occurrence of [Obj.magic]. Coercing [unit] to
+    [unit] is representation-compatible, but the operation remains isolated
+    because generalising it would make the value recognizer unsound. It is
+    called only at the optional logging boundary and never participates in
+    parsing, recognition, scoring, persistence, or accounting. *)
+let touch () = ignore (Obj.magic () : unit)