Полезные комбинаторы

Солкин Кирилл/README.md

@@ -0,0 +1,19 @@
+# Полезные комбинаторы
+## Код из книги
+    #let mem x l = exists (fun y -> y = x) l;;
+    mem : ’a -> ’a list -> bool = <fun>
+    #let insert x l =
+    if mem x l then l else x::l;;
+    insert : ’a -> ’a list -> ’a list = <fun>
+    #let union l1 l2 = itlist insert l1 l2;;
+    union : ’a list -> ’a list -> ’a list = <fun>
+    #let setify l = union l [];;
+    setify : ’a list -> ’a list = <fun>
+    #let Union l = itlist union l [];;
+    Union : ’a list list -> ’a list = <fun>
+    #let intersect l1 l2 = filter (fun x -> mem x l2) l1;;
+    intersect : ’a list -> ’a list -> ’a list = <fun>
+    #let subtract l1 l2 = filter (fun x -> not mem x l2) l1;;
+    subtract : ’a list -> ’a list -> ’a list = <fun>
+    #let subset l1 l2 = forall (fun t -> mem t l2) l1;;
+    subset : ’a list -> ’a list -> bool = <fun>

Солкин Кирилл/polezn_komb.rkt

@@ -0,0 +1,83 @@
+#lang racket
+(define (itlist f lst b)
+  (if (null? lst)
+       b
+      (f (car lst) (itlist f (list-tail lst 1) b))))
+
+(define (sum lst)
+  (itlist + lst 0))
+
+(define (prod lst)
+  (itlist * lst 1))
+
+(define (mid p)
+  (lambda (x s)
+    (if (p x)
+        (cons x s)
+        s)))
+
+(define (filter p lst)
+  (itlist (mid p) lst '()))
+
+(define (andt l b)
+  (and l b))
+
+(define (ort l b)
+  (or l b))
+
+(define (forall p lst)
+  (define a true)
+  (itlist andt (map p lst) a))
+
+(define (exists p lst)
+  (define a false)
+  (itlist ort (map p lst) a))
+
+(define (tem l b)
+  (+ b 1))
+
+(define (length lst)
+  (itlist tem lst 0))
+
+(define (append l m)
+  (itlist cons l m))
+
+(define (const f)
+  (lambda (x y) (cons (f x) y)))
+
+(define (map f l)
+  (define s '())
+  (define con (const f))
+  (itlist con l s))
+
+(define (mem x lst)
+  (exists (lambda (y) (= y x)) lst))
+
+(define (insert x lst)
+  (if (mem x lst)
+      lst
+      (cons x lst)))
+
+(define (union l1 l2)
+  (itlist insert l1 l2))
+
+(define (setify lst)
+  (union lst '()))
+
+(define (Union lst)
+  (itlist union lst '()))
+
+(define (notc l2)
+  (lambda (x) (mem x l2)))
+
+(define (nonotc l2)
+  (lambda (x) (not (mem x l2))))
+
+(define (intersect l1 l2)
+  (filter (notc l2) l1))
+
+(define (subtract l1 l2)
+  (filter (nonotc l2) l1))
+
+(define (subset l1 l2)
+  (forall (lambda (t) (mem t l2)) l1))