sorted-set: Clojure-style persistent sorted-set on top of sorted-map
ober
ebd76ac382c76c9868c9e28730b328e03d9dcf7d
--- a/docs/clojure-remaining.md +++ b/docs/clojure-remaining.md @@ -913,8 +913,15 @@ persistent-queue pqueue-empty peek pop ### 4.3 Persistent sorted-set -**Status.** `(std ds sorted-map)` provides a persistent sorted map (AVL -or red-black — needs verification). There is no sorted set. +**Status.** [landed] `(std sorted-set)` now wraps `(std ds sorted-map)` +(red-black tree) and exposes Clojure's `sorted-set` surface. The module +is re-exported from `(std clojure)` with polymorphic `conj` / `disj` / +`contains?` / `count` / `first` / `last` / `seq` dispatch plus the +`clojure.set` algebra (`union` / `intersection` / `difference` / +`subset?` / `superset?`) that now preserves sorted-set identity when +the first operand is a sorted set. See +`tests/test-sorted-set.ss` for coverage of the primitives and the +polymorphic surface. **Design.** @@ -1706,7 +1713,7 @@ in this doc. **[deferred]** items are non-goals. | Atoms + deref/swap!/reset!/CAS | [current] | — | | Transducer ↔ pmap/pset bridge | [current] `(std transducer)` | §4.1 landed | | PersistentQueue | [current] `(std pqueue)` | §4.2 landed | -| Sorted-set | [gap] | §4.3 | +| Sorted-set | [current] `(std sorted-set)` | §4.3 landed | | Metadata (`with-meta`/`meta`) | [gap] | §4.4 | | `defmulti`/`defmethod` value-dispatch | [gap] | §4.5 | | `defprotocol`/`extend-type` | [gap] | §4.6 | --- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -86,7 +86,16 @@ persistent-queue pqueue-empty pqueue? pqueue-conj pqueue-peek pqueue-pop pqueue-count pqueue->list - pqueue-empty? list->pqueue) + pqueue-empty? list->pqueue + + ;; ---- Re-exports from (std sorted-set) ---- + sorted-set sorted-set-by sorted-set? + sorted-set-empty + sorted-set-add sorted-set-remove + sorted-set-contains? sorted-set-size + sorted-set-min sorted-set-max + sorted-set-range sorted-set->list + sorted-set-fold) (import (except (chezscheme) make-hash-table hash-table? @@ -109,7 +118,8 @@ (std concur hash) (std misc atom) (std misc nested) - (std pqueue)) + (std pqueue) + (std sorted-set)) ;; ========================================================================= ;; Numerics @@ -136,6 +146,7 @@ [(pair? coll) #f] [(persistent-map? coll) (zero? (persistent-map-size coll))] [(persistent-set? coll) (zero? (persistent-set-size coll))] + [(sorted-set? coll) (zero? (sorted-set-size coll))] [(concurrent-hash? coll) (zero? (concurrent-hash-size coll))] [(hash-table? coll) (zero? (hash-length coll))] [(vector? coll) (zero? (vector-length coll))] @@ -152,6 +163,7 @@ [(pair? coll) (length coll)] [(persistent-map? coll) (persistent-map-size coll)] [(persistent-set? coll) (persistent-set-size coll)] + [(sorted-set? coll) (sorted-set-size coll)] [(concurrent-hash? coll) (concurrent-hash-size coll)] [(hash-table? coll) (hash-length coll)] [(vector? coll) (vector-length coll)] @@ -170,12 +182,15 @@ ;; Sets: membership check — return `key` if present [(persistent-set? coll) (if (persistent-set-contains? coll key) key default)] + [(sorted-set? coll) + (if (sorted-set-contains? coll key) key default)] [else (nested-get coll key default)])])) (define (contains? coll key) (cond [(persistent-map? coll) (persistent-map-has? coll key)] [(persistent-set? coll) (persistent-set-contains? coll key)] + [(sorted-set? coll) (sorted-set-contains? coll key)] [(concurrent-hash? coll) (concurrent-hash-key? coll key)] [(hash-table? coll) (hash-key? coll key)] [(vector? coll) @@ -337,6 +352,7 @@ (cond [(null? coll) #f] [(pair? coll) (car coll)] + [(sorted-set? coll) (sorted-set-min coll)] [(vector? coll) (if (zero? (vector-length coll)) #f (vector-ref coll 0))] [(string? coll) @@ -373,6 +389,7 @@ [(pair? coll) (let loop ([c coll]) (if (null? (cdr c)) (car c) (loop (cdr c))))] + [(sorted-set? coll) (sorted-set-max coll)] [(vector? coll) (let ([n (vector-length coll)]) (if (zero? n) #f (vector-ref coll (- n 1))))] @@ -425,6 +442,10 @@ (let loop ([s coll] [rest xs]) (if (null? rest) s (loop (persistent-set-add s (car rest)) (cdr rest))))] + [(sorted-set? coll) + (let loop ([s coll] [rest xs]) + (if (null? rest) s + (loop (sorted-set-add s (car rest)) (cdr rest))))] [else (error 'conj "unsupported collection type" coll)])) ;; ========================================================================= @@ -566,6 +587,8 @@ (if (zero? (persistent-map-size coll)) #f (persistent-map->list coll))] [(persistent-set? coll) (if (zero? (persistent-set-size coll)) #f (persistent-set->list coll))] + [(sorted-set? coll) + (if (zero? (sorted-set-size coll)) #f (sorted-set->list coll))] [(concurrent-hash? coll) (if (zero? (concurrent-hash-size coll)) #f @@ -782,13 +805,31 @@ (let loop ([cur s] [rest items]) (if (null? rest) cur (loop (persistent-set-remove cur (car rest)) (cdr rest))))] - [else (error 'disj "expected a persistent set" s)])) + [(sorted-set? s) + (let loop ([cur s] [rest items]) + (if (null? rest) cur + (loop (sorted-set-remove cur (car rest)) (cdr rest))))] + [else (error 'disj "expected a set" s)])) ;; Clojure's clojure.set/ operations + ;; + ;; Both `persistent-set` (HAMT) and `sorted-set` (red-black tree) are + ;; valid set-types. When the first operand is a sorted-set we dispatch + ;; to a sorted-set-preserving implementation that folds elements from + ;; the other operands — otherwise we use the HAMT-optimized primitives + ;; from (std pset). + (define (union . sets) (cond [(null? sets) pset-empty] [(null? (cdr sets)) (car sets)] + [(sorted-set? (car sets)) + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (loop (sorted-set-fold (car rest) + (lambda (x a) (sorted-set-add a x)) + acc) + (cdr rest))))] [else (let loop ([acc (car sets)] [rest (cdr sets)]) (if (null? rest) acc @@ -798,6 +839,15 @@ (cond [(null? sets) pset-empty] [(null? (cdr sets)) (car sets)] + [(sorted-set? (car sets)) + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (let ([other (car rest)]) + (loop (sorted-set-fold acc + (lambda (x a) + (if (contains? other x) a (sorted-set-remove a x))) + acc) + (cdr rest)))))] [else (let loop ([acc (car sets)] [rest (cdr sets)]) (if (null? rest) acc @@ -807,12 +857,26 @@ (cond [(null? sets) pset-empty] [(null? (cdr sets)) (car sets)] + [(sorted-set? (car sets)) + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (loop (sorted-set-fold (car rest) + (lambda (x a) (sorted-set-remove a x)) + acc) + (cdr rest))))] [else (let loop ([acc (car sets)] [rest (cdr sets)]) (if (null? rest) acc (loop (persistent-set-difference acc (car rest)) (cdr rest))))])) - (define (subset? s1 s2) (persistent-set-subset? s1 s2)) - (define (superset? s1 s2) (persistent-set-subset? s2 s1)) + (define (subset? s1 s2) + (cond + [(sorted-set? s1) + (sorted-set-fold s1 + (lambda (x acc) (and acc (contains? s2 x))) + #t)] + [else (persistent-set-subset? s1 s2)])) + + (define (superset? s1 s2) (subset? s2 s1)) ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/sorted-set.sls @@ -0,0 +1,115 @@ +#!chezscheme +;;; (std sorted-set) — Persistent sorted set +;;; +;;; A thin wrapper over `(std ds sorted-map)` that models a sorted set +;;; as a sorted-map where every key maps to `#t`. Provides Clojure's +;;; `sorted-set` surface: ordered iteration, min/max, range queries, +;;; and O(log n) add/remove/contains? against a red-black tree. +;;; +;;; This module is re-exported from `(std clojure)` with the Clojure +;;; name `sorted-set` wired into the polymorphic `conj` / `disj` / +;;; `contains?` / `count` / `first` / `last` / `seq` dispatch, and +;;; with the clojure.set algebra (`union`/`intersection`/`difference`) +;;; operating on sorted sets. +;;; +;;; API: +;;; sorted-set — variadic constructor (default cmp) +;;; sorted-set-by — variadic constructor with custom cmp +;;; sorted-set? — predicate +;;; sorted-set-empty — empty sorted set (default cmp) +;;; sorted-set-add ss x — insert, returns new set +;;; sorted-set-remove ss x — delete, returns new set +;;; sorted-set-contains? ss x — membership check +;;; sorted-set-size ss — cardinality +;;; sorted-set-min ss — smallest element or #f +;;; sorted-set-max ss — largest element or #f +;;; sorted-set-range ss lo hi — list of elements in [lo, hi] +;;; sorted-set->list ss — ordered list of elements +;;; sorted-set-fold ss proc init — left fold with proc : (x acc) -> acc + +(library (std sorted-set) + (export sorted-set sorted-set-by sorted-set? + sorted-set-empty + sorted-set-add sorted-set-remove + sorted-set-contains? sorted-set-size + sorted-set-min sorted-set-max + sorted-set-range sorted-set->list + sorted-set-fold) + + (import (chezscheme) + (std ds sorted-map)) + + ;; Internal record: a wrapper around a sorted-map where every key + ;; maps to #t. We rename the constructor/predicate to avoid colliding + ;; with the public variadic `sorted-set` and the public `sorted-set?`. + (define-record-type (sset-rec %make-sset sset-rec?) + (fields (immutable sm sset-sm))) + + (define sorted-set? sset-rec?) + + ;; Empty sorted-set using the default comparator. + (define sorted-set-empty (%make-sset (sorted-map-empty))) + + ;; Variadic constructor — Clojure: (sorted-set 3 1 2) → {1 2 3}. + (define (sorted-set . items) + (if (null? items) + sorted-set-empty + (let loop ([s sorted-set-empty] [rest items]) + (if (null? rest) + s + (loop (sorted-set-add s (car rest)) (cdr rest)))))) + + ;; Variadic constructor with a custom comparator — Clojure: + ;; (sorted-set-by cmp 3 1 2). + (define (sorted-set-by cmp . items) + (let ([empty (%make-sset (make-sorted-map cmp))]) + (let loop ([s empty] [rest items]) + (if (null? rest) + s + (loop (sorted-set-add s (car rest)) (cdr rest)))))) + + ;; Add an element. Idempotent: adding an existing element returns + ;; an equivalent set (structurally shared internal nodes). + (define (sorted-set-add ss x) + (%make-sset (sorted-map-insert (sset-sm ss) x #t))) + + ;; Remove an element. If the element isn't present, returns `ss`. + (define (sorted-set-remove ss x) + (%make-sset (sorted-map-delete (sset-sm ss) x))) + + (define (sorted-set-contains? ss x) + ;; sorted-map-lookup returns the value (which is always #t here) + ;; for a present key, or #f for an absent key — perfect for a + ;; boolean membership predicate. + (if (sorted-map-lookup (sset-sm ss) x) #t #f)) + + (define (sorted-set-size ss) + (sorted-map-size (sset-sm ss))) + + (define (sorted-set-min ss) + ;; sorted-map-min returns (cons k v) or #f. + (let ([r (sorted-map-min (sset-sm ss))]) + (if r (car r) #f))) + + (define (sorted-set-max ss) + (let ([r (sorted-map-max (sset-sm ss))]) + (if r (car r) #f))) + + ;; Return the list of elements in [lo, hi], in sorted order. + ;; Clojure's `subseq` is richer (supports open/closed bounds); we + ;; offer the simple closed-interval version that matches + ;; sorted-map-range's semantics. + (define (sorted-set-range ss lo hi) + (sorted-map-keys (sorted-map-range (sset-sm ss) lo hi))) + + (define (sorted-set->list ss) + (sorted-map-keys (sset-sm ss))) + + ;; Left fold over elements in ascending order: + ;; (proc element acc) → acc + (define (sorted-set-fold ss proc init) + (sorted-map-fold (sset-sm ss) + (lambda (k v acc) (proc k acc)) + init)) + +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-sorted-set.ss @@ -0,0 +1,280 @@ +#!chezscheme +;;; Tests for (std sorted-set) and Clojure's sorted-set dispatch. +;;; +;;; Exercises the sorted-set-* primitives directly and verifies the +;;; polymorphic conj/disj/contains?/count/first/last/seq dispatch in +;;; (std clojure) handles sorted sets, plus the clojure.set/ algebra +;;; (union / intersection / difference / subset? / superset?). + +(import (chezscheme) + (std sorted-set) + (except (std clojure) pop)) ;; avoid clash with test helper + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))])) + +(printf "--- (std sorted-set) + Clojure dispatch ---~%~%") + +;;; ===== sorted-set primitives ===== + +(test "sorted-set-empty is empty" + (sorted-set-size sorted-set-empty) + 0) + +(test "sorted-set? accepts the empty sorted set" + (sorted-set? sorted-set-empty) + #t) + +(test "sorted-set? rejects plain list" + (sorted-set? '(1 2 3)) + #f) + +(test "sorted-set? rejects hash-set" + (sorted-set? (hash-set 1 2 3)) + #f) + +(test "sorted-set constructor sorts numeric input" + (sorted-set->list (sorted-set 3 1 4 1 5 9 2 6)) + '(1 2 3 4 5 6 9)) + +(test "sorted-set-add inserts in order" + (sorted-set->list + (sorted-set-add (sorted-set-add (sorted-set-add sorted-set-empty 2) 1) 3)) + '(1 2 3)) + +(test "sorted-set-add is idempotent" + (sorted-set-size + (sorted-set-add (sorted-set-add sorted-set-empty 'a) 'a)) + 1) + +(test "sorted-set-remove drops element" + (sorted-set->list (sorted-set-remove (sorted-set 1 2 3) 2)) + '(1 3)) + +(test "sorted-set-remove missing is a no-op" + (sorted-set->list (sorted-set-remove (sorted-set 1 2 3) 99)) + '(1 2 3)) + +(test "sorted-set-contains? present" + (sorted-set-contains? (sorted-set 1 2 3) 2) + #t) + +(test "sorted-set-contains? absent" + (sorted-set-contains? (sorted-set 1 2 3) 99) + #f) + +(test "sorted-set-size" + (sorted-set-size (sorted-set 'a 'b 'c 'd)) + 4) + +(test "sorted-set-min" + (sorted-set-min (sorted-set 7 3 9 1 5)) + 1) + +(test "sorted-set-max" + (sorted-set-max (sorted-set 7 3 9 1 5)) + 9) + +(test "sorted-set-min on empty is #f" + (sorted-set-min sorted-set-empty) + #f) + +(test "sorted-set-max on empty is #f" + (sorted-set-max sorted-set-empty) + #f) + +(test "sorted-set-range closed interval" + (sorted-set-range (sorted-set 1 2 3 4 5 6 7 8 9 10) 3 7) + '(3 4 5 6 7)) + +(test "sorted-set-range symbol keys" + (sorted-set-range (sorted-set 'alpha 'beta 'gamma 'delta 'epsilon) 'beta 'delta) + ;; Sorted by symbol name: alpha, beta, delta, epsilon, gamma + ;; range beta..delta → (beta delta) + '(beta delta)) + +(test "sorted-set->list is sorted" + (sorted-set->list (sorted-set "charlie" "alpha" "bravo")) + '("alpha" "bravo" "charlie")) + +(test "sorted-set-fold sum" + (sorted-set-fold (sorted-set 1 2 3 4 5) + 0) + 15) + +(test "sorted-set-fold builds reverse list" + (sorted-set-fold (sorted-set 1 2 3) cons '()) + '(3 2 1)) + +;;; ===== sorted-set-by custom comparator ===== + +(test "sorted-set-by reverse order" + (sorted-set->list + (sorted-set-by (lambda (a b) (cond [(> a b) -1] [(< a b) 1] [else 0])) + 1 2 3 4 5)) + '(5 4 3 2 1)) + +;;; ===== Clojure polymorphic dispatch ===== + +(test "count sorted-set" + (count (sorted-set 1 2 3 4 5)) + 5) + +(test "empty? sorted-set — empty" + (empty? sorted-set-empty) + #t) + +(test "empty? sorted-set — non-empty" + (empty? (sorted-set 1)) + #f) + +(test "contains? sorted-set — present" + (contains? (sorted-set 'x 'y 'z) 'y) + #t) + +(test "contains? sorted-set — absent" + (contains? (sorted-set 'x 'y 'z) 'w) + #f) + +(test "get sorted-set — present returns element" + (get (sorted-set 1 2 3) 2) + 2) + +(test "get sorted-set — absent returns default" + (get (sorted-set 1 2 3) 99 'missing) + 'missing) + +(test "first sorted-set = min" + (first (sorted-set 5 3 8 1 4)) + 1) + +(test "last sorted-set = max" + (last (sorted-set 5 3 8 1 4)) + 8) + +(test "seq sorted-set is sorted list" + (seq (sorted-set 3 1 2)) + '(1 2 3)) + +(test "seq empty sorted-set is #f" + (seq sorted-set-empty) + #f) + +(test "conj sorted-set single" + (sorted-set->list (conj (sorted-set 1 2) 3)) + '(1 2 3)) + +(test "conj sorted-set multiple preserves sort" + (sorted-set->list (conj (sorted-set 5) 1 3 9 2)) + '(1 2 3 5 9)) + +(test "disj sorted-set single" + (sorted-set->list (disj (sorted-set 1 2 3) 2)) + '(1 3)) + +(test "disj sorted-set multiple" + (sorted-set->list (disj (sorted-set 1 2 3 4 5) 2 4)) + '(1 3 5)) + +;;; ===== clojure.set algebra ===== + +(test "union sorted-sets — result is sorted-set" + (sorted-set? + (union (sorted-set 1 3 5) (sorted-set 2 4 6))) + #t) + +(test "union sorted-sets — content" + (sorted-set->list + (union (sorted-set 1 3 5) (sorted-set 2 4 6))) + '(1 2 3 4 5 6)) + +(test "union sorted-sets three-way" + (sorted-set->list + (union (sorted-set 1) (sorted-set 2 3) (sorted-set 4 5 6))) + '(1 2 3 4 5 6)) + +(test "intersection sorted-sets — content" + (sorted-set->list + (intersection (sorted-set 1 2 3 4 5) (sorted-set 3 4 5 6 7))) + '(3 4 5)) + +(test "intersection sorted-sets — empty overlap" + (sorted-set->list + (intersection (sorted-set 1 2 3) (sorted-set 4 5 6))) + '()) + +(test "intersection sorted-sets — three-way" + (sorted-set->list + (intersection (sorted-set 1 2 3 4) (sorted-set 2 3 4 5) (sorted-set 3 4 5 6))) + '(3 4)) + +(test "difference sorted-sets — content" + (sorted-set->list + (difference (sorted-set 1 2 3 4 5) (sorted-set 2 4))) + '(1 3 5)) + +(test "difference sorted-sets — three-way" + (sorted-set->list + (difference (sorted-set 1 2 3 4 5 6) (sorted-set 2) (sorted-set 4 6))) + '(1 3 5)) + +(test "subset? sorted-sets — true" + (subset? (sorted-set 2 3) (sorted-set 1 2 3 4)) + #t) + +(test "subset? sorted-sets — false" + (subset? (sorted-set 2 5) (sorted-set 1 2 3 4)) + #f) + +(test "subset? sorted-sets — empty is subset" + (subset? sorted-set-empty (sorted-set 1 2 3)) + #t) + +(test "superset? sorted-sets — true" + (superset? (sorted-set 1 2 3 4) (sorted-set 2 3)) + #t) + +(test "superset? sorted-sets — false" + (superset? (sorted-set 1 2) (sorted-set 1 2 3)) + #f) + +;;; ===== Immutability check ===== + +(test "sorted-set-add does not mutate original" + (let ([s (sorted-set 1 2 3)]) + (sorted-set-add s 99) + (sorted-set->list s)) + '(1 2 3)) + +(test "conj does not mutate original sorted-set" + (let ([s (sorted-set 'a 'b 'c)]) + (conj s 'd 'e) + (sorted-set->list s)) + '(a b c)) + +;;; ===== Large-ish sanity ===== + +(test "1000 insertions stay sorted" + (let loop ([i 999] [s sorted-set-empty]) + (if (< i 0) + (let ([lst (sorted-set->list s)]) + (and (= (length lst) 1000) + (= (car lst) 0) + (= (last lst) 999))) + (loop (- i 1) (sorted-set-add s i)))) + #t) + +(printf "~%~a tests: ~a passed, ~a failed~%" + (+ pass fail) pass fail) +(when (> fail 0) (exit 1))