Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
3
Task/Algebraic-data-types/00-META.yaml
Normal file
3
Task/Algebraic-data-types/00-META.yaml
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Algebraic_data_types
|
||||
note: Algebraic data types
|
||||
11
Task/Algebraic-data-types/00-TASK.txt
Normal file
11
Task/Algebraic-data-types/00-TASK.txt
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
Some languages offer direct support for [[wp:Algebraic_data_type|algebraic data types]] and pattern matching on them. While this of course can always be simulated with manual tagging and conditionals, it allows for terse code which is easy to read, and can represent the algorithm directly.
|
||||
|
||||
|
||||
;Task:
|
||||
As an example, implement insertion in a [[wp:Red_Black_Tree|red-black-tree]].
|
||||
|
||||
A red-black-tree is a binary tree where each internal node has a color attribute ''red'' or ''black''. Moreover, no red node can have a red child, and every path from the root to an empty node must contain the same number of black nodes. As a consequence, the tree is balanced, and must be re-balanced after an insertion.
|
||||
<br><br>
|
||||
|
||||
;Reference:
|
||||
[https://www.cs.tufts.edu/comp/150FP/archive/chris-okasaki/redblack99.pdf Red-Black Trees in a Functional Setting]
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
( ( balance
|
||||
= a x b y c zd
|
||||
. !arg
|
||||
: ( B
|
||||
. ( ( R
|
||||
. ((R.?a,?x,?b),?y,?c)
|
||||
| (?a,?x,(R.?b,?y,?c))
|
||||
)
|
||||
, ?zd
|
||||
)
|
||||
| ( ?a
|
||||
, ?x
|
||||
, ( R
|
||||
. ((R.?b,?y,?c),?zd)
|
||||
| (?b,?y,(R.?c,?zd))
|
||||
)
|
||||
)
|
||||
)
|
||||
& (R.(B.!a,!x,!b),!y,(B.!c,!zd))
|
||||
| !arg
|
||||
)
|
||||
& ( ins
|
||||
= C X tree a m z
|
||||
. !arg:(?X.?tree)
|
||||
& !tree:(?C.?a,?m,?z)
|
||||
& ( !X:<!m
|
||||
& balance$(!C.ins$(!X.!a),!m,!z)
|
||||
| !X:>!m
|
||||
& balance$(!C.!a,!m,ins$(!X.!z))
|
||||
| !tree
|
||||
)
|
||||
| (R.,!X,)
|
||||
)
|
||||
& ( insert
|
||||
= X tree
|
||||
. !arg:(?X.?tree)
|
||||
& ins$(!X.!tree):(?.?X)
|
||||
& (B.!X)
|
||||
)
|
||||
& ( insertMany
|
||||
= L R tree
|
||||
. !arg:(%?L_%?R.?tree)
|
||||
& insertMany$(!L.!tree):?tree
|
||||
& insertMany$(!R.!tree)
|
||||
| insert$!arg
|
||||
)
|
||||
);
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
( ( it allows for terse code which is easy to read
|
||||
, and can represent the algorithm directly
|
||||
.
|
||||
)
|
||||
: ?values
|
||||
& insertMany$(!values.):?tree
|
||||
& lst$tree
|
||||
& done
|
||||
);
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
(tree=
|
||||
B
|
||||
. ( B
|
||||
. (R.(B.,,),algorithm,(B.,allows,))
|
||||
, and
|
||||
, (B.,can,)
|
||||
)
|
||||
, code
|
||||
, ( R
|
||||
. ( B
|
||||
. (B.(R.,directly,),easy,)
|
||||
, for
|
||||
, (B.(R.,is,),it,)
|
||||
)
|
||||
, read
|
||||
, ( B
|
||||
. (B.,represent,)
|
||||
, terse
|
||||
, (R.(B.,the,),to,(B.,which,))
|
||||
)
|
||||
)
|
||||
);
|
||||
45
Task/Algebraic-data-types/C++/algebraic-data-types-1.cpp
Normal file
45
Task/Algebraic-data-types/C++/algebraic-data-types-1.cpp
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
enum Color { R, B };
|
||||
template<Color, class, auto, class> struct T;
|
||||
struct E;
|
||||
|
||||
template<Color col, class a, auto x, class b> struct balance {
|
||||
using type = T<col, a, x, b>;
|
||||
};
|
||||
template<class a, auto x, class b, auto y, class c, auto z, class d>
|
||||
struct balance<B, T<R, T<R, a, x, b>, y, c>, z, d> {
|
||||
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
|
||||
};
|
||||
template<class a, auto x, class b, auto y, class c, auto z, class d>
|
||||
struct balance<B, T<R, a, x, T<R, b, y, c>>, z, d> {
|
||||
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
|
||||
};
|
||||
template<class a, auto x, class b, auto y, class c, auto z, class d>
|
||||
struct balance<B, a, x, T<R, T<R, b, y, c>, z, d>> {
|
||||
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
|
||||
};
|
||||
template<class a, auto x, class b, auto y, class c, auto z, class d>
|
||||
struct balance<B, a, x, T<R, b, y, T<R, c, z, d>>> {
|
||||
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
|
||||
};
|
||||
|
||||
template<auto x, class s> struct insert {
|
||||
template<class, class = void> struct ins;
|
||||
template<class _> struct ins<E, _> { using type = T<R, E, x, E>; };
|
||||
template<Color col, class a, auto y, class b> struct ins<T<col, a, y, b>> {
|
||||
template<int, class = void> struct cond;
|
||||
template<class _> struct cond<-1, _> : balance<col, typename ins<a>::type, y, b> {};
|
||||
template<class _> struct cond<1, _> : balance<col, a, y, typename ins<b>::type> {};
|
||||
template<class _> struct cond<0, _> { using type = T<col, a, y, b>; };
|
||||
using type = typename cond<x < y ? -1 : y < x ? 1 : 0>::type;
|
||||
};
|
||||
template<class> struct repaint;
|
||||
template<Color col, class a, auto y, class b>
|
||||
struct repaint<T<col, a, y, b>> { using type = T<B, a, y, b>; };
|
||||
using type = typename repaint<typename ins<s>::type>::type;
|
||||
};
|
||||
template<auto x, class s> using insert_t = typename insert<x, s>::type;
|
||||
|
||||
template<class> void print();
|
||||
int main() {
|
||||
print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
|
||||
}
|
||||
103
Task/Algebraic-data-types/C++/algebraic-data-types-2.cpp
Normal file
103
Task/Algebraic-data-types/C++/algebraic-data-types-2.cpp
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
#include <memory>
|
||||
#include <variant>
|
||||
|
||||
template<class... Ts> struct overloaded : Ts... { using Ts::operator()...; };
|
||||
template<class... Ts> overloaded(Ts...) -> overloaded<Ts...>;
|
||||
|
||||
enum Color { R, B };
|
||||
using E = std::monostate;
|
||||
template<class, Color> struct Node;
|
||||
template<class T, Color C> using Ptr = std::unique_ptr<Node<T, C>>;
|
||||
template<class T> using Tree = std::variant<E, Ptr<T, R>, Ptr<T, B>>;
|
||||
template<class T, Color Col> struct Node {
|
||||
static constexpr auto C = Col;
|
||||
Tree<T> left;
|
||||
T value;
|
||||
Tree<T> right;
|
||||
};
|
||||
template<Color C, class A, class T, class B> Tree<T> tree(A&& a, T& x, B&& b) {
|
||||
return Tree<T>{Ptr<T, C>{new Node<T, C>{std::move(a), std::move(x), std::move(b)}}};
|
||||
}
|
||||
|
||||
template<class T> Tree<T> balance(Tree<T> s) {
|
||||
auto&& ll = [](Ptr<T, R>& s, Ptr<T, R>& t, auto&, Ptr<T, B>& u, auto&, auto&, auto&) {
|
||||
auto& [a, x, b] = *s;
|
||||
auto& [s_, y, c] = *t;
|
||||
auto& [t_, z, d] = *u;
|
||||
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
|
||||
};
|
||||
auto&& lr = [](auto&, Ptr<T, R>& s, Ptr<T, R>& t, Ptr<T, B>& u, auto&, auto&, auto&) {
|
||||
auto& [a, x, t_] = *s;
|
||||
auto& [b, y, c] = *t;
|
||||
auto& [s_, z, d] = *u;
|
||||
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
|
||||
};
|
||||
auto&& rl = [](auto&, auto&, auto&, Ptr<T, B>& s, Ptr<T, R>& t, Ptr<T, R>& u, auto&) {
|
||||
auto& [a, x, u_] = *s;
|
||||
auto& [b, y, c] = *t;
|
||||
auto& [t_, z, d] = *u;
|
||||
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
|
||||
};
|
||||
auto&& rr = [](auto&, auto&, auto&, Ptr<T, B>& s, auto&, Ptr<T, R>& t, Ptr<T, R>& u) {
|
||||
auto& [a, x, t_] = *s;
|
||||
auto& [b, y, u_] = *t;
|
||||
auto& [c, z, d] = *u;
|
||||
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
|
||||
};
|
||||
auto&& l = [](auto& s) -> Tree<T>& {
|
||||
return *std::visit(overloaded{[&](E) { return &s; }, [](auto& t) { return &t->left; }}, s);
|
||||
};
|
||||
auto&& r = [](auto& s) -> Tree<T>& {
|
||||
return *std::visit(overloaded{[&](E) { return &s; }, [](auto& t) { return &t->right; }}, s);
|
||||
};
|
||||
return std::visit([&](auto&... ss) -> Tree<T> {
|
||||
if constexpr (1 <
|
||||
std::is_invocable_v<decltype(ll), decltype(ss)...> +
|
||||
std::is_invocable_v<decltype(lr), decltype(ss)...> +
|
||||
std::is_invocable_v<decltype(rl), decltype(ss)...> +
|
||||
std::is_invocable_v<decltype(rr), decltype(ss)...>)
|
||||
throw std::logic_error{""};
|
||||
else
|
||||
return overloaded{ll, lr, rl, rr, [&](auto&... ss) { return std::move(s); }}(ss...);
|
||||
}, l(l(s)), l(s), r(l(s)), s, l(r(s)), r(s), r(r(s)));
|
||||
}
|
||||
template<class T> Tree<T> ins(T& x, Tree<T>& s) {
|
||||
return std::visit(overloaded{
|
||||
[&](E) -> Tree<T> { return tree<R>(s, x, s); },
|
||||
[&](auto& t) {
|
||||
auto& [a, y, b] = *t;
|
||||
static constexpr auto Col = std::remove_reference_t<decltype(*t)>::C;
|
||||
return x < y ? balance(tree<Col>(ins(x, a), y, b)) :
|
||||
y < x ? balance(tree<Col>(a, y, ins(x, b))) :
|
||||
std::move(s);
|
||||
},
|
||||
}, s);
|
||||
}
|
||||
template<class T> Tree<T> insert(T x, Tree<T> s) {
|
||||
return std::visit(overloaded{
|
||||
[](E) -> Tree<T> { throw std::logic_error{""}; },
|
||||
[](auto&& t) {
|
||||
auto& [a, y, b] = *t;
|
||||
return tree<B>(a, y, b);
|
||||
}
|
||||
}, ins(x, s));
|
||||
}
|
||||
|
||||
#include <iostream>
|
||||
template<class T> void print(Tree<T> const& s, int i = 0) {
|
||||
std::visit(overloaded{
|
||||
[](E) {},
|
||||
[&](auto& t) {
|
||||
auto& [a, y, b] = *t;
|
||||
print(a, i + 1);
|
||||
std::cout << std::string(i, ' ') << "RB"[t->C] << " " << y << "\n";
|
||||
print(b, i + 1);
|
||||
}
|
||||
}, s);
|
||||
}
|
||||
int main(int argc, char* argv[]) {
|
||||
auto t = Tree<std::string>{};
|
||||
for (auto i = 1; i != argc; ++i)
|
||||
t = insert(std::string{argv[i]}, std::move(t));
|
||||
print(t);
|
||||
}
|
||||
49
Task/Algebraic-data-types/C-sharp/algebraic-data-types.cs
Normal file
49
Task/Algebraic-data-types/C-sharp/algebraic-data-types.cs
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
using System;
|
||||
|
||||
class Tree
|
||||
{
|
||||
public static void Main() {
|
||||
Tree tree = Tree.E;
|
||||
for (int i = 1; i <= 16; i++) {
|
||||
tree = tree.Insert(i);
|
||||
}
|
||||
tree.Print();
|
||||
}
|
||||
|
||||
private const bool B = false, R = true;
|
||||
public static readonly Tree E = new Tree(B, null, 0, null);
|
||||
|
||||
private Tree(bool c, Tree? l, int v, Tree? r) => (IsRed, Left, Value, Right) = (c, l ?? this, v, r ?? this);
|
||||
|
||||
public bool IsRed { get; private set; }
|
||||
public int Value { get; }
|
||||
public Tree Left { get; }
|
||||
public Tree Right { get; }
|
||||
|
||||
public static implicit operator Tree((bool c, Tree l, int v, Tree r) t) => new Tree(t.c, t.l, t.v, t.r);
|
||||
public void Deconstruct(out bool c, out Tree l, out int v, out Tree r) => (c, l, v, r) = (IsRed, Left, Value, Right);
|
||||
public override string ToString() => this == E ? "[]" : $"[{(IsRed ? 'R' : 'B')}{Value}]";
|
||||
public Tree Insert(int x) => Ins(x).MakeBlack();
|
||||
private Tree MakeBlack() { IsRed = false; return this; }
|
||||
|
||||
public void Print(int indent = 0) {
|
||||
if (this != E) Right.Print(indent + 1);
|
||||
Console.WriteLine(new string(' ', indent * 4) + ToString());
|
||||
if (this != E) Left.Print(indent + 1);
|
||||
}
|
||||
|
||||
private Tree Ins(int x) => Math.Sign(x.CompareTo(Value)) switch {
|
||||
_ when this == E => (R, E, x, E),
|
||||
-1 => new Tree(IsRed, Left.Ins(x) , Value, Right).Balance(),
|
||||
1 => new Tree(IsRed, Left , Value, Right.Ins(x)).Balance(),
|
||||
_ => this
|
||||
};
|
||||
|
||||
private Tree Balance() => this switch {
|
||||
(B, (R, (R, var a, var x, var b), var y, var c), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
|
||||
(B, (R, var a, var x, (R, var b, var y, var c)), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
|
||||
(B, var a, var x, (R, (R, var b, var y, var c), var z, var d)) => (R, (B, a, x, b), y, (B, c, z, d)),
|
||||
(B, var a, var x, (R, var b, var y, (R, var c, var z, var d))) => (R, (B, a, x, b), y, (B, c, z, d)),
|
||||
_ => this
|
||||
};
|
||||
}
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
(mapc #'use-package '(#:toadstool #:toadstool-system))
|
||||
(defstruct (red-black-tree (:constructor tree (color left val right)))
|
||||
color left val right)
|
||||
|
||||
(defcomponent tree (operator macro-mixin))
|
||||
(defexpand tree (color left val right)
|
||||
`(class red-black-tree red-black-tree-color ,color
|
||||
red-black-tree-left ,left
|
||||
red-black-tree-val ,val
|
||||
red-black-tree-right ,right))
|
||||
(pushnew 'tree *used-components*)
|
||||
|
||||
(defun balance (color left val right)
|
||||
(toad-ecase (color left val right)
|
||||
(('black (tree 'red (tree 'red a x b) y c) z d)
|
||||
(tree 'red (tree 'black a x b) y
|
||||
(tree 'black c z d)))
|
||||
(('black (tree 'red a x (tree 'red b y c)) z d)
|
||||
(tree 'red (tree 'black a x b) y (tree 'black c z d)))
|
||||
(('black a x (tree 'red (tree 'red b y c) z d))
|
||||
(tree 'red (tree 'black a x b) y (tree 'black c z d)))
|
||||
(('black a x (tree 'red b y (tree 'red c z d)))
|
||||
(tree 'red (tree 'black a x b) y (tree 'black c z d)))
|
||||
((color a x b)
|
||||
(tree color a x b))))
|
||||
|
||||
(defun %insert (x s)
|
||||
(toad-ecase1 s
|
||||
(nil (tree 'red nil x nil))
|
||||
((tree color a y b)
|
||||
(cond ((< x y)
|
||||
(balance color (%insert x a) y b))
|
||||
((> x y)
|
||||
(balance color a y (%insert x b)))
|
||||
(t s)))))
|
||||
|
||||
(defun insert (x s)
|
||||
(toad-ecase1 (%insert x s)
|
||||
((tree t a y b) (tree 'black a y b))))
|
||||
27
Task/Algebraic-data-types/EchoLisp/algebraic-data-types-1.l
Normal file
27
Task/Algebraic-data-types/EchoLisp/algebraic-data-types-1.l
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
;; code adapted from Racket and Common Lisp
|
||||
;; Illustrates matching on structures
|
||||
(require 'match)
|
||||
(require 'struct)
|
||||
|
||||
|
||||
(define (N-tostring n) (format "%s %d" (N-color n) (N-value n)))
|
||||
(struct N (color left value right) #:tostring N-tostring)
|
||||
|
||||
(define (balance t)
|
||||
(match t
|
||||
[(N '⚫️ (N '🔴 (N '🔴 a x b) y c) z d) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
|
||||
[(N '⚫️ (N '🔴 a x (N '🔴 b y c)) z d) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
|
||||
[(N '⚫️ a x (N '🔴 (N '🔴 b y c) z d)) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
|
||||
[(N '⚫️ a x (N '🔴 b y (N '🔴 c z d))) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
|
||||
[else t]))
|
||||
|
||||
(define (ins value: x tree: t)
|
||||
(match t
|
||||
['empty (N '🔴 'empty x 'empty)]
|
||||
[(N c l v r) (cond [(< x v) (balance (N c (ins x l) v r))]
|
||||
[(> x v) (balance (N c l v (ins x r)))]
|
||||
[else t])]))
|
||||
|
||||
(define (insert value: x tree: s)
|
||||
(match (ins x s) [(N _ l v r) (N '⚫️ l v r)]))
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
(define (t-show n (depth 0))
|
||||
(when (!eq? 'empty n)
|
||||
(t-show (N-left n) (+ 12 depth))
|
||||
(writeln (string-pad-left (format "%s" n ) depth))
|
||||
(t-show (N-right n) (+ 12 depth))))
|
||||
|
||||
(define T (for/fold [t 'empty] ([i 32]) (insert (random 100) t)))
|
||||
(t-show T)
|
||||
43
Task/Algebraic-data-types/Elixir/algebraic-data-types.elixir
Normal file
43
Task/Algebraic-data-types/Elixir/algebraic-data-types.elixir
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
defmodule RBtree do
|
||||
def find(nil, _), do: :not_found
|
||||
def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
|
||||
def find({ key1, _, _, left, _ }, key) when key < key1, do: find(left, key)
|
||||
def find({ key1, _, _, _, right }, key) when key > key1, do: find(right, key)
|
||||
|
||||
def new(key, value), do: ins(nil, key, value) |> make_black
|
||||
|
||||
def insert(tree, key, value), do: ins(tree, key, value) |> make_black
|
||||
|
||||
defp ins(nil, key, value),
|
||||
do: { key, value, :r, nil, nil }
|
||||
defp ins({ key, _, color, left, right }, key, value),
|
||||
do: { key, value, color, left, right }
|
||||
defp ins({ ky, vy, cy, ly, ry }, key, value) when key < ky,
|
||||
do: balance({ ky, vy, cy, ins(ly, key, value), ry })
|
||||
defp ins({ ky, vy, cy, ly, ry }, key, value) when key > ky,
|
||||
do: balance({ ky, vy, cy, ly, ins(ry, key, value) })
|
||||
|
||||
defp make_black({ key, value, _, left, right }),
|
||||
do: { key, value, :b, left, right }
|
||||
|
||||
defp balance({ kx, vx, :b, lx, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } } }),
|
||||
do: { ky, vy, :r, { kx, vx, :b, lx, ly }, { kz, vz, :b, lz, rz } }
|
||||
defp balance({ kx, vx, :b, lx, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry } }),
|
||||
do: { kz, vz, :r, { kx, vx, :b, lx, lz }, { ky, vy, :b, rz, ry } }
|
||||
defp balance({ kx, vx, :b, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry }, rx }),
|
||||
do: { ky, vy, :r, { kz, vz, :b, lz, rz }, { kx, vx, :b, ry, rx } }
|
||||
defp balance({ kx, vx, :b, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } }, rx }),
|
||||
do: { kz, vz, :r, { ky, vy, :b, ly, lz }, { kx, vx, :b, rz, rx } }
|
||||
defp balance(t),
|
||||
do: t
|
||||
end
|
||||
|
||||
RBtree.new(0,3) |> IO.inspect
|
||||
|> RBtree.insert(1,5) |> IO.inspect
|
||||
|> RBtree.insert(2,-1) |> IO.inspect
|
||||
|> RBtree.insert(3,7) |> IO.inspect
|
||||
|> RBtree.insert(4,-3) |> IO.inspect
|
||||
|> RBtree.insert(5,0) |> IO.inspect
|
||||
|> RBtree.insert(6,-1) |> IO.inspect
|
||||
|> RBtree.insert(7,0) |> IO.inspect
|
||||
|> RBtree.find(4) |> IO.inspect
|
||||
28
Task/Algebraic-data-types/Emacs-Lisp/algebraic-data-types.l
Normal file
28
Task/Algebraic-data-types/Emacs-Lisp/algebraic-data-types.l
Normal file
|
|
@ -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))
|
||||
39
Task/Algebraic-data-types/Erlang/algebraic-data-types.erl
Normal file
39
Task/Algebraic-data-types/Erlang/algebraic-data-types.erl
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
-module(rbtree).
|
||||
-export([insert/3, find/2]).
|
||||
|
||||
% Node structure: { Key, Value, Color, Smaller, Bigger }
|
||||
|
||||
find(_, nil) ->
|
||||
not_found;
|
||||
find(Key, { Key, Value, _, _, _ }) ->
|
||||
{ found, { Key, Value } };
|
||||
find(Key, { Key1, _, _, Left, _ }) when Key < Key1 ->
|
||||
find(Key, Left);
|
||||
find(Key, { Key1, _, _, _, Right }) when Key > Key1 ->
|
||||
find(Key, Right).
|
||||
|
||||
insert(Key, Value, Tree) ->
|
||||
make_black(ins(Key, Value, Tree)).
|
||||
|
||||
ins(Key, Value, nil) ->
|
||||
{ Key, Value, r, nil, nil };
|
||||
ins(Key, Value, { Key, _, Color, Left, Right }) ->
|
||||
{ Key, Value, Color, Left, Right };
|
||||
ins(Key, Value, { Ky, Vy, Cy, Ly, Ry }) when Key < Ky ->
|
||||
balance({ Ky, Vy, Cy, ins(Key, Value, Ly), Ry });
|
||||
ins(Key, Value, { Ky, Vy, Cy, Ly, Ry }) when Key > Ky ->
|
||||
balance({ Ky, Vy, Cy, Ly, ins(Key, Value, Ry) }).
|
||||
|
||||
make_black({ Key, Value, _, Left, Right }) ->
|
||||
{ Key, Value, b, Left, Right }.
|
||||
|
||||
balance({ Kx, Vx, b, Lx, { Ky, Vy, r, Ly, { Kz, Vz, r, Lz, Rz } } }) ->
|
||||
{ Ky, Vy, r, { Kx, Vx, b, Lx, Ly }, { Kz, Vz, b, Lz, Rz } };
|
||||
balance({ Kx, Vx, b, Lx, { Ky, Vy, r, { Kz, Vz, r, Lz, Rz }, Ry } }) ->
|
||||
{ Kz, Vz, r, { Kx, Vx, b, Lx, Lz }, { Ky, Vy, b, Rz, Ry } };
|
||||
balance({ Kx, Vx, b, { Ky, Vy, r, { Kz, Vz, r, Lz, Rz }, Ry }, Rx }) ->
|
||||
{ Ky, Vy, r, { Kz, Vz, b, Lz, Rz }, { Kx, Vx, b, Ry, Rx } };
|
||||
balance({ Kx, Vx, b, { Ky, Vy, r, Ly, { Kz, Vz, r, Lz, Rz } }, Rx }) ->
|
||||
{ Kz, Vz, r, { Ky, Vy, b, Ly, Lz }, { Kx, Vx, b, Rz, Rx } };
|
||||
balance(T) ->
|
||||
T.
|
||||
12
Task/Algebraic-data-types/F-Sharp/algebraic-data-types.fs
Normal file
12
Task/Algebraic-data-types/F-Sharp/algebraic-data-types.fs
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
// Pattern Matching. Nigel Galloway: January 15th., 2021
|
||||
type colour= |Red |Black
|
||||
type rbT<'N>= |Empty |N of colour * rbT<'N> * rbT<'N> * 'N
|
||||
let repair=function |Black,N(Red,N(Red,ll,lr,lv),rl,v),rr,rv
|
||||
|Black,N(Red,ll,N(Red,lr,rl,v),lv),rr,rv
|
||||
|Black,ll,N(Red,N(Red,lr,rl,v),rr,rv),lv
|
||||
|Black,ll,N(Red,lr,N(Red,rl,rr,rv),v),lv->N(Red,N(Black,ll,lr,lv),N(Black,rl,rr,rv),v)
|
||||
|i,g,e,l->N(i,g,e,l)
|
||||
let insert item rbt = let rec insert=function
|
||||
|Empty->N(Red,Empty,Empty,item)
|
||||
|N(i,g,e,l) as node->if item>l then repair(i,g,insert e,l) elif item<l then repair(i,insert g,e,l) else node
|
||||
match insert rbt with N(_,g,e,l)->N(Black,g,e,l) |_->Empty
|
||||
118
Task/Algebraic-data-types/Go/algebraic-data-types.go
Normal file
118
Task/Algebraic-data-types/Go/algebraic-data-types.go
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
package main
|
||||
|
||||
import "fmt"
|
||||
|
||||
type Color string
|
||||
|
||||
const (
|
||||
R Color = "R"
|
||||
B = "B"
|
||||
)
|
||||
|
||||
type Tree interface {
|
||||
ins(x int) Tree
|
||||
}
|
||||
|
||||
type E struct{}
|
||||
|
||||
func (_ E) ins(x int) Tree {
|
||||
return T{R, E{}, x, E{}}
|
||||
}
|
||||
|
||||
func (_ E) String() string {
|
||||
return "E"
|
||||
}
|
||||
|
||||
type T struct {
|
||||
cl Color
|
||||
le Tree
|
||||
aa int
|
||||
ri Tree
|
||||
}
|
||||
|
||||
func (t T) balance() Tree {
|
||||
if t.cl != B {
|
||||
return t
|
||||
}
|
||||
le, leIsT := t.le.(T)
|
||||
ri, riIsT := t.ri.(T)
|
||||
var lele, leri, rile, riri T
|
||||
var leleIsT, leriIsT, rileIsT, ririIsT bool
|
||||
if leIsT {
|
||||
lele, leleIsT = le.le.(T)
|
||||
}
|
||||
if leIsT {
|
||||
leri, leriIsT = le.ri.(T)
|
||||
}
|
||||
if riIsT {
|
||||
rile, rileIsT = ri.le.(T)
|
||||
}
|
||||
if riIsT {
|
||||
riri, ririIsT = ri.ri.(T)
|
||||
}
|
||||
switch {
|
||||
case leIsT && leleIsT && le.cl == R && lele.cl == R:
|
||||
_, t2, z, d := t.destruct()
|
||||
_, t3, y, c := t2.(T).destruct()
|
||||
_, a, x, b := t3.(T).destruct()
|
||||
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
|
||||
case leIsT && leriIsT && le.cl == R && leri.cl == R:
|
||||
_, t2, z, d := t.destruct()
|
||||
_, a, x, t3 := t2.(T).destruct()
|
||||
_, b, y, c := t3.(T).destruct()
|
||||
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
|
||||
case riIsT && rileIsT && ri.cl == R && rile.cl == R:
|
||||
_, a, x, t2 := t.destruct()
|
||||
_, t3, z, d := t2.(T).destruct()
|
||||
_, b, y, c := t3.(T).destruct()
|
||||
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
|
||||
case riIsT && ririIsT && ri.cl == R && riri.cl == R:
|
||||
_, a, x, t2 := t.destruct()
|
||||
_, b, y, t3 := t2.(T).destruct()
|
||||
_, c, z, d := t3.(T).destruct()
|
||||
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
|
||||
default:
|
||||
return t
|
||||
}
|
||||
}
|
||||
|
||||
func (t T) ins(x int) Tree {
|
||||
switch {
|
||||
case x < t.aa:
|
||||
return T{t.cl, t.le.ins(x), t.aa, t.ri}.balance()
|
||||
case x > t.aa:
|
||||
return T{t.cl, t.le, t.aa, t.ri.ins(x)}.balance()
|
||||
default:
|
||||
return t
|
||||
}
|
||||
}
|
||||
|
||||
func (t T) destruct() (Color, Tree, int, Tree) {
|
||||
return t.cl, t.le, t.aa, t.ri
|
||||
}
|
||||
|
||||
func (t T) String() string {
|
||||
return fmt.Sprintf("T(%s, %v, %d, %v)", t.cl, t.le, t.aa, t.ri)
|
||||
}
|
||||
|
||||
func insert(tr Tree, x int) Tree {
|
||||
t := tr.ins(x)
|
||||
switch t.(type) {
|
||||
case T:
|
||||
tt := t.(T)
|
||||
_, a, y, b := tt.destruct()
|
||||
return T{B, a, y, b}
|
||||
case E:
|
||||
return E{}
|
||||
default:
|
||||
return nil
|
||||
}
|
||||
}
|
||||
|
||||
func main() {
|
||||
var tr Tree = E{}
|
||||
for i := 1; i <= 16; i++ {
|
||||
tr = insert(tr, i)
|
||||
}
|
||||
fmt.Println(tr)
|
||||
}
|
||||
18
Task/Algebraic-data-types/Haskell/algebraic-data-types.hs
Normal file
18
Task/Algebraic-data-types/Haskell/algebraic-data-types.hs
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
data Color = R | B
|
||||
data Tree a = E | T Color (Tree a) a (Tree a)
|
||||
|
||||
balance :: Color -> Tree a -> a -> Tree a -> Tree a
|
||||
balance B (T R (T R a x b) y c ) z d = T R (T B a x b) y (T B c z d)
|
||||
balance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
|
||||
balance B a x (T R (T R b y c) z d ) = T R (T B a x b) y (T B c z d)
|
||||
balance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
|
||||
balance col a x b = T col a x b
|
||||
|
||||
insert :: Ord a => a -> Tree a -> Tree a
|
||||
insert x s = T B a y b where
|
||||
ins E = T R E x E
|
||||
ins s@(T col a y b)
|
||||
| x < y = balance col (ins a) y b
|
||||
| x > y = balance col a y (ins b)
|
||||
| otherwise = s
|
||||
T _ a y b = ins s
|
||||
39
Task/Algebraic-data-types/J/algebraic-data-types-1.j
Normal file
39
Task/Algebraic-data-types/J/algebraic-data-types-1.j
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
insert=:{{
|
||||
'R';'';y;a:
|
||||
:
|
||||
if. 0=#y do. insert x
|
||||
elseif. 0=L.y do. x insert insert y
|
||||
else.
|
||||
'C e K w'=. y
|
||||
select. *x - K
|
||||
case. _1 do. balance C;(x insert e);K;<w
|
||||
case. 0 do. y
|
||||
case. 1 do. balance C;e;K;<x insert w
|
||||
end.
|
||||
end.
|
||||
}}
|
||||
|
||||
NB. C: color, e: east, K: key, w: west
|
||||
NB. two cascaded reds under a black become two black siblings under a red
|
||||
balance=: {{
|
||||
'C e K w'=. y
|
||||
if. #e do.
|
||||
'eC ee eK ew'=. e
|
||||
if. 'R'=eC do.
|
||||
if. #ee do.
|
||||
'eeC eee eeK eew'=. ee NB. ((eee eeK eew) eK ew) K w => (eee eeK eew) eK (ew K w)
|
||||
if. 'R'=eeC do. 'R';('B';eee;eeK;<eew);eK;<'B';ew;K;<w return. end. end.
|
||||
if. #ew do.
|
||||
'ewC ewe ewK eww'=. ew NB. (ee ek (ewe ewK eww)) K w => (ee ek ewe) ewK (eww K w)
|
||||
if. 'R'=ewC do. 'R';('B';ee;eK;<ewe);ewK;<'B';eww;K;<w return. end. end. end. end.
|
||||
if. #w do.
|
||||
'wC we wK ww'=. w
|
||||
if. 'R'=wC do.
|
||||
if. #we do.
|
||||
'weC wee weK wew'=. we NB. e K ((wee weK wew) wK ww) => (e K wee) weK (wew wK ww)
|
||||
if. 'R'=weC do. 'R';('B';e;K;<wee);weK;<'B';wew;wK;<ww return. end. end.
|
||||
if. #ww do.
|
||||
'wwC wwe wwK www'=. ww NB. e K (we wK (wwe wwK www)) => (e K we) wK (wwe wwK www)
|
||||
if. 'R'=wwC do. 'R';('B';e;K;<we);wK;<'B';wwe;wwK;<www return. end. end. end. end.
|
||||
y
|
||||
}}
|
||||
6
Task/Algebraic-data-types/J/algebraic-data-types-2.j
Normal file
6
Task/Algebraic-data-types/J/algebraic-data-types-2.j
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
3 insert 2 insert 5
|
||||
┌─┬───────┬─┬───────┐
|
||||
│R│┌─┬┬─┬┐│3│┌─┬┬─┬┐│
|
||||
│ ││B││2│││ ││B││5│││
|
||||
│ │└─┴┴─┴┘│ │└─┴┴─┴┘│
|
||||
└─┴───────┴─┴───────┘
|
||||
18
Task/Algebraic-data-types/J/algebraic-data-types-3.j
Normal file
18
Task/Algebraic-data-types/J/algebraic-data-types-3.j
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
NB. always treat root of tree as black
|
||||
validate=: {{
|
||||
if. 0=#y do. 1 return. end.
|
||||
'C e K w'=. y
|
||||
check 'B';e;K;<w
|
||||
}}
|
||||
|
||||
check=: {{
|
||||
if. 0=#y do. 1 return. end.
|
||||
'C e K w'=. y
|
||||
if. 'R'=C do.
|
||||
if. 'R'={.;{.e do. 0 return. end.
|
||||
if. 'R'={.;{.w do. 0 return. end.
|
||||
end.
|
||||
a=. check e
|
||||
b=. check w
|
||||
(*a)*(a=b)*b+'B'=C
|
||||
}}
|
||||
16
Task/Algebraic-data-types/J/algebraic-data-types-4.j
Normal file
16
Task/Algebraic-data-types/J/algebraic-data-types-4.j
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
?.~20
|
||||
14 18 12 16 5 1 3 0 6 13 9 8 15 17 2 10 7 4 19 11
|
||||
insert/?.~20
|
||||
┌─┬──────────────────────────────────────────────────────────────────────┬──┬────────────────────────────────────────────────────────────────────────┐
|
||||
│R│┌─┬───────────────────────────────────┬─┬────────────────────────────┐│10│┌─┬────────────────────────────────────────────────┬──┬────────────────┐│
|
||||
│ ││R│┌─┬──────────────┬─┬──────────────┐│5│┌─┬───────┬─┬──────────────┐││ ││B│┌─┬────────────────┬──┬────────────────────────┐│17│┌─┬────────┬──┬┐││
|
||||
│ ││ ││B│┌─┬┬─┬───────┐│2│┌─┬───────┬─┬┐││ ││B│┌─┬┬─┬┐│7│┌─┬┬─┬───────┐│││ ││ ││R│┌─┬┬──┬────────┐│13│┌─┬────────┬──┬────────┐││ ││B│┌─┬┬──┬┐│19││││
|
||||
│ ││ ││ ││B││0│┌─┬┬─┬┐││ ││B│┌─┬┬─┬┐│4││││ ││ ││B││6│││ ││B││8│┌─┬┬─┬┐││││ ││ ││ ││B││11│┌─┬┬──┬┐││ ││B│┌─┬┬──┬┐│15│┌─┬┬──┬┐│││ ││ ││R││18│││ ││││
|
||||
│ ││ ││ ││ ││ ││R││1││││ ││ ││R││3│││ ││││ ││ │└─┴┴─┴┘│ ││ ││ ││R││9││││││ ││ ││ ││ ││ ││R││12││││ ││ ││R││14│││ ││R││16│││││ ││ │└─┴┴──┴┘│ ││││
|
||||
│ ││ ││ ││ ││ │└─┴┴─┴┘││ ││ │└─┴┴─┴┘│ ││││ ││ │ │ ││ ││ │└─┴┴─┴┘││││ ││ ││ ││ ││ │└─┴┴──┴┘││ ││ │└─┴┴──┴┘│ │└─┴┴──┴┘│││ │└─┴────────┴──┴┘││
|
||||
│ ││ ││ │└─┴┴─┴───────┘│ │└─┴───────┴─┴┘││ ││ │ │ │└─┴┴─┴───────┘│││ ││ ││ │└─┴┴──┴────────┘│ │└─┴────────┴──┴────────┘││ │ ││
|
||||
│ ││ │└─┴──────────────┴─┴──────────────┘│ │└─┴───────┴─┴──────────────┘││ ││ │└─┴────────────────┴──┴────────────────────────┘│ │ ││
|
||||
│ │└─┴───────────────────────────────────┴─┴────────────────────────────┘│ │└─┴────────────────────────────────────────────────┴──┴────────────────┘│
|
||||
└─┴──────────────────────────────────────────────────────────────────────┴──┴────────────────────────────────────────────────────────────────────────┘
|
||||
validate insert/?.~20
|
||||
4
|
||||
28
Task/Algebraic-data-types/Jq/algebraic-data-types-1.jq
Normal file
28
Task/Algebraic-data-types/Jq/algebraic-data-types-1.jq
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
# bindings($x) attempts to match . and $x structurally on the
|
||||
# assumption that . is free of JSON objects, and that any objects in
|
||||
# $x will have distinct, singleton keys that are to be interpreted as
|
||||
# variables. These variables will match the corresponding entities in
|
||||
# . if . and $x can be structurally matched.
|
||||
#
|
||||
# If . and $x cannot be matched, then null is returned;
|
||||
# otherwise, if $x contains no objects, {} is returned;
|
||||
# finally, if . and $x can be structurally matched, a composite object containing the bindings
|
||||
# will be returned.
|
||||
# Output: null (failure to match) or a single JSON object giving the bindings if any.
|
||||
def bindings($x):
|
||||
if $x == . then {} # by assumption, no bindings are necessary
|
||||
elif ($x|type) == "object"
|
||||
then ($x|keys) as $keys
|
||||
| if ($keys|length) == 1 then {($keys[0]): .} else "objects should be singletons"|error end
|
||||
elif type != ($x|type) then null
|
||||
elif type == "array"
|
||||
then if length != ($x|length) then null
|
||||
else . as $in
|
||||
| reduce range(0;length) as $i ({};
|
||||
if . == null then null
|
||||
else ($in[$i] | bindings($x[$i]) ) as $m
|
||||
| if $m == null then null else . + $m end
|
||||
end)
|
||||
end
|
||||
else null
|
||||
end ;
|
||||
42
Task/Algebraic-data-types/Jq/algebraic-data-types-2.jq
Normal file
42
Task/Algebraic-data-types/Jq/algebraic-data-types-2.jq
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
include "bindings" {search: "."};
|
||||
|
||||
def E: []; # the empty node
|
||||
# Each nonempty node is an array: [Color, Left, Value, Right]
|
||||
# where Left and Right are nodes.
|
||||
|
||||
def B: "⚫";
|
||||
def R: "🔴";
|
||||
|
||||
def b(x): bindings({} | x) // empty;
|
||||
|
||||
# Input: [$color, $left, $value, $right]
|
||||
def balance:
|
||||
def node: [R, [B, .a, .x, .b], .y, [B, .c, .z, .d]];
|
||||
|
||||
( b([B, [R, [R, {a}, {x}, {x}], {y}, {c}], {z}, {d}])
|
||||
// b([B, [R, {a}, {x}, [R, {b}, {y}, {c}]], {z}, {d}])
|
||||
// b([B, {a},{x}, [R, [R, {b}, {y}, {c}], {z}, {d}]])
|
||||
// b([B, {a},{x}, [R, {b}, {y}, [R, {c}, {z}, {d}]]])
|
||||
| node) // . ;
|
||||
|
||||
# Input: a node
|
||||
def ins($x):
|
||||
if . == E then [R, E, $x, E]
|
||||
else . as [$col, $left, $y, $right]
|
||||
| if $x < $y then [ $col, ($left|ins($x)), $y, $right] | balance
|
||||
elif $x > $y then [ $col, $left, $y, ($right|ins($x)) ] | balance
|
||||
else $left
|
||||
end
|
||||
end;
|
||||
|
||||
# insert(Value) into .
|
||||
def insert($x):
|
||||
ins($x) as [$col, $left, $y, $right]
|
||||
| [ B, $left, $y, $right] ;
|
||||
|
||||
def pp: walk( if type == "array" then map(select(length>0)) else . end);
|
||||
|
||||
def task($n):
|
||||
reduce range(0; $n) as $i (E; insert($i));
|
||||
|
||||
task(16) | pp
|
||||
1
Task/Algebraic-data-types/Jq/algebraic-data-types-3.jq
Normal file
1
Task/Algebraic-data-types/Jq/algebraic-data-types-3.jq
Normal file
|
|
@ -0,0 +1 @@
|
|||
jq -n -f pattern-matching.jq | grep -v '[][]' | tr -d ',"'
|
||||
68
Task/Algebraic-data-types/Julia/algebraic-data-types.julia
Normal file
68
Task/Algebraic-data-types/Julia/algebraic-data-types.julia
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
import Base.length
|
||||
|
||||
abstract type AbstractColoredNode end
|
||||
|
||||
struct RedNode <: AbstractColoredNode end; const R = RedNode()
|
||||
struct BlackNode <: AbstractColoredNode end; const B = BlackNode()
|
||||
struct Empty end; const E = Empty()
|
||||
length(e::Empty) = 1
|
||||
|
||||
function balance(b::BlackNode, v::Vector, z, d)
|
||||
if v[1] == R
|
||||
if length(v[2]) == 4 && v[2][1] == R
|
||||
return [R, [B, v[2][2], v[2][3], v[2][4]], v[3], [B, v[4], z, d]]
|
||||
elseif length(v[4]) == 4 && v[4][1] == R
|
||||
return [R, [B, v[2], v[3], v[4][2]], v[4][3], [B, v[4][4], z, d]]
|
||||
end
|
||||
end
|
||||
[b, v, z, d]
|
||||
end
|
||||
|
||||
function balance(b::BlackNode, a, x, v::Vector)
|
||||
if v[1] == R
|
||||
if length(v[2]) == 4 && v[2][1] == R
|
||||
return [R, [B, a, x, v[2][2]], v[2][3], [B, v[2][4], v[3], v[4]]]
|
||||
elseif length(v[4]) == 4 && v[4][1] == R
|
||||
return [R, [B, a, x, v[2]], v[3], [B, v[4][2], v[4][3], v[4][4]]]
|
||||
end
|
||||
end
|
||||
[b, a, x, v]
|
||||
end
|
||||
|
||||
function balance(b::BlackNode, a::Vector, x, v::Vector)
|
||||
if v[1] == R
|
||||
if length(v[2]) == 4 && v[2][1] == R
|
||||
return [R, [B, a, x, v[2][2]], v[2][3], [B, v[2][4], v[3], v[4]]]
|
||||
elseif length(v[4]) == 4 && v[4][1] == R
|
||||
return [R, [B, a, x, v[2]], v[3], [B, v[4][2], v[4][3], v[4][4]]]
|
||||
end
|
||||
end
|
||||
[b, a, x, v]
|
||||
end
|
||||
|
||||
balance(node, l, a, r) = [node, l, a, r]
|
||||
|
||||
function ins(v::Vector, x::Number)
|
||||
if length(v) == 4
|
||||
if x < v[3]
|
||||
return balance(v[1], ins(v[2], x), v[3], v[4])
|
||||
elseif x > v[3]
|
||||
return balance(v[1], v[2], v[3], ins(v[4], x))
|
||||
end
|
||||
end
|
||||
v
|
||||
end
|
||||
|
||||
ins(t, a) = [R, E, a, E]
|
||||
|
||||
insert(v, a) = (t = ins(v, a); t[1] = B; t)
|
||||
|
||||
function testRB()
|
||||
t = E
|
||||
for i in rand(collect(1:20), 10)
|
||||
t = insert(t, i)
|
||||
end
|
||||
println(replace(string(t), r"lackNode\(\)|edNode\(\)|Any|mpty\(\)" => ""))
|
||||
end
|
||||
|
||||
testRB()
|
||||
84
Task/Algebraic-data-types/Kotlin/algebraic-data-types.kotlin
Normal file
84
Task/Algebraic-data-types/Kotlin/algebraic-data-types.kotlin
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
// version 1.1.51
|
||||
|
||||
import Color.*
|
||||
|
||||
enum class Color { R, B }
|
||||
|
||||
sealed class Tree<A : Comparable<A>> {
|
||||
|
||||
fun insert(x: A): Tree<A> {
|
||||
val t = ins(x)
|
||||
return when (t) {
|
||||
is T -> {
|
||||
val (_, a, y, b) = t
|
||||
T(B, a, y, b)
|
||||
}
|
||||
|
||||
is E -> E()
|
||||
}
|
||||
}
|
||||
|
||||
abstract fun ins(x: A): Tree<A>
|
||||
}
|
||||
|
||||
class E<A : Comparable<A>> : Tree<A>() {
|
||||
|
||||
override fun ins(x: A): Tree<A> = T(R, E(), x, E())
|
||||
|
||||
override fun toString() = "E"
|
||||
}
|
||||
|
||||
data class T<A : Comparable<A>>(
|
||||
val cl: Color,
|
||||
val le: Tree<A>,
|
||||
val aa: A,
|
||||
val ri: Tree<A>
|
||||
) : Tree<A>() {
|
||||
|
||||
private fun balance(): Tree<A> {
|
||||
if (cl != B) return this
|
||||
val res =
|
||||
if (le is T && le.le is T && le.cl == R && le.le.cl == R) {
|
||||
val (_, t, z, d) = this
|
||||
val (_, t2, y, c) = t as T
|
||||
val (_, a, x, b) = t2 as T
|
||||
T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
}
|
||||
else if (le is T && le.ri is T && le.cl == R && le.ri.cl == R) {
|
||||
val (_, t, z, d) = this
|
||||
val (_, a, x, t2) = t as T
|
||||
val (_, b, y, c) = t2 as T
|
||||
T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
}
|
||||
else if (ri is T && ri.le is T && ri.cl == R && ri.le.cl == R) {
|
||||
val (_, a, x, t) = this
|
||||
val (_, t2, z, d) = t as T
|
||||
val (_, b, y, c) = t2 as T
|
||||
T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
}
|
||||
else if (ri is T && ri.ri is T && ri.cl == R && ri.ri.cl == R) {
|
||||
val (_, a, x, t) = this
|
||||
val (_, b, y, t2) = t as T
|
||||
val (_, c, z, d) = t2 as T
|
||||
T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
}
|
||||
else this
|
||||
return res
|
||||
}
|
||||
|
||||
override fun ins(x: A): Tree<A> = when (x.compareTo(aa)) {
|
||||
-1 -> T(cl, le.ins(x), aa, ri).balance()
|
||||
+1 -> T(cl, le, aa, ri.ins(x)).balance()
|
||||
else -> this
|
||||
}
|
||||
|
||||
override fun toString() = "T($cl, $le, $aa, $ri)"
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
var tree: Tree<Int> = E()
|
||||
for (i in 1..16) {
|
||||
tree = tree.insert(i)
|
||||
}
|
||||
println(tree)
|
||||
}
|
||||
45
Task/Algebraic-data-types/Nim/algebraic-data-types.nim
Normal file
45
Task/Algebraic-data-types/Nim/algebraic-data-types.nim
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
import fusion/matching
|
||||
{.experimental: "caseStmtMacros".}
|
||||
|
||||
type
|
||||
Colour = enum Empty, Red, Black
|
||||
RBTree[T] = ref object
|
||||
colour: Colour
|
||||
left, right: RBTree[T]
|
||||
value: T
|
||||
|
||||
proc `[]`[T](r: RBTree[T], idx: static[FieldIndex]): auto =
|
||||
## enables tuple syntax for unpacking and matching
|
||||
when idx == 0: r.colour
|
||||
elif idx == 1: r.left
|
||||
elif idx == 2: r.value
|
||||
elif idx == 3: r.right
|
||||
|
||||
template B[T](l: untyped, v: T, r): RBTree[T] =
|
||||
RBTree[T](colour: Black, left: l, value: v, right: r)
|
||||
|
||||
template R[T](l: untyped, v: T, r): RBTree[T] =
|
||||
RBTree[T](colour: Red, left: l, value: v, right: r)
|
||||
|
||||
template balImpl[T](t: typed): untyped =
|
||||
case t
|
||||
of (colour: Red | Empty): discard
|
||||
of (Black, (Red, (Red, @a, @x, @b), @y, @c), @z, @d) |
|
||||
(Black, (Red, @a, @x, (Red, @b, @y, @c)), @z, @d) |
|
||||
(Black, @a, @x, (Red, (Red, @b, @y, @c), @z, @d)) |
|
||||
(Black, @a, @x, (Red, @b, @y, (Red, @c, @z, @d))):
|
||||
t = R(B(a, x, b), y, B(c, z, d))
|
||||
|
||||
proc balance*[T](t: var RBTree[T]) = balImpl[T](t)
|
||||
|
||||
template insImpl[T](t, x: typed): untyped =
|
||||
template E: RBTree[T] = RBTree[T]()
|
||||
case t
|
||||
of (colour: Empty): t = R(E, x, E)
|
||||
of (value: > x): t.left.ins(x); t.balance()
|
||||
of (value: < x): t.right.ins(x); t.balance()
|
||||
|
||||
proc insert*[T](tt: var RBTree[T], xx: T) =
|
||||
proc ins(t: var RBTree[T], x: T) = insImpl[T](t, x)
|
||||
tt.ins(xx)
|
||||
tt.colour = Black
|
||||
24
Task/Algebraic-data-types/OCaml/algebraic-data-types.ocaml
Normal file
24
Task/Algebraic-data-types/OCaml/algebraic-data-types.ocaml
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
type color = R | B
|
||||
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
|
||||
|
||||
(** val balance : color * 'a tree * 'a * 'a tree -> 'a tree *)
|
||||
let balance = function
|
||||
| B, T (R, T (R,a,x,b), y, c), z, d
|
||||
| B, T (R, a, x, T (R,b,y,c)), z, d
|
||||
| B, a, x, T (R, T (R,b,y,c), z, d)
|
||||
| B, a, x, T (R, b, y, T (R,c,z,d)) -> T (R, T (B,a,x,b), y, T (B,c,z,d))
|
||||
| col, a, x, b -> T (col, a, x, b)
|
||||
|
||||
(** val insert : 'a -> 'a tree -> 'a tree *)
|
||||
let insert x s =
|
||||
let rec ins = function
|
||||
| E -> T (R,E,x,E)
|
||||
| T (col,a,y,b) as s ->
|
||||
if x < y then
|
||||
balance (col, ins a, y, b)
|
||||
else if x > y then
|
||||
balance (col, a, y, ins b)
|
||||
else
|
||||
s
|
||||
in let T (_,a,y,b) = ins s
|
||||
in T (B,a,y,b)
|
||||
24
Task/Algebraic-data-types/Oz/algebraic-data-types.oz
Normal file
24
Task/Algebraic-data-types/Oz/algebraic-data-types.oz
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
fun {Balance Col A X B}
|
||||
case Col#A#X#B
|
||||
of b#t(r t(r A X B) Y C )#Z#D then t(r t(b A X B) Y t(b C Z D))
|
||||
[] b#t(r A X t(r B Y C))#Z#D then t(r t(b A X B) Y t(b C Z D))
|
||||
[] b#A #X#t(r t(r B Y C) Z D) then t(r t(b A X B) Y t(b C Z D))
|
||||
[] b#A #X#t(r B Y t(r C Z D)) then t(r t(b A X B) Y t(b C Z D))
|
||||
else t(Col A X B)
|
||||
end
|
||||
end
|
||||
|
||||
fun {Insert X S}
|
||||
fun {Ins S}
|
||||
case S of e then t(r e X e)
|
||||
[] t(Col A Y B) then
|
||||
if X < Y then {Balance Col {Ins A} Y B}
|
||||
elseif X > Y then {Balance Col A Y {Ins B}}
|
||||
else S
|
||||
end
|
||||
end
|
||||
end
|
||||
t(_ A Y B) = {Ins S}
|
||||
in
|
||||
t(b A Y B)
|
||||
end
|
||||
65
Task/Algebraic-data-types/Perl/algebraic-data-types.pl
Normal file
65
Task/Algebraic-data-types/Perl/algebraic-data-types.pl
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
#!perl
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings qw(FATAL all);
|
||||
|
||||
my $balanced = qr{([^<>,]++|<(?-1),(?-1),(?-1),(?-1)>)};
|
||||
my ($a, $b, $c, $d, $x, $y, $z) = map +qr((?<$_>$balanced)),
|
||||
'a'..'d', 'x'..'z';
|
||||
my $col = qr{(?<col>[RB])};
|
||||
|
||||
sub balance {
|
||||
local $_ = shift;
|
||||
if( /^<B,<R,<R,$a,$x,$b>,$y,$c>,$z,$d>\z/ or
|
||||
/^<B,<R,$a,$x,<R,$b,$y,$c>>,$z,$d>\z/ or
|
||||
/^<B,$a,$x,<R,<R,$b,$y,$c>,$z,$d>>\z/ or
|
||||
/^<B,$a,$x,<R,$b,$y,<R,$c,$z,$d>>>\z/ )
|
||||
{
|
||||
my ($aa, $bb, $cc, $dd) = @+{'a'..'d'};
|
||||
my ($xx, $yy, $zz) = @+{'x'..'z'};
|
||||
"<R,<B,$aa,$xx,$bb>,$yy,<B,$cc,$zz,$dd>>";
|
||||
} else {
|
||||
$_;
|
||||
}
|
||||
}
|
||||
|
||||
sub ins {
|
||||
my ($xx, $tree) = @_;
|
||||
if($tree =~ m{^<$col,$a,$y,$b>\z} ) {
|
||||
my ($color, $aa, $bb, $yy) = @+{qw(col a b y)};
|
||||
if( $xx < $yy ) {
|
||||
return balance "<$color,".ins($xx,$aa).",$yy,$bb>";
|
||||
} elsif( $xx > $yy ) {
|
||||
return balance "<$color,$aa,$yy,".ins($xx,$bb).">";
|
||||
} else {
|
||||
return $tree;
|
||||
}
|
||||
} elsif( $tree !~ /,/) {
|
||||
return "<R,_,$xx,_>";
|
||||
} else {
|
||||
print "Unexpected failure!\n";
|
||||
print "Tree parts are: \n";
|
||||
print $_, "\n" for $tree =~ /$balanced/g;
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
sub insert {
|
||||
my $tree = ins(@_);
|
||||
$tree =~ m{^<$col,$a,$y,$b>\z} or die;
|
||||
"<B,$+{a},$+{y},$+{b}>";
|
||||
}
|
||||
|
||||
MAIN: {
|
||||
my @a = 1..10;
|
||||
for my $aa ( 1 .. $#a ) {
|
||||
my $bb = int rand( 1 + $aa );
|
||||
@a[$aa, $bb] = @a[$bb, $aa];
|
||||
}
|
||||
my $t = "!";
|
||||
for( @a ) {
|
||||
$t = insert( $_, $t );
|
||||
print "Tree: $t.\n";
|
||||
}
|
||||
}
|
||||
print "Done\n";
|
||||
128
Task/Algebraic-data-types/Phix/algebraic-data-types.phix
Normal file
128
Task/Algebraic-data-types/Phix/algebraic-data-types.phix
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000080;font-style:italic;">--
|
||||
-- demo\rosetta\Pattern_matching.exw
|
||||
-- =================================
|
||||
--
|
||||
-- 1). Lightly modified copy of demo\rosetta\VisualiseTree.exw</span>
|
||||
|
||||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
|
||||
|
||||
<span style="color: #000080;font-style:italic;">-- To the theme tune of the Milk Tray Ad iyrt,
|
||||
-- All because the Windows console hates utf8:</span>
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">TL</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#DA</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '┌'</span>
|
||||
<span style="color: #000000;">VT</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#B3</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '│'</span>
|
||||
<span style="color: #000000;">BL</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#C0</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '└'</span>
|
||||
<span style="color: #000000;">HZ</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#C4</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '─'</span>
|
||||
<span style="color: #000000;">HS</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"\#C4"</span> <span style="color: #000080;font-style:italic;">-- (string version of HZ)</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">w1252_to_utf8</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">WINDOWS</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">substitute_all</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,{</span> <span style="color: #000000;">TL</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">VT</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">BL</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">HZ</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #008000;">"┌"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"│"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"└"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"─"</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
<span style="color: #000080;font-style:italic;">--</hates utf8></span>
|
||||
|
||||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">=</span><span style="color: #000000;">HS</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"<empty>\n"</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">colour</span><span style="color: #0000FF;">,</span><span style="color: #000000;">left</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">right</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">TL</span> <span style="color: #008080;">or</span> <span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">HZ</span><span style="color: #0000FF;">?</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">:</span><span style="color: #000000;">VT</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">,</span><span style="color: #000000;">root</span><span style="color: #0000FF;">&</span><span style="color: #000000;">TL</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">g</span>
|
||||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s%s%v\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">w1252_to_utf8</span><span style="color: #0000FF;">(</span><span style="color: #000000;">root</span><span style="color: #0000FF;">),</span><span style="color: #000000;">colour</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">TL</span><span style="color: #0000FF;">?</span><span style="color: #000000;">VT</span><span style="color: #0000FF;">:</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">,</span><span style="color: #000000;">root</span><span style="color: #0000FF;">&</span><span style="color: #000000;">BL</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
|
||||
<span style="color: #000080;font-style:italic;">--</copy VisualiseTree>
|
||||
|
||||
-- 2). Imagine the following is in a file, say algebraic_data_types.e - not quite generic enough
|
||||
-- for inclusion in builtins, but not exactly difficult to copy/maintain per-project either.</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">key</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">and</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">key</span><span style="color: #0000FF;">)==</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">key</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #000000;">ki</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">key</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">ti</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #008080;">not</span> <span style="color: #004080;">string</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">r2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">r2</span><span style="color: #0000FF;">={}</span> <span style="color: #008080;">then</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">r2</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">ki</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">ki</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">ti</span> <span style="color: #008080;">then</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #000080;font-style:italic;">/*global*/</span> <span style="color: #008080;">function</span> <span style="color: #000000;">match_algebraic</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
<span style="color: #000080;font-style:italic;">--</algebraic_data_types.e>
|
||||
|
||||
-- 3). The actual task</span>
|
||||
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">B</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">R</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"R"</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_algebraic</span><span style="color: #0000FF;">({{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}}}},</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
|
||||
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">},</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}}</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">t</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">}</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;"><</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">else</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">({</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">tree</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">B</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">stuff</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span>
|
||||
|
||||
<span style="color: #0000FF;">?</span><span style="color: #008000;">"done"</span>
|
||||
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
|
||||
<!--
|
||||
30
Task/Algebraic-data-types/Picat/algebraic-data-types.picat
Normal file
30
Task/Algebraic-data-types/Picat/algebraic-data-types.picat
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
main =>
|
||||
T = e,
|
||||
foreach (X in 1..10)
|
||||
insert(X,T,T1),
|
||||
T := T1
|
||||
end,
|
||||
output(T,0).
|
||||
|
||||
insert(X,S,R) =>
|
||||
ins(X,S,R1),
|
||||
R1 = $t(_,A,Y,B),
|
||||
R = $t(b,A,Y,B).
|
||||
|
||||
ins(X,e,R) => R = $t(r,e,X,e).
|
||||
ins(X,t(C,A,Y,B),R), X < Y => ins(X,A,Ao), balance(C,Ao,Y,B,R).
|
||||
ins(X,t(C,A,Y,B),R), X > Y => ins(X,B,Bo), balance(C,A,Y,Bo,R).
|
||||
ins(_X,T,R) => R = T.
|
||||
|
||||
balance(C,A,X,B,S) :- (bal(C,A,X,B,T) -> S = T ; S = $t(C,A,X,B)).
|
||||
|
||||
bal(b, t(r,t(r,A,X,B),Y,C), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
|
||||
bal(b, t(r,A,X,t(r,B,Y,C)), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
|
||||
bal(b, A, X, t(r,t(r,B,Y,C),Z,D), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
|
||||
bal(b, A, X, t(r,B,Y,t(r,C,Z,D)), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
|
||||
|
||||
output(e,Indent) => printf("%*w\n",Indent,e).
|
||||
output(t(C,A,Y,B),Indent) =>
|
||||
output(A,Indent+6),
|
||||
printf("%*w[%w]\n",Indent,C,Y),
|
||||
output(B,Indent+6).
|
||||
35
Task/Algebraic-data-types/PicoLisp/algebraic-data-types-1.l
Normal file
35
Task/Algebraic-data-types/PicoLisp/algebraic-data-types-1.l
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
(be color (R))
|
||||
(be color (B))
|
||||
|
||||
(be tree (@ E))
|
||||
(be tree (@P (T @C @L @X @R))
|
||||
(color @C)
|
||||
(tree @P @L)
|
||||
(call @P @X)
|
||||
(tree @P @R) )
|
||||
|
||||
(be bal (B (T R (T R @A @X @B) @Y @C) @Z @D (T R (T B @A @X @B) @Y (T B @C @Z @D))))
|
||||
(be bal (B (T R @A @X (T R @B @Y @C)) @Z @D (T R (T B @A @X @B) @Y (T B @C @Z @D))))
|
||||
(be bal (B @A @X (T R (T R @B @Y @C) @Z @D) (T R (T B @A @X @B) @Y (T B @C @Z @D))))
|
||||
(be bal (B @A @X (T R @B @Y (T R @C @Z @D)) (T R (T B @A @X @B) @Y (T B @C @Z @D))))
|
||||
|
||||
(be balance (@C @A @X @B @S)
|
||||
(bal @C @A @X @B @S)
|
||||
T )
|
||||
(be balance (@C @A @X @B (T @C @A @X @B)))
|
||||
|
||||
(be ins (@X E (T R E @X E)))
|
||||
(be ins (@X (T @C @A @Y @B) @R)
|
||||
(^ @ (> (-> @Y) (-> @X)))
|
||||
(ins @X @A @Ao)
|
||||
(balance @C @Ao @Y @B @R)
|
||||
T )
|
||||
(be ins (@X (T @C @A @Y @B) @R)
|
||||
(^ @ (> (-> @X) (-> @Y)))
|
||||
(ins @X @B @Bo)
|
||||
(balance @C @A @Y @Bo @R)
|
||||
T )
|
||||
(be ins (@X (T @C @A @Y @B) (T @C @A @Y @B)))
|
||||
|
||||
(be insert (@X @S (T B @A @Y @B))
|
||||
(ins @X @S (T @ @A @Y @B)) )
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
: (? (insert 2 E @A) (insert 1 @A @B) (insert 3 @B @C))
|
||||
@A=(T B E 2 E) @B=(T B (T R E 1 E) 2 E) @C=(T B (T R E 1 E) 2 (T R E 3 E))
|
||||
-> NIL
|
||||
90
Task/Algebraic-data-types/Python/algebraic-data-types.py
Normal file
90
Task/Algebraic-data-types/Python/algebraic-data-types.py
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
from __future__ import annotations
|
||||
from enum import Enum
|
||||
from typing import NamedTuple
|
||||
from typing import Optional
|
||||
|
||||
|
||||
class Color(Enum):
|
||||
B = 0
|
||||
R = 1
|
||||
|
||||
|
||||
class Tree(NamedTuple):
|
||||
color: Color
|
||||
left: Optional[Tree]
|
||||
value: int
|
||||
right: Optional[Tree]
|
||||
|
||||
def insert(self, val: int) -> Tree:
|
||||
return self._insert(val).make_black()
|
||||
|
||||
def _insert(self, val: int) -> Tree:
|
||||
match compare(val, self.value):
|
||||
case _ if self == EMPTY:
|
||||
return Tree(Color.R, EMPTY, val, EMPTY)
|
||||
case -1:
|
||||
assert self.left is not None
|
||||
return Tree(
|
||||
self.color, self.left._insert(val), self.value, self.right
|
||||
).balance()
|
||||
case 1:
|
||||
assert self.right is not None
|
||||
return Tree(
|
||||
self.color, self.left, self.value, self.right._insert(val)
|
||||
).balance()
|
||||
case _:
|
||||
return self
|
||||
|
||||
def balance(self) -> Tree:
|
||||
match self:
|
||||
case (Color.B, (Color.R, (Color.R, a, x, b), y, c), z, d):
|
||||
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
|
||||
case (Color.B, (Color.R, a, x, (Color.R, b, y, c)), z, d):
|
||||
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
|
||||
case (Color.B, a, x, (Color.R, (Color.R, b, y, c), z, d)):
|
||||
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
|
||||
case (Color.B, a, x, (Color.R, b, y, (Color.R, c, z, d))):
|
||||
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
|
||||
case _:
|
||||
return self
|
||||
|
||||
def make_black(self) -> Tree:
|
||||
return self._replace(color=Color.B)
|
||||
|
||||
def __str__(self) -> str:
|
||||
if self == EMPTY:
|
||||
return "[]"
|
||||
return f"[{'R' if self.color == Color.R else 'B'}{self.value}]"
|
||||
|
||||
def print(self, indent: int = 0) -> None:
|
||||
if self != EMPTY:
|
||||
assert self.right is not None
|
||||
self.right.print(indent + 1)
|
||||
|
||||
print(f"{' ' * indent * 4}{self}")
|
||||
|
||||
if self != EMPTY:
|
||||
assert self.left is not None
|
||||
self.left.print(indent + 1)
|
||||
|
||||
|
||||
EMPTY = Tree(Color.B, None, 0, None)
|
||||
|
||||
|
||||
def compare(x: int, y: int) -> int:
|
||||
if x > y:
|
||||
return 1
|
||||
if x < y:
|
||||
return -1
|
||||
return 0
|
||||
|
||||
|
||||
def main():
|
||||
tree = EMPTY
|
||||
for i in range(1, 17):
|
||||
tree = tree.insert(i)
|
||||
tree.print()
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
38
Task/Algebraic-data-types/REXX/algebraic-data-types.rexx
Normal file
38
Task/Algebraic-data-types/REXX/algebraic-data-types.rexx
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
/*REXX pgm builds a red/black tree (with verification & validation), balanced as needed.*/
|
||||
parse arg nodes '/' insert /*obtain optional arguments from the CL*/
|
||||
if nodes='' then nodes = 13.8.17 8.1.11 17.15.25 1.6 25.22.27 /*default nodes. */
|
||||
if insert='' then insert= 22.44 44.66 /* " inserts.*/
|
||||
top= . /*define the default for the TOP var.*/
|
||||
call Dnodes nodes /*define nodes, balance them as added. */
|
||||
call Dnodes insert /*insert " " " " needed.*/
|
||||
call Lnodes /*list the nodes (with indentations). */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
err: say; say '***error***: ' arg(1); say; exit 13
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Dnodes: arg $d; do j=1 for words($d); t= word($d, j) /*color: encoded into L. */
|
||||
parse var t p '.' a "." b '.' x 1 . . . xx
|
||||
call Vnodes p a b
|
||||
if x\=='' then call err "too many nodes specified: " xx
|
||||
if p\==top then if @.p==. then call err "node isn't defined: " p
|
||||
if p ==top then do; !.p=1; L.1=p; end /*assign the top node. */
|
||||
@.p= a b; n= !.p + 1 /*assign node; bump level.*/
|
||||
if a\=='' then do; !.a= n; @.a=; maxL= max(maxL, !.a); end
|
||||
if b\=='' then do; !.b= n; @.b=; maxL= max(maxL, !.b); end
|
||||
L.n= space(L.n a b) /*append to the level list*/
|
||||
end /*j*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Lnodes: do L=1 for maxL; w= length(maxL); rb= word('(red) (black)', 1+L//2)
|
||||
say "level:" right(L, w) left('', L+L) " ───► " rb ' ' L.L
|
||||
end /*lev*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Vnodes: arg $v; do v=1 for words($v); y= word($v, v)
|
||||
if \datatype(y, 'W') then call err "node isn't a whole number: " y
|
||||
y= y / 1 /*normalize Y int.: no LZ, dot*/
|
||||
if top==. then do; LO=y; top=y; HI=y; L.=; @.=; maxL=1; end
|
||||
LO= min(LO, y); HI= max(HI, y)
|
||||
if @.y\==. & @.y\=='' then call err "node is already defined: " y
|
||||
end /*v*/
|
||||
return
|
||||
32
Task/Algebraic-data-types/Racket/algebraic-data-types.rkt
Normal file
32
Task/Algebraic-data-types/Racket/algebraic-data-types.rkt
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
#lang racket
|
||||
|
||||
;; Using short names to make the code line up nicely
|
||||
(struct N (color left value right) #:prefab)
|
||||
|
||||
(define (balance t)
|
||||
(match t
|
||||
[(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))]
|
||||
[(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))]
|
||||
[(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))]
|
||||
[(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))]
|
||||
[else t]))
|
||||
|
||||
(define (insert x s)
|
||||
(define (ins t)
|
||||
(match t
|
||||
['empty (N 'R 'empty x 'empty)]
|
||||
[(N c l v r) (cond [(< x v) (balance (N c (ins l) v r))]
|
||||
[(> x v) (balance (N c l v (ins r)))]
|
||||
[else t])]))
|
||||
(match (ins s) [(N _ l v r) (N 'B l v r)]))
|
||||
|
||||
(define (visualize t0)
|
||||
(let loop ([t t0] [last? #t] [indent '()])
|
||||
(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)))
|
||||
25
Task/Algebraic-data-types/Raku/algebraic-data-types.raku
Normal file
25
Task/Algebraic-data-types/Raku/algebraic-data-types.raku
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
enum RedBlack <R B>;
|
||||
|
||||
multi balance(B,[R,[R,$a,$x,$b],$y,$c],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
|
||||
multi balance(B,[R,$a,$x,[R,$b,$y,$c]],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
|
||||
multi balance(B,$a,$x,[R,[R,$b,$y,$c],$z,$d]) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
|
||||
multi balance(B,$a,$x,[R,$b,$y,[R,$c,$z,$d]]) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
|
||||
|
||||
multi balance($col, $a, $x, $b) { [$col, $a, $x, $b] }
|
||||
|
||||
multi ins( $x, @s [$col, $a, $y, $b] ) {
|
||||
when $x before $y { balance $col, ins($x, $a), $y, $b }
|
||||
when $x after $y { balance $col, $a, $y, ins($x, $b) }
|
||||
default { @s }
|
||||
}
|
||||
multi ins( $x, Any:U ) { [R, Any, $x, Any] }
|
||||
|
||||
multi insert( $x, $s ) {
|
||||
[B, |ins($x,$s)[1..3]];
|
||||
}
|
||||
|
||||
sub MAIN {
|
||||
my $t = Any;
|
||||
$t = insert($_, $t) for (1..10).pick(*);
|
||||
say $t.gist;
|
||||
}
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
// Literal
|
||||
rascal>123 := 123
|
||||
bool: true
|
||||
|
||||
// VariableDeclaration
|
||||
rascal>if(str S := "abc")
|
||||
>>>>>>> println("Match succeeds, S == \"<S>\"");
|
||||
Match succeeds, S == "abc"
|
||||
ok
|
||||
|
||||
// MultiVariable
|
||||
rascal>if([10, N*, 50] := [10, 20, 30, 40, 50])
|
||||
>>>>>>> println("Match succeeds, N == <N>");
|
||||
Match succeeds, N == [20,30,40]
|
||||
ok
|
||||
|
||||
// Variable
|
||||
rascal>N = 10;
|
||||
int: 10
|
||||
rascal>N := 10;
|
||||
bool: true
|
||||
rascal>N := 20;
|
||||
bool: false
|
||||
|
||||
// Set and List
|
||||
rascal>if({10, set[int] S, 50} := {50, 40, 30, 20, 10})
|
||||
>>>>>>> println("Match succeeded, S = <S>");
|
||||
Match succeeded, S = {30,40,20}
|
||||
ok
|
||||
|
||||
rascal>for([L1*, L2*] := [10, 20, 30, 40, 50])
|
||||
>>>>>>> println("<L1> and <L2>");
|
||||
[] and [10,20,30,40,50]
|
||||
[10] and [20,30,40,50]
|
||||
[10,20] and [30,40,50]
|
||||
[10,20,30] and [40,50]
|
||||
[10,20,30,40] and [50]
|
||||
[10,20,30,40,50] and []
|
||||
list[void]: []
|
||||
|
||||
// Descendant
|
||||
rascal>T = red(red(black(leaf(1), leaf(2)), black(leaf(3), leaf(4))), black(leaf(5), leaf(4)));
|
||||
rascal>for(/black(_,leaf(4)) := T)
|
||||
>>>>>>> println("Match!");
|
||||
Match!
|
||||
Match!
|
||||
list[void]: []
|
||||
|
||||
rascal>for(/black(_,leaf(int N)) := T)
|
||||
>>>>>>> println("Match <N>");
|
||||
Match 2
|
||||
Match 4
|
||||
Match 4
|
||||
list[void]: []
|
||||
|
||||
rascal>for(/int N := T)
|
||||
>>>>>>> append N;
|
||||
list[int]: [1,2,3,4,5,4]
|
||||
|
||||
// Labelled
|
||||
rascal>for(/M:black(_,leaf(4)) := T)
|
||||
>>>>>>> println("Match <M>");
|
||||
Match black(leaf(3),leaf(4))
|
||||
Match black(leaf(5),leaf(4))
|
||||
list[void]: []
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
// Quoted pattern
|
||||
` Token1 Token2 ... Tokenn `
|
||||
// A typed quoted pattern
|
||||
(Symbol) ` Token1 Token2 ... TokenN `
|
||||
// A typed variable pattern
|
||||
<Type Var>
|
||||
// A variable pattern
|
||||
<Var>
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
// Define ColoredTrees with red and black nodes and integer leaves
|
||||
data ColoredTree = leaf(int N)
|
||||
| red(ColoredTree left, ColoredTree right)
|
||||
| black(ColoredTree left, ColoredTree right);
|
||||
|
||||
// Count the number of black nodes
|
||||
public int cntBlack(ColoredTree t){
|
||||
int c = 0;
|
||||
visit(t) {
|
||||
case black(_,_): c += 1;
|
||||
};
|
||||
return c;
|
||||
}
|
||||
|
||||
// Returns if a tree is balanced
|
||||
public bool balance(ColoredTree t){
|
||||
visit(t){
|
||||
case black(a,b): if (cntBlack(a) == cntBlack(b)) true; else return false;
|
||||
case red(a,b): if (cntBlack(a) == cntBlack(b)) true; else return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
// Compute the sum of all integer leaves
|
||||
public int addLeaves(ColoredTree t){
|
||||
int c = 0;
|
||||
visit(t) {
|
||||
case leaf(int N): c += N;
|
||||
};
|
||||
return c;
|
||||
}
|
||||
|
||||
// Add green nodes to ColoredTree
|
||||
data ColoredTree = green(ColoredTree left, ColoredTree right);
|
||||
|
||||
// Transform red nodes into green nodes
|
||||
public ColoredTree makeGreen(ColoredTree t){
|
||||
return visit(t) {
|
||||
case red(l, r) => green(l, r)
|
||||
};
|
||||
}
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
rascal>/XX/i := "some xx";
|
||||
bool: true
|
||||
rascal>/a.c/ := "abc";
|
||||
bool: true
|
||||
43
Task/Algebraic-data-types/Rust/algebraic-data-types.rust
Normal file
43
Task/Algebraic-data-types/Rust/algebraic-data-types.rust
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
#![feature(box_patterns, box_syntax)]
|
||||
use self::Color::*;
|
||||
use std::cmp::Ordering::*;
|
||||
|
||||
enum Color {R,B}
|
||||
|
||||
type Link<T> = Option<Box<N<T>>>;
|
||||
struct N<T> {
|
||||
c: Color,
|
||||
l: Link<T>,
|
||||
val: T,
|
||||
r: Link<T>,
|
||||
}
|
||||
|
||||
|
||||
impl<T: Ord> N<T> {
|
||||
fn balance(col: Color, n1: Link<T>, z: T, n2: Link<T>) -> Link<T> {
|
||||
Some(box
|
||||
match (col,n1,n2) {
|
||||
(B, Some(box N {c: R, l: Some(box N {c: R, l: a, val: x, r: b}), val: y, r: c}), d)
|
||||
| (B, Some(box N {c: R, l: a, val: x, r: Some (box N {c: R, l: b, val: y, r: c})}), d)
|
||||
=> N {c: R, l: Some(box N {c: B, l: a, val: x, r: b}), val: y, r: Some(box N {c: B, l: c, val: z, r: d})},
|
||||
(B, a, Some(box N {c: R, l: Some(box N {c: R, l: b, val: y, r: c}), val: v, r: d}))
|
||||
| (B, a, Some(box N {c: R, l: b, val: y, r: Some(box N {c: R, l: c, val: v, r: d})}))
|
||||
=> N {c: R, l: Some(box N {c: B, l: a, val: z, r: b}), val: y, r: Some(box N {c: B, l: c, val: v, r: d})},
|
||||
(col, a, b) => N {c: col, l: a, val: z, r: b},
|
||||
})
|
||||
}
|
||||
fn insert(x: T, n: Link<T>) -> Link<T> {
|
||||
match n {
|
||||
None => Some(box N { c: R, l: None, val: x, r: None }),
|
||||
Some(n) => {
|
||||
let n = *n;
|
||||
let N {c: col, l: a, val: y, r: b} = n;
|
||||
match x.cmp(&y) {
|
||||
Greater => Self::balance(col, a,y,Self::insert(x,b)),
|
||||
Less => Self::balance(col, Self::insert(x,a),y,b),
|
||||
Equal => Some(box N {c: col, l: a, val: y, r: b})
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
33
Task/Algebraic-data-types/Scala/algebraic-data-types.scala
Normal file
33
Task/Algebraic-data-types/Scala/algebraic-data-types.scala
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
class RedBlackTree[A](implicit ord: Ordering[A]) {
|
||||
sealed abstract class Color
|
||||
case object R extends Color
|
||||
case object B extends Color
|
||||
|
||||
sealed abstract class Tree {
|
||||
def insert(x: A): Tree = ins(x) match {
|
||||
case T(_, a, y, b) => T(B, a, y, b)
|
||||
case E => E
|
||||
}
|
||||
def ins(x: A): Tree
|
||||
}
|
||||
|
||||
case object E extends Tree {
|
||||
override def ins(x: A): Tree = T(R, E, x, E)
|
||||
}
|
||||
|
||||
case class T(c: Color, left: Tree, a: A, right: Tree) extends Tree {
|
||||
private def balance: Tree = (c, left, a, right) match {
|
||||
case (B, T(R, T(R, a, x, b), y, c), z, d ) => T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
case (B, T(R, a, x, T(R, b, y, c)), z, d ) => T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
case (B, a, x, T(R, T(R, b, y, c), z, d )) => T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
case (B, a, x, T(R, b, y, T(R, c, z, d))) => T(R, T(B, a, x, b), y, T(B, c, z, d))
|
||||
case _ => this
|
||||
}
|
||||
|
||||
override def ins(x: A): Tree = ord.compare(x, a) match {
|
||||
case -1 => T(c, left ins x, a, right ).balance
|
||||
case 1 => T(c, left, a, right ins x).balance
|
||||
case 0 => this
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
datatype color = R | B
|
||||
datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
|
||||
|
||||
(** val balance = fn : color * 'a tree * 'a * 'a tree -> 'a tree *)
|
||||
fun balance (B, T (R, T (R,a,x,b), y, c), z, d) = T (R, T (B,a,x,b), y, T (B,c,z,d))
|
||||
| balance (B, T (R, a, x, T (R,b,y,c)), z, d) = T (R, T (B,a,x,b), y, T (B,c,z,d))
|
||||
| balance (B, a, x, T (R, T (R,b,y,c), z, d)) = T (R, T (B,a,x,b), y, T (B,c,z,d))
|
||||
| balance (B, a, x, T (R, b, y, T (R,c,z,d))) = T (R, T (B,a,x,b), y, T (B,c,z,d))
|
||||
| balance (col, a, x, b) = T (col, a, x, b)
|
||||
|
||||
(** val insert = fn : int -> int tree -> int tree *)
|
||||
fun insert x s = let
|
||||
fun ins E = T (R,E,x,E)
|
||||
| ins (s as T (col,a,y,b)) =
|
||||
if x < y then
|
||||
balance (col, ins a, y, b)
|
||||
else if x > y then
|
||||
balance (col, a, y, ins b)
|
||||
else
|
||||
s
|
||||
val T (_,a,y,b) = ins s
|
||||
in
|
||||
T (B,a,y,b)
|
||||
end
|
||||
37
Task/Algebraic-data-types/Swift/algebraic-data-types.swift
Normal file
37
Task/Algebraic-data-types/Swift/algebraic-data-types.swift
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
enum Color { case R, B }
|
||||
enum Tree<A> {
|
||||
case E
|
||||
indirect case T(Color, Tree<A>, A, Tree<A>)
|
||||
}
|
||||
|
||||
func balance<A>(input: (Color, Tree<A>, A, Tree<A>)) -> Tree<A> {
|
||||
switch input {
|
||||
case let (.B, .T(.R, .T(.R,a,x,b), y, c), z, d): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
|
||||
case let (.B, .T(.R, a, x, .T(.R,b,y,c)), z, d): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
|
||||
case let (.B, a, x, .T(.R, .T(.R,b,y,c), z, d)): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
|
||||
case let (.B, a, x, .T(.R, b, y, .T(.R,c,z,d))): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
|
||||
case let (col, a, x, b) : return .T(col, a, x, b)
|
||||
}
|
||||
}
|
||||
|
||||
func insert<A : Comparable>(x: A, s: Tree<A>) -> Tree<A> {
|
||||
func ins(s: Tree<A>) -> Tree<A> {
|
||||
switch s {
|
||||
case .E : return .T(.R,.E,x,.E)
|
||||
case let .T(col,a,y,b):
|
||||
if x < y {
|
||||
return balance((col, ins(a), y, b))
|
||||
} else if x > y {
|
||||
return balance((col, a, y, ins(b)))
|
||||
} else {
|
||||
return s
|
||||
}
|
||||
}
|
||||
}
|
||||
switch ins(s) {
|
||||
case let .T(_,a,y,b): return .T(.B,a,y,b)
|
||||
case .E:
|
||||
assert(false)
|
||||
return .E
|
||||
}
|
||||
}
|
||||
5
Task/Algebraic-data-types/TXR/algebraic-data-types-1.txr
Normal file
5
Task/Algebraic-data-types/TXR/algebraic-data-types-1.txr
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(defstruct (rbnode color left right data) ()
|
||||
color
|
||||
left
|
||||
right
|
||||
data)
|
||||
1
Task/Algebraic-data-types/TXR/algebraic-data-types-2.txr
Normal file
1
Task/Algebraic-data-types/TXR/algebraic-data-types-2.txr
Normal file
|
|
@ -0,0 +1 @@
|
|||
@(struct time year @y month @m)
|
||||
13
Task/Algebraic-data-types/TXR/algebraic-data-types-3.txr
Normal file
13
Task/Algebraic-data-types/TXR/algebraic-data-types-3.txr
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
(defmatch rb (color left right data)
|
||||
(flet ((var? (sym) (if (bindable sym) ^@,sym sym)))
|
||||
^@(struct rbnode
|
||||
color ,(var? color)
|
||||
left ,(var? left)
|
||||
right ,(var? right)
|
||||
data ,(var? data))))
|
||||
|
||||
(defmatch red (left right data)
|
||||
^@(rb :red ,left ,right ,data))
|
||||
|
||||
(defmatch black (left right data)
|
||||
^@(rb :black ,left ,right ,data))
|
||||
27
Task/Algebraic-data-types/TXR/algebraic-data-types-4.txr
Normal file
27
Task/Algebraic-data-types/TXR/algebraic-data-types-4.txr
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
(defun-match rb-balance
|
||||
((@(or @(black @(red @(red a b x) c y) d z)
|
||||
@(black @(red a @(red b c x) x) d z)
|
||||
@(black a @(red @(red b c y) d z) x)
|
||||
@(black a @(red b @(red c d z) y) x)))
|
||||
(new (rbnode :red
|
||||
(new (rbnode :black a b x))
|
||||
(new (rbnode :black c d z))
|
||||
y)))
|
||||
((@else) else))
|
||||
|
||||
(defun rb-insert-rec (tree x)
|
||||
(match-ecase tree
|
||||
(nil
|
||||
(new (rbnode :red nil nil x)))
|
||||
(@(rb color a b y)
|
||||
(cond
|
||||
((< x y)
|
||||
(rb-balance (new (rbnode color (rb-insert-rec a) b y))))
|
||||
((> x y)
|
||||
(rb-balance (new (rbnode color a (rb-insert-rec b) y))))
|
||||
(t tree)))))
|
||||
|
||||
(defun rb-insert (tree x)
|
||||
(match-case (rb-insert-rec tree x)
|
||||
(@(red a b y) (new (rbnode :black a b y)))
|
||||
(@else else)))
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
processor RedBlackTree
|
||||
data node <{VOID}|{colour: <='black'|='red'>, left: <node>, right: <node>, value: <> VOID}> local
|
||||
@: {};
|
||||
sink insert
|
||||
templates balance
|
||||
when <{colour: <='black'>, left: <{ colour: <='red'> left: <{colour: <='red'>}>}>}>
|
||||
do { colour: 'red',
|
||||
left: { $.left.left..., colour: 'black'},
|
||||
value: $.left.value,
|
||||
right: { $..., left: $.left.right }} !
|
||||
when <{colour: <='black'>, left: <{ colour: <='red'> right: <{colour: <='red'>}>}>}>
|
||||
do { colour: 'red',
|
||||
left: { $.left..., colour: 'black', right: $.left.right.left},
|
||||
value: $.left.right.value,
|
||||
right: { $..., left: $.left.right.right }} !
|
||||
when <{colour: <='black'>, right: <{ colour: <='red'> left: <{colour: <='red'>}>}>}>
|
||||
do { colour: 'red',
|
||||
left: { $..., right: $.right.left.left},
|
||||
value: $.right.left.value,
|
||||
right: { $.right..., colour: 'black', left: $.right.left.right }} !
|
||||
when <{colour: <='black'>, right: <{ colour: <='red'> right: <{colour: <='red'>}>}>}>
|
||||
do { colour: 'red',
|
||||
left: { $..., right: $.right.left},
|
||||
value: $.right.value,
|
||||
right: { $.right.right..., colour: 'black' }} !
|
||||
otherwise $ !
|
||||
end balance
|
||||
templates ins&{into:}
|
||||
when <?($into <´node´ ={}>)> do { colour: 'red', left: {}, value: $, right: {}} !
|
||||
when <..$into.value::raw> do { $into..., left: $ -> ins&{into: $into.left}} -> balance !
|
||||
otherwise { $into..., right: $ -> ins&{into: $into.right}} -> balance !
|
||||
end ins
|
||||
@RedBlackTree: { $ -> ins&{into: $@RedBlackTree} ..., colour: 'black'};
|
||||
end insert
|
||||
source toString
|
||||
'$@RedBlackTree;' !
|
||||
end toString
|
||||
end RedBlackTree
|
||||
|
||||
def tree: $RedBlackTree;
|
||||
1..5 -> \('$tree::toString;$#10;' -> !OUT::write $ -> !tree::insert \) -> !VOID
|
||||
$tree::toString -> !OUT::write
|
||||
70
Task/Algebraic-data-types/Tcl/algebraic-data-types-1.tcl
Normal file
70
Task/Algebraic-data-types/Tcl/algebraic-data-types-1.tcl
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
# From http://wiki.tcl.tk/9547
|
||||
package require Tcl 8.5
|
||||
package provide datatype 0.1
|
||||
|
||||
namespace eval ::datatype {
|
||||
namespace export define match matches
|
||||
namespace ensemble create
|
||||
|
||||
# Datatype definitions
|
||||
proc define {type = args} {
|
||||
set ns [uplevel 1 { namespace current }]
|
||||
foreach cons [split [join $args] |] {
|
||||
set name [lindex $cons 0]
|
||||
set args [lrange $cons 1 end]
|
||||
proc $ns\::$name $args [format {
|
||||
lreplace [info level 0] 0 0 %s
|
||||
} [list $name]]
|
||||
}
|
||||
return $type
|
||||
}
|
||||
|
||||
# Pattern matching
|
||||
# matches pattern value envVar --
|
||||
# Returns 1 if value matches pattern, else 0
|
||||
# Binds match variables in envVar
|
||||
proc matches {pattern value envVar} {
|
||||
upvar 1 $envVar env
|
||||
if {[var? $pattern]} { return [bind env $pattern $value] }
|
||||
if {[llength $pattern] != [llength $value]} { return 0 }
|
||||
if {[lindex $pattern 0] ne [lindex $value 0]} { return 0 }
|
||||
foreach pat [lrange $pattern 1 end] val [lrange $value 1 end] {
|
||||
if {![matches $pat $val env]} { return 0 }
|
||||
}
|
||||
return 1
|
||||
}
|
||||
# A variable starts with lower-case letter or _. _ is a wildcard.
|
||||
proc var? term { string match {[a-z_]*} $term }
|
||||
proc bind {envVar var value} {
|
||||
upvar 1 $envVar env
|
||||
if {![info exists env]} { set env [dict create] }
|
||||
if {$var eq "_"} { return 1 }
|
||||
dict set env $var $value
|
||||
return 1
|
||||
}
|
||||
proc match args {
|
||||
#puts "MATCH: $args"
|
||||
set values [lrange $args 0 end-1]
|
||||
set choices [lindex $args end]
|
||||
append choices \n [list return -code error -level 2 "no match for $values"]
|
||||
set f [list values $choices [namespace current]]
|
||||
lassign [apply $f $values] env body
|
||||
#puts "RESULT: $env -> $body"
|
||||
dict for {k v} $env { upvar 1 $k var; set var $v }
|
||||
catch { uplevel 1 $body } msg opts
|
||||
dict incr opts -level
|
||||
return -options $opts $msg
|
||||
}
|
||||
proc case args {
|
||||
upvar 1 values values
|
||||
set patterns [lrange $args 0 end-2]
|
||||
set body [lindex $args end]
|
||||
set env [dict create]
|
||||
if {[llength $patterns] != [llength $values]} { return }
|
||||
foreach pattern $patterns value $values {
|
||||
if {![matches $pattern $value env]} { return }
|
||||
}
|
||||
return -code return [list $env $body]
|
||||
}
|
||||
proc default body { return -code return [list {} $body] }
|
||||
}
|
||||
30
Task/Algebraic-data-types/Tcl/algebraic-data-types-2.tcl
Normal file
30
Task/Algebraic-data-types/Tcl/algebraic-data-types-2.tcl
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
datatype define Color = R | B
|
||||
datatype define Tree = E | T color left val right
|
||||
|
||||
# balance :: Color -> Tree a -> a -> Tree a -> Tree a
|
||||
proc balance {color left val right} {
|
||||
datatype match $color $left $val $right {
|
||||
case B [T R [T R a x b] y c] z d -> { T R [T B $a $x $b] $y [T B $c $z $d] }
|
||||
case B [T R a x [T R b y c]] z d -> { T R [T B $a $x $b] $y [T B $c $z $d] }
|
||||
case B a x [T R [T R b y c] z d] -> { T R [T B $a $x $b] $y [T B $c $z $d] }
|
||||
case B a x [T R b y [T R c z d]] -> { T R [T B $a $x $b] $y [T B $c $z $d] }
|
||||
case col a x b -> { T $col $a $x $b }
|
||||
}
|
||||
}
|
||||
# insert :: Ord a => a -> Tree a -> Tree a
|
||||
proc insert {x s} {
|
||||
datatype match [ins $x $s] {
|
||||
case [T _ a y b] -> { T B $a $y $b }
|
||||
}
|
||||
}
|
||||
# ins :: Ord a => a -> Tree a -> Tree a
|
||||
proc ins {x s} {
|
||||
datatype match $s {
|
||||
case E -> { T R E $x E }
|
||||
case [T col a y b] -> {
|
||||
if {$x < $y} { return [balance $col [ins $x $a] $y $b] }
|
||||
if {$x > $y} { return [balance $col $a $y [ins $x $b]] }
|
||||
return $s
|
||||
}
|
||||
}
|
||||
}
|
||||
84
Task/Algebraic-data-types/Wren/algebraic-data-types.wren
Normal file
84
Task/Algebraic-data-types/Wren/algebraic-data-types.wren
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
var R = "R"
|
||||
var B = "B"
|
||||
|
||||
class Tree {
|
||||
ins(x) {} // overridden by child classes
|
||||
|
||||
insert(x) { // inherited by child classes
|
||||
var t = ins(x)
|
||||
if (t.type == T) return T.new(B, t.le, t.aa, t.ri)
|
||||
if (t.type == E) return E.new()
|
||||
return null
|
||||
}
|
||||
}
|
||||
|
||||
class T is Tree {
|
||||
construct new(cl, le, aa, ri) {
|
||||
_cl = cl // color
|
||||
_le = le // Tree
|
||||
_aa = aa // integer
|
||||
_ri = ri // Tree
|
||||
}
|
||||
|
||||
cl { _cl }
|
||||
le { _le }
|
||||
aa { _aa }
|
||||
ri { _ri }
|
||||
|
||||
balance() {
|
||||
if (_cl != B) return this
|
||||
|
||||
var le2 = _le.type == T ? _le : null
|
||||
var lele
|
||||
var leri
|
||||
if (le2) {
|
||||
lele = _le.le.type == T ? _le.le : null
|
||||
leri = _le.ri.type == T ? _le.ri : null
|
||||
}
|
||||
var ri2 = _ri.type == T ? _ri : null
|
||||
var rile
|
||||
var riri
|
||||
if (ri2) {
|
||||
rile = _ri.le.type == T ? _ri.le : null
|
||||
riri = _ri.ri.type == T ? _ri.ri : null
|
||||
}
|
||||
|
||||
if (le2 && lele && le2.cl == R && lele.cl == R) {
|
||||
var t = le2.le
|
||||
return T.new(R, T.new(B, t.le, t.aa, t.ri), le2.aa, T.new(B, le2.ri, _aa, _ri))
|
||||
}
|
||||
if (le2 && leri && le2.cl == R && leri.cl == R) {
|
||||
var t = le2.ri
|
||||
return T.new(R, T.new(B, le2.le, le2.aa, t.le), t.aa, T.new(B, t.ri, _aa, _ri))
|
||||
}
|
||||
if (ri2 && rile && ri2.cl == R && rile.cl == R) {
|
||||
var t = ri2.ri
|
||||
return T.new(R, T.new(B, _le, _aa, t.le), t.aa, T.new(B, t.ri, ri2.aa, ri2.ri))
|
||||
}
|
||||
if (ri2 && riri && ri2.cl == R && riri.cl == R) {
|
||||
var t = ri2.ri
|
||||
return T.new(R, T.new(B, _le, _aa, ri2.le), ri2.aa, T.new(B, t.le, t.aa, t.ri))
|
||||
}
|
||||
return this
|
||||
}
|
||||
|
||||
ins(x) {
|
||||
if (x < _aa) return T.new(_cl, _le.ins(x), _aa, _ri).balance()
|
||||
if (x > _aa) return T.new(_cl, _le, _aa, _ri.ins(x)).balance()
|
||||
return this
|
||||
}
|
||||
|
||||
toString { "T(%(_cl), %(_le), %(_aa), %(_ri))" }
|
||||
}
|
||||
|
||||
class E is Tree {
|
||||
construct new() {}
|
||||
|
||||
ins(x) { T.new(R, E.new(), x, E.new()) }
|
||||
|
||||
toString { "E" }
|
||||
}
|
||||
|
||||
var tr = E.new()
|
||||
for (i in 1..16) tr = tr.insert(i)
|
||||
System.print(tr)
|
||||
Loading…
Add table
Add a link
Reference in a new issue