From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001
From: Franciszek Malinka <franciszek.malinka@gmail.com>
Date: Thu, 25 Feb 2021 14:42:55 +0100
Subject: Stare semestry, niepoukladane

---
 Semestr 2/racket/leftist.rkt | 105 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 105 insertions(+)
 create mode 100644 Semestr 2/racket/leftist.rkt

(limited to 'Semestr 2/racket/leftist.rkt')

diff --git a/Semestr 2/racket/leftist.rkt b/Semestr 2/racket/leftist.rkt
new file mode 100644
index 0000000..78319e4
--- /dev/null
+++ b/Semestr 2/racket/leftist.rkt	
@@ -0,0 +1,105 @@
+#lang racket
+
+(provide make-elem elem-priority elem-val empty-heap heap-insert heap-merge heap-min heap-pop heap-empty?)
+
+(define (inc n)
+  (+ n 1))
+
+;;; tagged lists
+(define (tagged-list? len-xs tag xs)
+  (and (list? xs)
+       (= len-xs (length xs))
+       (eq? (first xs) tag)))
+
+;;; ordered elements
+(define (make-elem pri val)
+  (cons pri val))
+
+(define (elem-priority x)
+  (car x))
+
+(define (elem-val x)
+  (cdr x))
+
+;;; leftist heaps (after Okasaki)
+
+;; data representation
+(define leaf 'leaf)
+
+(define (leaf? h) (eq? 'leaf h))
+
+(define (hnode? h)
+  (and (tagged-list? 5 'hnode h)
+       (natural? (caddr h))))
+
+(define (make-hnode elem heap-a heap-b)
+  (if (< (rank heap-a) (rank heap-b))
+      (list 'hnode elem (+ (rank heap-a) 1) heap-b heap-a)
+      (list 'hnode elem (+ (rank heap-b) 1) heap-a heap-b)))
+
+(define (hnode-elem h)
+  (second h))
+
+(define (hnode-left h)
+  (fourth h))
+
+(define (hnode-right h)
+  (fifth h))
+
+(define (hnode-rank h)
+  (third h))
+
+(define (hord? p h)
+  (or (leaf? h)
+      (<= p (elem-priority (hnode-elem h)))))
+
+(define (heap? h)
+  (or (leaf? h)
+      (and (hnode? h)
+           (heap? (hnode-left h))
+           (heap? (hnode-right h))
+           (<= (rank (hnode-right h))
+               (rank (hnode-left h)))
+           (= (rank h) (inc (rank (hnode-right h))))
+           (hord? (elem-priority (hnode-elem h))
+                  (hnode-left h))
+           (hord? (elem-priority (hnode-elem h))
+                  (hnode-right h)))))
+
+(define (rank h)
+  (if (leaf? h)
+      0
+      (hnode-rank h)))
+
+;; operations
+
+(define empty-heap leaf)
+
+(define (heap-empty? h)
+  (leaf? h))
+
+(define (heap-insert elt heap)
+  (heap-merge heap (make-hnode elt leaf leaf)))
+
+(define (heap-min heap)
+  (hnode-elem heap))
+
+(define (heap-pop heap)
+  (heap-merge (hnode-left heap) (hnode-right heap)))
+
+(define (heap-merge h1 h2)
+  (cond
+   [(leaf? h1) h2]
+   [(leaf? h2) h1]
+   [else (let ((h1-min (heap-min h1))
+                (h2-min (heap-min h2)))
+            (if (< (elem-priority h1-min) (elem-priority h2-min))
+                (make-hnode h1-min (heap-merge (hnode-left h1) (hnode-right h1)) h2)
+                (make-hnode h2-min h1 (heap-merge (hnode-left h2) (hnode-right h2)))))]))
+
+;;; check that a list is sorted (useful for longish lists)
+(define (sorted? xs)
+  (cond [(null? xs)              true]
+        [(null? (cdr xs))        true]
+        [(<= (car xs) (cadr xs)) (sorted? (cdr xs))]
+        [else                    false]))
-- 
cgit v1.2.3