From ee1cf9b1000662ebcdefcc7cc4079fb46c705452 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Fri, 19 Jun 2015 20:08:49 -0400
Subject: [PATCH] tset

---
 prospect/tset.rkt | 96 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 96 insertions(+)
 create mode 100644 prospect/tset.rkt

diff --git a/prospect/tset.rkt b/prospect/tset.rkt
new file mode 100644
index 0000000..a5f6b42
--- /dev/null
+++ b/prospect/tset.rkt
@@ -0,0 +1,96 @@
+#lang racket/base
+
+(require "treap.rkt")
+
+(provide tset?
+         datum-tset
+         make-tset
+         tset-count
+         tset-empty
+         tset-empty?
+         tset-add
+         tset-remove
+         tset-union
+         tset-intersect
+         tset-subtract
+         tset->list
+         tset-member?
+         )
+
+(require data/order)
+
+(define (tset? t)
+  (treap? t))
+
+(define (datum-tset . elts)
+  (make-tset datum-order elts))
+
+(define (make-tset o elts)
+  (for/fold [(t (tset-empty o))] [(e elts)] (tset-add t e)))
+
+(define (tset-count t)
+  (treap-size t))
+
+(define (tset-empty o)
+  (treap-empty o))
+
+(define (tset-empty? t)
+  (treap-empty? t))
+
+(define (tset-add t v)
+  (treap-insert t v #t))
+
+(define (tset-remove t v)
+  (treap-delete t v))
+
+(define (tset-union t1 t2)
+  (if (< (treap-size t1) (treap-size t2))
+      (treap-fold t1 treap-insert t2)
+      (treap-fold t2 treap-insert t1)))
+
+(define (tset-intersect t1 t2)
+  (if (< (treap-size t1) (treap-size t2))
+      (treap-fold t1
+                  (lambda (t k v) (if (treap-has-key? t2 k) (treap-insert t k v) t))
+                  (treap->empty t1))
+      (treap-fold t2
+                  (lambda (t k v) (if (treap-has-key? t1 k) (treap-insert t k v) t))
+                  (treap->empty t2))))
+
+(define (tset-subtract t1 t2)
+  (if (< (treap-size t1) (treap-size t2))
+      (treap-fold t1
+                  (lambda (t k v) (if (treap-has-key? t2 k) t (treap-insert t k v)))
+                  (treap->empty t1))
+      (treap-fold t2
+                  (lambda (t k v) (treap-delete t k))
+                  t1)))
+
+(define (tset->list t)
+  (treap-fold t (lambda (acc k v) (cons k acc)) '()))
+
+(define (tset-member? t k)
+  (treap-has-key? t k))
+
+(module+ test
+  (require rackunit)
+  (require data/order)
+  (define (tset . elts) (make-tset datum-order elts))
+  (check-equal? (tset->list (tset 1 2 3 4 5)) '(1 2 3 4 5))
+  (check-equal? (tset->list (tset 5 4 3 2 1)) '(1 2 3 4 5))
+  (check-equal? (tset->list (tset-union (tset 1 2 3) (tset 2 3 4))) '(1 2 3 4))
+  (check-equal? (tset->list (tset-intersect (tset 1 2 3) (tset 2 3 4))) '(2 3))
+  (check-equal? (tset->list (tset-subtract (tset 1 2 3) (tset 2 3 4))) '(1))
+  (check-true (tset-member? (tset 1 2 3) 2))
+  (check-false (tset-member? (tset 1 2 3) 4))
+  (check-true (tset-empty? (tset)))
+  (check-false (tset-empty? (tset 1)))
+  (check-equal? (tset-count (tset 1 2 3)) 3)
+  (check-equal? (tset-count (tset)) 0)
+  (check-equal? (tset-count (tset-union (tset 1 2 3) (tset 2 3 4))) 4)
+  (check-true (tset? (tset-empty datum-order)))
+  (check-true (tset? (tset)))
+  (check-false (tset? 123))
+  (check-false (tset? (list 1 2 3)))
+  (check-false (tset? 'a))
+  )