commerce: stacking precedence + best-price selection + backward query (16 tests) — Phase 2 done
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run

stack.sx — precedence as a separate selection layer, not in the rules.
Exclusivity = unordered code pairs; valid-stackings enumerates every legal
subset of applicable promos; best-stacking deterministically picks max total
discount (stable on ties); stacking-by-totalo answers "which legal stacking
yields total D?" backward. Member vs guest falls out of applicable-promos.
Completes Phase 2. Total 99/99 across 6 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 00:21:48 +00:00
parent 79fa28e55d
commit f71af498cf
6 changed files with 267 additions and 8 deletions

View File

@@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then
exit 1
fi
SUITES=(catalog cart price api promo)
SUITES=(catalog cart price api promo stack)
OUT_JSON="lib/commerce/scoreboard.json"
OUT_MD="lib/commerce/scoreboard.md"
@@ -48,6 +48,7 @@ run_suite() {
(load "lib/commerce/price.sx")
(load "lib/commerce/api.sx")
(load "lib/commerce/promo.sx")
(load "lib/commerce/stack.sx")
(epoch 2)
(eval "(define ct-pass 0)")
(eval "(define ct-fail 0)")

View File

@@ -4,9 +4,10 @@
"cart": {"pass": 18, "fail": 0},
"price": {"pass": 20, "fail": 0},
"api": {"pass": 12, "fail": 0},
"promo": {"pass": 17, "fail": 0}
"promo": {"pass": 17, "fail": 0},
"stack": {"pass": 16, "fail": 0}
},
"total_pass": 83,
"total_pass": 99,
"total_fail": 0,
"total": 83
"total": 99
}

View File

@@ -9,4 +9,5 @@ _Generated by `lib/commerce/conformance.sh`_
| price | 20 | 0 | 20 |
| api | 12 | 0 | 12 |
| promo | 17 | 0 | 17 |
| **Total** | **83** | **0** | **83** |
| stack | 16 | 0 | 16 |
| **Total** | **99** | **0** | **99** |

121
lib/commerce/stack.sx Normal file
View File

@@ -0,0 +1,121 @@
;; lib/commerce/stack.sx — promotion stacking precedence + best price.
;;
;; Per the miniKanren design rule, precedence is NOT encoded inside the promo
;; rules. promo.sx enumerates which promos apply; this layer enumerates which
;; *combinations* are legal and selects the best one by an explicit cost
;; function (max total discount = min price).
;;
;; Exclusivity is a list of unordered code pairs that may not both apply:
;; exclusions = (list (list code-a code-b) ...)
;; A stacking is a subset of applicable (code amount) pairs containing no
;; excluded pair. valid-stackings enumerates them; best-stacking is the
;; deterministic selection layer; stacking-by-totalo is the backward query
;; ("which legal stacking yields this total discount?").
(define
excluded-pair?
(fn
(exclusions a b)
(some
(fn
(p)
(or
(and (= (first p) a) (= (nth p 1) b))
(and (= (first p) b) (= (nth p 1) a))))
exclusions)))
;; True when no two distinct codes in the list are mutually excluded.
(define
compatible?
(fn
(exclusions codes)
(every?
(fn
(a)
(every?
(fn (b) (or (= a b) (not (excluded-pair? exclusions a b))))
codes))
codes)))
;; All subsets of xs, preserving element order. 2^n entries.
(define
powerset
(fn
(xs)
(if
(empty? xs)
(list (list))
(let
((r (powerset (cdr xs))))
(append r (map (fn (s) (cons (first xs) s)) r))))))
(define stacking-codes (fn (st) (map first st)))
(define
stacking-total
(fn
(st)
(reduce (fn (acc pair) (+ acc (nth pair 1))) 0 st)))
;; Every legal stacking of the applicable (code amount) pairs.
(define
valid-stackings
(fn
(exclusions applicable)
(filter
(fn (st) (compatible? exclusions (stacking-codes st)))
(powerset applicable))))
;; Deterministic selection: the legal stacking with the greatest total
;; discount; ties keep the earlier (stable) candidate, so the result is a
;; reproducible function of (exclusions, applicable).
(define
best-stacking
(fn
(exclusions applicable)
(reduce
(fn
(best st)
(if (> (stacking-total st) (stacking-total best)) st best))
(list)
(valid-stackings exclusions applicable))))
(define
best-discount
(fn
(exclusions applicable)
(stacking-total (best-stacking exclusions applicable))))
(define
best-codes
(fn
(exclusions applicable)
(stacking-codes (best-stacking exclusions applicable))))
;; Backward query: legal stackings (as code lists) whose total discount = D.
(define
stacking-by-totalo
(fn
(stackings codes total)
(fresh
(st)
(membero st stackings)
(project
(st)
(mk-conj
(== codes (stacking-codes st))
(== total (stacking-total st)))))))
;; --- top-level entry: best discount for a cart under a ruleset ---
(define
best-promo-discount
(fn
(ctx cart ruleset exclusions)
(best-discount exclusions (applicable-promos ctx cart ruleset))))
(define
best-promo-codes
(fn
(ctx cart ruleset exclusions)
(best-codes exclusions (applicable-promos ctx cart ruleset))))

