Algebraic data types: Difference between revisions

Content added Content deleted

Inline

@@ Line 580: / Line 580: @@
 {{trans|OCaml}}
-<lang scheme>#lang racket
+<lang racket>
+#lang racket
+;; Using short names to make the code line up nicely
-(struct t-node (color t-left value t-right))
+(struct N (color left value right) #:prefab)
 (define (balance t)
   (match t
-    [(t-node 'black (t-node 'red (t-node 'red a x b) y c) z d)
+    [(N 'B (N 'R (N 'R a x b) y c) z d) (N 'R (N 'B a x b) y (N 'B c z d))]
-     (t-node 'red (t-node 'black a x b) y (t-node 'black c z d))]
+    [(N 'B (N 'R a x (N 'R b y c)) z d) (N 'R (N 'B a x b) y (N 'B c z d))]
-    [(t-node 'black (t-node 'red a x (t-node 'red b y c)) z d)
+    [(N 'B a x (N 'R (N 'R b y c) z d)) (N 'R (N 'B a x b) y (N 'B c z d))]
-     (t-node 'red (t-node 'black a x b) y (t-node 'black c z d))]
+    [(N 'B a x (N 'R b y (N 'R c z d))) (N 'R (N 'B a x b) y (N 'B c z d))]
-    [(t-node 'black a x (t-node 'red (t-node 'red b y c) z d))
-     (t-node 'red (t-node 'black a x b) y (t-node 'black c z d))]
-    [(t-node 'black a x (t-node 'red b y (t-node 'red c z d)))
-     (t-node 'red (t-node 'black a x b) y (t-node 'black c z d))]
     [else t]))
@@ Line 599: / Line 597: @@
   (define (ins t)
     (match t
-      ['empty (t-node 'red 'empty x 'empty)]
+      ['empty (N 'R 'empty x 'empty)]
-      [(t-node c a y b)
+      [(N c l v r) (cond [(< x v) (balance (N c (ins l) v r))]
-       (cond [(< x y)
+                         [(> x v) (balance (N c l v (ins r)))]
-              (balance (t-node c (ins a) y b))]
+                         [else t])]))
-             [(> x y)
+  (match (ins s) [(N _ l v r) (N 'B l v r)]))
-              (balance (t-node c a y (ins b)))]
+(define (visualize t0)
-             [else t])]))
+  (let loop ([t t0] [last? #t] [indent '()])
-  (match (ins s)
-    [(t-node _ a y b) (t-node 'black a y b)]))</lang>
+    (define (I mid last) (cond [(eq? t t0) ""] [last? mid] [else last]))
+    (for-each display (reverse indent))
+    (printf "~a~a[~a]\n" (I "\\-" "+-") (N-value t) (N-color t))
+    (define subs (filter N? (list (N-left t) (N-right t))))
+    (for ([s subs] [n (in-range (sub1 (length subs)) -1 -1)])
+      (loop s (zero? n) (cons (I "  " "| ") indent)))))
+(visualize (for/fold ([t 'empty]) ([i 16]) (insert i t)))
+</lang>
+<pre>
+[B]
++-3[B]
+| +-1[B]
+| | +-0[B]
+| | \-2[B]
+| \-5[B]
+|   +-4[B]
+|   \-6[B]
+\-11[B]
+  +-9[B]
+  | +-8[B]
+  | \-10[B]
+  \-13[B]
+    +-12[B]
+    \-14[B]
+      \-15[R]
+</pre>
 =={{header|Rascal}}==