Data update

Task/Algebraic-data-types/Emacs-Lisp/algebraic-data-types.el

@@ -0,0 +1,28 @@
+(defun rbt-balance (tree)
+  (pcase tree
+    (`(B (R (R ,a ,x ,b) ,y ,c) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
+    (`(B (R ,a ,x (R ,b ,y ,c)) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
+    (`(B ,a ,x (R (R ,b ,y ,c) ,z ,d)) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
+    (`(B ,a ,x (R ,b ,y (R ,c ,z ,d))) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
+    (_                                 tree)))
+
+(defun rbt-insert- (x s)
+  (pcase s
+    (`nil              `(R nil ,x nil))
+    (`(,color ,a ,y ,b) (cond ((< x y)
+                               (rbt-balance `(,color ,(rbt-insert- x a) ,y ,b)))
+                              ((> x y)
+                               (rbt-balance `(,color ,a ,y ,(rbt-insert- x b))))
+                              (t
+                               s)))
+    (_                  (error "Expected tree: %S" s))))
+
+(defun rbt-insert (x s)
+  (pcase (rbt-insert- x s)
+    (`(,_ ,a ,y ,b) `(B ,a ,y ,b))
+    (_              (error "Internal error: %S" s))))
+
+(let ((s nil))
+  (dotimes (i 16)
+    (setq s (rbt-insert (1+ i) s)))
+  (pp s))

Task/Algebraic-data-types/Pluto/algebraic-data-types.pluto

@@ -0,0 +1,78 @@
+$define R = "R"
+$define B = "B"
+
+class Tree
+    function ins(_) end  -- overridden by child classes
+
+    function insert(x)   -- inherited by child classes
+        local t = self:ins(x)
+        if t:type() == "T" then return new T(B, t.le, t.aa, t.ri) end
+        if t:type() == "E" then return new E() end
+        return nil
+    end
+end
+
+class T extends Tree
+    function __construct(
+        public cl, -- color
+        public le, -- Tree
+        public aa, -- integer
+        public ri  -- Tree
+    )
+    end
+
+    function type() return "T" end
+
+    function balance()
+        if self.cl != B then return self end
+        local le2 = self.le:type() == "T" ? self.le : nil
+        local lele, leri
+        if le2 then
+            lele = self.le.le:type() == "T" ? self.le.le : nil
+            leri = self.le.ri:type() == "T" ? self.le.ri : nil
+        end
+        local ri2 = self.ri:type() == "T" ? self.ri : nil
+        local rile, riri
+        if ri2 then
+            rile = self.ri.le:type() == "T" ? self.ri.le : nil
+            riri = self.ri.ri.type() == "T" ? self.ri.ri : nil
+        end
+        if le2 and lele and le2.cl == R and lele.cl == R then
+            local t = le2.le
+            return new T(R, new T(B, t.le, t.aa, t.ri), le2.aa, new T(B, le2.ri, self.aa, self.ri))
+        end
+        if le2 and leri and le2.cl == R and leri.cl == R then
+            local t = le2.ri
+            return new T(R, new T(B, le2.le, le2.aa, t.le), t.aa, new T(B, t.ri, self.aa, self.ri))
+        end
+        if ri2 and rile and ri2.cl == R and rile.cl == R then
+            local t = ri2.ri
+            return new T(R, new T(B, self.le, self.aa, t.le), t.aa, new T(B, t.ri, ri2.aa, ri2.ri))
+        end
+        if ri2 and riri and ri2.cl == R and riri.cl == R then
+            local t = ri2.ri
+            return new T(R, new T(B, self.le, self.aa, ri2.le), ri2.aa, new T(B, t.le, t.aa, t.ri))
+        end
+        return self
+    end
+
+    function ins(x)
+        if x < self.aa then return new T(self.cl, self.le:ins(x), self.aa, self.ri):balance() end
+        if x > self.aa then return new T(self.cl, self.le, self.aa, self.ri:ins(x)):balance() end
+        return self
+    end
+
+    function __tostring() return $"T({self.cl}, {self.le}, {self.aa}, {self.ri})" end
+end
+
+class E extends Tree
+    function ins(x) return new T(R, new E(), x, new E()) end
+
+    function type() return "E" end
+
+    function __tostring() return "E" end
+end
+
+local tr = new E()
+for i = 1, 16 do tr = tr:insert(i) end
+print(tr)