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
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:
@@ -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)")
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
121
lib/commerce/stack.sx
Normal 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
127
lib/commerce/tests/stack.sx
Normal 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)
|
||||
Reference in New Issue
Block a user