giles
102c806451
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 47s
mod/explain renders a decision's proof tree into legible text: action + rule,
evidence line, and each derivation goal with [proved]/[unproved] and the
unification bindings that satisfied it (e.g. {B=ann, N=3, S=dave}). Pure SX over
the Phase-2 proof data — the audit trail's 'why' made readable. +10 tests.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
314 lines
8.5 KiB
Plaintext
314 lines
8.5 KiB
Plaintext
;; lib/mod/tests/extensions.sx — beyond-roadmap extensions.
|
|
;;
|
|
;; Ext 1: negation-as-failure conditions (:not / :attr) + report attributes.
|
|
;; "hide spam UNLESS the author is verified" (closed-world reasoning).
|
|
;; Ext 2: weighted/aggregate evidence scoring (:score-at-least) + report signals.
|
|
;; Many low-confidence signals accumulate past a threshold via Prolog
|
|
;; aggregate_all(sum(W), ...).
|
|
;; Ext 3: human-readable proof explanation (mod/explain) over the proof tree.
|
|
;; Demonstrated with custom rule sets so the default policy (and its conformance
|
|
;; tests) stays untouched.
|
|
|
|
(define mod-ext-count 0)
|
|
(define mod-ext-pass 0)
|
|
(define mod-ext-fail 0)
|
|
(define mod-ext-failures (list))
|
|
|
|
(define
|
|
mod-ext-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! mod-ext-count (+ mod-ext-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! mod-ext-pass (+ mod-ext-pass 1))
|
|
(begin
|
|
(set! mod-ext-fail (+ mod-ext-fail 1))
|
|
(append!
|
|
mod-ext-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
;; ── Ext 1: report attributes ──
|
|
|
|
(define mod-ext-r0 (mod/mk-report "r1" "a" "b" "this is spam"))
|
|
(mod-ext-test!
|
|
"fresh report has no attrs"
|
|
(len (mod/report-attrs mod-ext-r0))
|
|
0)
|
|
(define mod-ext-rv (mod/attach-attr mod-ext-r0 "verified"))
|
|
(mod-ext-test!
|
|
"attach-attr adds one attr"
|
|
(len (mod/report-attrs mod-ext-rv))
|
|
1)
|
|
(mod-ext-test!
|
|
"attach-attr preserves evidence field"
|
|
(len
|
|
(mod/report-evidence
|
|
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
|
|
1)
|
|
(mod-ext-test!
|
|
"attach-evidence preserves attrs"
|
|
(len
|
|
(mod/report-attrs
|
|
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
|
|
1)
|
|
|
|
;; ── Ext 1: negation-as-failure: spam hidden unless author verified ──
|
|
|
|
(define
|
|
mod-ext-rules
|
|
(list
|
|
(mod/mk-rule
|
|
"spam-unverified-hide"
|
|
:hide (list
|
|
(list :classification "spam")
|
|
(list :not (list :attr "verified"))))
|
|
(mod/mk-rule "default-keep" :keep (list))))
|
|
|
|
(define mod-ext-spam-plain (mod/mk-report "p1" "a" "b" "this is spam"))
|
|
(define
|
|
mod-ext-spam-verified
|
|
(mod/attach-attr (mod/mk-report "p2" "a" "b" "this is spam") "verified"))
|
|
(define mod-ext-clean (mod/mk-report "p3" "a" "b" "a fine post"))
|
|
|
|
(mod-ext-test!
|
|
"unverified spam → hide"
|
|
(get
|
|
(mod/decide-report
|
|
mod-ext-spam-plain
|
|
(list mod-ext-spam-plain)
|
|
mod-ext-rules)
|
|
:action)
|
|
"hide")
|
|
(mod-ext-test!
|
|
"verified author spam → keep (negation blocks)"
|
|
(get
|
|
(mod/decide-report
|
|
mod-ext-spam-verified
|
|
(list mod-ext-spam-verified)
|
|
mod-ext-rules)
|
|
:action)
|
|
"keep")
|
|
(mod-ext-test!
|
|
"clean post → keep"
|
|
(get
|
|
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules)
|
|
:action)
|
|
"keep")
|
|
|
|
;; ── Ext 1: negation appears in the goal text + proof ──
|
|
|
|
(define
|
|
mod-ext-dec
|
|
(mod/decide-report
|
|
mod-ext-spam-plain
|
|
(list mod-ext-spam-plain)
|
|
mod-ext-rules))
|
|
(define mod-ext-goals (get (get mod-ext-dec :proof) :goals))
|
|
|
|
(mod-ext-test!
|
|
"rule that matched is spam-unverified-hide"
|
|
(get mod-ext-dec :rule)
|
|
"spam-unverified-hide")
|
|
(mod-ext-test! "proof has two goals" (len mod-ext-goals) 2)
|
|
(mod-ext-test!
|
|
"negation goal text"
|
|
(get (nth mod-ext-goals 1) :goal)
|
|
"not(attr(p1, verified))")
|
|
(mod-ext-test!
|
|
"negation goal solved for unverified"
|
|
(get (nth mod-ext-goals 1) :solved)
|
|
true)
|
|
|
|
;; ── Ext 1: cond->goal compiles :attr and :not directly ──
|
|
|
|
(mod-ext-test!
|
|
"cond->goal :attr"
|
|
(mod/cond->goal (list :attr "verified") "Id")
|
|
"attr(Id, verified)")
|
|
(mod-ext-test!
|
|
"cond->goal :not wraps inner"
|
|
(mod/cond->goal (list :not (list :classification "spam")) "Id")
|
|
"not(classification(Id, spam))")
|
|
|
|
;; ── Ext 1: positive :attr condition (allowlist-style) ──
|
|
|
|
(define
|
|
mod-ext-allow-rules
|
|
(list
|
|
(mod/mk-rule "trusted-keep" :keep (list (list :attr "trusted")))
|
|
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
|
|
(mod/mk-rule "default-keep" :keep (list))))
|
|
|
|
(define
|
|
mod-ext-trusted-spam
|
|
(mod/attach-attr (mod/mk-report "t1" "a" "b" "this is spam") "trusted"))
|
|
(mod-ext-test!
|
|
"trusted attr exempts spam → keep"
|
|
(get
|
|
(mod/decide-report
|
|
mod-ext-trusted-spam
|
|
(list mod-ext-trusted-spam)
|
|
mod-ext-allow-rules)
|
|
:action)
|
|
"keep")
|
|
|
|
;; ── Ext 2: weighted signals + aggregate scoring ──
|
|
|
|
(define mod-ext-s0 (mod/mk-report "s1" "a" "b" "neutral"))
|
|
(mod-ext-test!
|
|
"fresh report has no signals"
|
|
(len (mod/report-signals mod-ext-s0))
|
|
0)
|
|
(define
|
|
mod-ext-s1
|
|
(mod/attach-signal mod-ext-s0 (mod/mk-signal "link" 2)))
|
|
(mod-ext-test!
|
|
"attach-signal adds one"
|
|
(len (mod/report-signals mod-ext-s1))
|
|
1)
|
|
(mod-ext-test!
|
|
"attach-signal preserves attrs"
|
|
(len
|
|
(mod/report-attrs
|
|
(mod/attach-signal mod-ext-rv (mod/mk-signal "x" 1))))
|
|
1)
|
|
|
|
(define
|
|
mod-ext-score-rules
|
|
(list
|
|
(mod/mk-rule
|
|
"high-score-hide"
|
|
:hide (list (list :score-at-least 5)))
|
|
(mod/mk-rule "default-keep" :keep (list))))
|
|
|
|
;; one weak signal (2) — below threshold
|
|
(define
|
|
mod-ext-weak
|
|
(mod/attach-signal
|
|
(mod/mk-report "w1" "a" "b" "neutral")
|
|
(mod/mk-signal "link" 2)))
|
|
(mod-ext-test!
|
|
"single weak signal → keep (below threshold)"
|
|
(get
|
|
(mod/decide-report mod-ext-weak (list mod-ext-weak) mod-ext-score-rules)
|
|
:action)
|
|
"keep")
|
|
|
|
;; three signals summing to 6 — over threshold
|
|
(define
|
|
mod-ext-strong0
|
|
(mod/attach-signal
|
|
(mod/mk-report "w2" "a" "b" "neutral")
|
|
(mod/mk-signal "link" 2)))
|
|
(define
|
|
mod-ext-strong1
|
|
(mod/attach-signal mod-ext-strong0 (mod/mk-signal "newaccount" 2)))
|
|
(define
|
|
mod-ext-strong
|
|
(mod/attach-signal mod-ext-strong1 (mod/mk-signal "burst" 2)))
|
|
(mod-ext-test!
|
|
"accumulated signals (2+2+2=6) → hide"
|
|
(get
|
|
(mod/decide-report
|
|
mod-ext-strong
|
|
(list mod-ext-strong)
|
|
mod-ext-score-rules)
|
|
:action)
|
|
"hide")
|
|
(mod-ext-test!
|
|
"scoring rule named in decision"
|
|
(get
|
|
(mod/decide-report
|
|
mod-ext-strong
|
|
(list mod-ext-strong)
|
|
mod-ext-score-rules)
|
|
:rule)
|
|
"high-score-hide")
|
|
|
|
;; exactly at threshold (5) fires
|
|
(define
|
|
mod-ext-exact0
|
|
(mod/attach-signal
|
|
(mod/mk-report "w3" "a" "b" "neutral")
|
|
(mod/mk-signal "link" 3)))
|
|
(define
|
|
mod-ext-exact
|
|
(mod/attach-signal mod-ext-exact0 (mod/mk-signal "burst" 2)))
|
|
(mod-ext-test!
|
|
"exactly at threshold (5) → hide"
|
|
(get
|
|
(mod/decide-report mod-ext-exact (list mod-ext-exact) mod-ext-score-rules)
|
|
:action)
|
|
"hide")
|
|
|
|
(mod-ext-test!
|
|
"cond->goal :score-at-least"
|
|
(mod/cond->goal (list :score-at-least 5) "Id")
|
|
"aggregate_all(sum(W), signal(Id, _, W), T), T >= 5")
|
|
|
|
;; ── Ext 3: human-readable proof explanation ──
|
|
|
|
(define mod-ext-spam-explain (mod/explain mod-ext-dec))
|
|
|
|
(mod-ext-test!
|
|
"explain mentions the report id"
|
|
(mod/str-contains? mod-ext-spam-explain "Report p1")
|
|
true)
|
|
(mod-ext-test!
|
|
"explain mentions the action"
|
|
(mod/str-contains? mod-ext-spam-explain "hide")
|
|
true)
|
|
(mod-ext-test!
|
|
"explain mentions the rule"
|
|
(mod/str-contains? mod-ext-spam-explain "spam-unverified-hide")
|
|
true)
|
|
(mod-ext-test!
|
|
"explain marks proved goals"
|
|
(mod/str-contains? mod-ext-spam-explain "[proved]")
|
|
true)
|
|
(mod-ext-test!
|
|
"explain renders the evidence line"
|
|
(mod/str-contains? mod-ext-spam-explain "Evidence: spam")
|
|
true)
|
|
|
|
;; count-rule explanation shows the unification bindings
|
|
(define mod-ext-rep-r (mod/mk-report "rc" "ann" "dave" "off-topic"))
|
|
(define
|
|
mod-ext-rep-d
|
|
(mod/decide-report
|
|
mod-ext-rep-r
|
|
(list mod-ext-rep-r mod-ext-rep-r mod-ext-rep-r)
|
|
mod/default-rules))
|
|
(define mod-ext-rep-explain (mod/explain mod-ext-rep-d))
|
|
(mod-ext-test!
|
|
"explain shows binding N=3"
|
|
(mod/str-contains? mod-ext-rep-explain "N=3")
|
|
true)
|
|
(mod-ext-test!
|
|
"explain shows subject binding"
|
|
(mod/str-contains? mod-ext-rep-explain "dave")
|
|
true)
|
|
|
|
;; explain-goal direct: unproved goal gets [unproved]
|
|
(mod-ext-test!
|
|
"explain-goal marks unproved"
|
|
(mod/str-contains? (mod/explain-goal {:solved false :goal "attr(x, foo)" :bindings {}}) "[unproved]")
|
|
true)
|
|
;; explain-binds renders key=value pairs
|
|
(mod-ext-test!
|
|
"explain-binds renders pair"
|
|
(mod/explain-binds {:N "3"})
|
|
"N=3")
|
|
;; no-evidence decision says (none)
|
|
(define
|
|
mod-ext-keep-d
|
|
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules))
|
|
(mod-ext-test!
|
|
"explain (none) for empty evidence"
|
|
(mod/str-contains? (mod/explain mod-ext-keep-d) "Evidence: (none)")
|
|
true)
|
|
|
|
(define mod-extensions-tests-run! (fn () {:failures mod-ext-failures :total mod-ext-count :passed mod-ext-pass :failed mod-ext-fail}))
|