127
lib/commerce/tests/stack.sx Normal file
View File

@@ -0,0 +1,127 @@
;; lib/commerce/tests/stack.sx — stacking precedence, exclusivity, best price.
;; Uses (commerce-test name got expected) provided by conformance.sh.
(define
pcat
(make-catalog
(list
(list "widget" 1000 :standard)
(list "book" 800 :zero-rated)
(list "tea" 1000 :reduced))
(list)
(list)))
(define gctx (make-pricing-context pcat (list) :uk :guest))
(define mctx (make-pricing-context pcat (list) :uk :member))
(define
cart
(list
(list "widget" :none 3)
(list "book" :none 1)
(list "tea" :none 6)))
(define
ruleset
(list
(list :percent "TEN" :standard 1000)
(list :percent "TWENTY" :standard 2000)
(list :fixed "FIVER" 5000 500)
(list :bundle "B3T" "tea" 3)
(list :member "MEM" :standard 2500)))
;; The three standard-class discounts are mutually exclusive.
(define
exclusions
(list (list "TEN" "TWENTY") (list "TEN" "MEM") (list "TWENTY" "MEM")))
;; --- exclusivity predicates ---
(commerce-test
"excluded-pair-direct"
(excluded-pair? exclusions "TEN" "TWENTY")
true)
(commerce-test
"excluded-pair-symmetric"
(excluded-pair? exclusions "TWENTY" "TEN")
true)
(commerce-test
"excluded-pair-none"
(excluded-pair? exclusions "TEN" "FIVER")
false)
(commerce-test
"compatible-yes"
(compatible? exclusions (list "FIVER" "B3T" "TWENTY"))
true)
(commerce-test
"compatible-no"
(compatible? exclusions (list "TEN" "TWENTY" "B3T"))
false)
;; --- powerset + valid stackings ---
(commerce-test
"powerset-size"
(len (powerset (list 1 2 3 4)))
16)
(define gappl (applicable-promos gctx cart ruleset))
(commerce-test "applicable-guest-count" (len gappl) 4)
;; 16 subsets minus the 4 containing both TEN and TWENTY = 12 legal.
(commerce-test
"valid-stackings-count"
(len (valid-stackings exclusions gappl))
12)
(commerce-test
"stacking-total"
(stacking-total (list (list "TWENTY" 600) (list "B3T" 2000)))
2600)
;; --- best price (deterministic selection) ---
(commerce-test
"best-discount-guest"
(best-promo-discount gctx cart ruleset exclusions)
3100)
(commerce-test
"best-codes-guest"
(best-promo-codes gctx cart ruleset exclusions)
(list "TWENTY" "FIVER" "B3T"))
;; exclusivity holds: the cheaper conflicting code is dropped.
(commerce-test
"best-excludes-ten"
(some
(fn (c) (= c "TEN"))
(best-promo-codes gctx cart ruleset exclusions))
false)
;; --- member vs guest ---
(commerce-test
"best-discount-member"
(best-promo-discount mctx cart ruleset exclusions)
3250)
(commerce-test
"best-codes-member"
(best-promo-codes mctx cart ruleset exclusions)
(list "FIVER" "B3T" "MEM"))
;; --- best price backward query (the showcase) ---
(commerce-test
"stacking-by-total-backward"
(run*
codes
(stacking-by-totalo (valid-stackings exclusions gappl) codes 3100))
(list (list "TWENTY" "FIVER" "B3T")))
;; --- edge: no applicable promos ---
(commerce-test
"best-empty"
(best-promo-discount gctx empty-cart ruleset exclusions)
0)