From 5254a0befde355fca2711033f77047cf0bb5c08f Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Mon, 27 Mar 2023 21:58:09 +0200 Subject: moar --- coding-exercises/2/59.rkt | 5 +++ coding-exercises/2/60.rkt | 10 +++-- coding-exercises/2/61.rkt | 2 +- coding-exercises/2/62.rkt | 3 +- coding-exercises/2/63.rkt | 37 ++++++++-------- coding-exercises/2/64.rkt | 1 - coding-exercises/2/65.rkt | 65 ++++++++++++++++++++++++++++ coding-exercises/2/66.rkt | 52 ++++++++++++++++++++++ coding-exercises/2/67.rkt | 105 ++++++++++++++++++++++++++++++++++++++++++++ shared/sets.rkt | 108 ++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 363 insertions(+), 25 deletions(-) create mode 100644 coding-exercises/2/65.rkt create mode 100644 coding-exercises/2/66.rkt create mode 100644 coding-exercises/2/67.rkt create mode 100644 shared/sets.rkt diff --git a/coding-exercises/2/59.rkt b/coding-exercises/2/59.rkt index e5f3289..b9193bd 100644 --- a/coding-exercises/2/59.rkt +++ b/coding-exercises/2/59.rkt @@ -1,15 +1,19 @@ #lang racket ;; unordered distinct list + +;; linear scan of the elements O(n) (define (element-of-set? x myset) (cond ((null? myset) false) ((equal? x (car myset)) true) (else (element-of-set? x (cdr myset))))) +;; O(n) (define (adjoin-set x myset) (if (element-of-set? x myset) myset (cons x myset))) +;; linear scan of set1 and at each step we scan set2, O(n**2) (define (intersection-set set1 set2) (cond ((or (null? set1) (null? set2)) '()) ((element-of-set? (car set1) set2) @@ -18,6 +22,7 @@ (else (intersection-set (cdr set1) set2)))) (intersection-set (list 1 2 3) (list 'a 2 'c)) +;; linear scan of set1 and at each step we scan set2, O(n**2) (define (union-set set1 set2) (cond ((null? set1) set2) ((null? set2) set1) diff --git a/coding-exercises/2/60.rkt b/coding-exercises/2/60.rkt index 3effe1c..fba2086 100644 --- a/coding-exercises/2/60.rkt +++ b/coding-exercises/2/60.rkt @@ -1,20 +1,24 @@ #lang racket ;; unordered duplicates list -;; can be use if adjoin needs to be fast O(1) -;; append is linear so union is O(n) -;; Tried to make intersection better for case with lot of duplicates and large n + +;; linear scan of elements O(n) (define (element-of-set? x myset) (cond ((null? myset) false) ((equal? x (car myset)) true) (else (element-of-set? x (cdr myset))))) +;; can be use if adjoin needs to be fast O(1) (define (adjoin-set x myset) (cons x myset)) +;; append is linear so union is O(n) (define (union-set set1 set2) (append set1 set2)) (union-set (list 1 1 1 1 1 1 1 2 3) (list 2 2 2 2 2 3 'c)) +;; Tried to make intersection better for case with lot of duplicates and large n by short circuiting before the linear scan overhead +;; , but it will still have O(n**2) worst case performance +;; not sure about average case (define (intersection-set set1 set2) (define (iter s1 s2 result) (cond ((or (null? s1) (null? s2)) result) diff --git a/coding-exercises/2/61.rkt b/coding-exercises/2/61.rkt index 71d773d..ed99294 100644 --- a/coding-exercises/2/61.rkt +++ b/coding-exercises/2/61.rkt @@ -6,7 +6,7 @@ (cond ((null? myset) (cons x '())) ((= (car myset) x) myset) ((> (car myset) x) (cons x myset)) - (else (cons (car myset) + (else (cons (car myset) (adjoin-set x (cdr myset)))))) (define test-set (list 1 2 3 4 5 7)) diff --git a/coding-exercises/2/62.rkt b/coding-exercises/2/62.rkt index 705dcbd..a1be49e 100644 --- a/coding-exercises/2/62.rkt +++ b/coding-exercises/2/62.rkt @@ -1,6 +1,8 @@ #lang racket ;; In each branch of the problem we either terminate the process or we reduce the problem to a subproblem with set - (car set) +;; O(n) +;; need to iterate like this to prevent duplicates? (define (union-set set1 set2) (cond ((and (null? set1) (null? set2)) '()) ((null? set1) (cons (car set2) (union-set set1 (cdr set2)))) @@ -12,4 +14,3 @@ (define test-list (list 1 2)) (define test-list2 (list 4 5 6 7)) (union-set test-list test-list2) - diff --git a/coding-exercises/2/63.rkt b/coding-exercises/2/63.rkt index 6a8fd88..7b99c77 100644 --- a/coding-exercises/2/63.rkt +++ b/coding-exercises/2/63.rkt @@ -13,7 +13,7 @@ (element-of-set? (right-branch mset))) ((< x (entry mset)) (element-of-set? (left-branch mset))))) - + (define (adjoin-set x mset) (cond ((null? mset) (make-tree x '() '())) ((= x (entry mset)) mset) @@ -44,37 +44,36 @@ (copy-to-list (right-branch tree) result-list))))) (copy-to-list tree '())) - ;; depth of a balanced tree with n elements is log n.. right? Because every level you need 2*(level-1) elements, so the total levels is how many time we can do that step until 2*levels > n. ;; So it is the log a where a is the smallest number that only has factor 2 and > n. -;; Both procedure 1 and 2 are levelwise reducing the problem. +;; EDIT this is incomplete. Since the recursive call is done multiple times we get a geometric series with base 2 that describes the number of units of work done. +;; It can be shown that this is O(2n) asymptotically by using the identity for powerseries. +;; Both procedure 1 and 2 are reducing the problem the same way using tree recursion. ;; Only the overhead spent at each level is greater for 1, because append is used in the linear recursive process. -;; Since at every level we do a linear scan of all left elements, it is n*logn. -;; 1 is a linear iterative procedure and has almost no overhead at every level except a cons operation so it is logn. +;; Since at every level we do a linear scan of all left elements, it is a*n*n on average. Where a is a factor that corrects for the fact that we have to scan halve at each depth. +;; 1 is a linear iterative procedure and has almost no overhead at every level except a cons operation so it is O(n) on average. ((lambda () - (define test216a (make-entry + (define test216a (make-entry 7 - (make-entry - 3 - (make-entry - 1 '() '()) - (make-entry 5 '() '())) - + (make-entry) + 9 (make-entry - 9 - '() + 3 + (make-entry + 1 '() '()) + (make-entry 5 '() '() (make-entry 11 '() - '())))) + '()))))) (println (tree->list-1 test216a)) (println (tree->list-2 test216a)) (newline) - (define test216b (make-entry + (define test216b (make-entry 3 (make-entry 1 '() '()) - (make-entry + (make-entry 7 (make-entry 5 '() '()) (make-entry @@ -87,10 +86,10 @@ (println (tree->list-1 test216b)) (println (tree->list-2 test216b)) (newline) - (define test216c (make-entry + (define test216c (make-entry 5 (make-entry 3 (make-entry 1 '() '()) '()) - (make-entry + (make-entry 9 (make-entry 7 '() '()) (make-entry diff --git a/coding-exercises/2/64.rkt b/coding-exercises/2/64.rkt index 90994e8..bee12ab 100644 --- a/coding-exercises/2/64.rkt +++ b/coding-exercises/2/64.rkt @@ -10,7 +10,6 @@ (let ((left-tree (car left-result)) (non-left-elts (cdr left-result)) (right-size (- n (+ left-size 1)))) - (let ((this-entry (car non-left-elts)) (right-result (partial-tree (cdr non-left-elts) right-size))) diff --git a/coding-exercises/2/65.rkt b/coding-exercises/2/65.rkt new file mode 100644 index 0000000..ca26639 --- /dev/null +++ b/coding-exercises/2/65.rkt @@ -0,0 +1,65 @@ +#lang racket +(require "../../shared/sets.rkt") + +;; 2*O(n) + O(n) + O(n) +(define (union-set s1 s2) + (define (ordered-list-union-set set1 set2) + (cond + ((and (null? set1) (null? set2)) '()) + ((null? set1) (cons (car set2) (ordered-list-union-set set1 (cdr set2)))) + ((null? set2) (cons (car set1) (ordered-list-union-set (cdr set1) set2))) + ((= (car set1) (car set2)) (cons (car set2) (ordered-list-union-set (cdr set1) (cdr set2)))) + ((> (car set1) (car set2)) (cons (car set2) (ordered-list-union-set set1 (cdr set2)))) + ((< (car set1) (car set2)) (cons (car set1) (ordered-list-union-set (cdr set1) set2))))) + (list->tree + (ordered-list-union-set (tree->list s1) (tree->list s2)))) + +;; 2*O(n) + O(n) + O(n) +(define (intersection-set set1 set2) + (define (ordered-list-intersection-set s1 s2) + (if (or (null? s1) (null? s2)) + '() + (let ((x1 (car s1)) (x2 (car s2))) + (cond ((= x1 x2) + (cons x1 + (ordered-list-intersection-set + (cdr s1) + (cdr s2)))) + ((< x1 x2) + (ordered-list-intersection-set + (cdr s1) + s2)) + ((> x1 x2) + (ordered-list-intersection-set + s1 + (cdr s2))))))) + (list->tree + (ordered-list-intersection-set + (tree->list set1) (tree->list set2)))) + +((lambda () + (println "tree -- UNION") + (define test216a (make-entry + 7 + '() + '())) + (define test216b (make-entry + 4 + (make-entry 1 '() '()) + (make-entry + 8 + (make-entry 6 '() '()) + (make-entry + 10 + '() + (make-entry + 12 + '() + '()))))) + (println (union-set + (list->tree (tree->list test216a)) + (list->tree (tree->list test216b)))) + (println (intersection-set + (list->tree (tree->list test216a)) + (list->tree (tree->list test216b)))) + (newline))) diff --git a/coding-exercises/2/66.rkt b/coding-exercises/2/66.rkt new file mode 100644 index 0000000..7cfedb8 --- /dev/null +++ b/coding-exercises/2/66.rkt @@ -0,0 +1,52 @@ +#lang racket +(require "../../shared/sets.rkt") + +;; just use id as key +(define (key x) + (if (number? x) + x + (error "Only supports numericals that we can compare with >, <, = -- KEY"))) + +(define (list-lookup given-key set-of-records) + (cond ((null? set-of-records) false) + ((equal? given-key (key (car set-of-records))) + (car set-of-records)) + (else (list-lookup given-key (cdr set-of-records))))) + +(define (lookup given-key set-of-records) + (if (null? set-of-records) + false + (let ((v (key (car set-of-records)))) + (cond ((= given-key v) v) + ((< given-key v) + (lookup given-key (left-branch set-of-records))) + ((> given-key v) + (lookup given-key (right-branch set-of-records))))))) + +((lambda () + (println "list -- LOOKUP") + (println (list-lookup 5 (list 1 2 3 4 5))) + (newline) + (println "tree -- UNION") + (define test216a (make-entry + 7 + '() + '())) + (define test216b (make-entry + 4 + (make-entry 1 '() '()) + (make-entry + 8 + (make-entry 6 '() '()) + (make-entry + 10 + '() + (make-entry + 12 + '() + '()))))) + (println (lookup 10 + (union-set + (list->tree (tree->list test216a)) + (list->tree (tree->list test216b))))) + (newline))) diff --git a/coding-exercises/2/67.rkt b/coding-exercises/2/67.rkt new file mode 100644 index 0000000..d6021b1 --- /dev/null +++ b/coding-exercises/2/67.rkt @@ -0,0 +1,105 @@ +#lang racket +(require "../../shared/lists.rkt") +(define (make-leaf symbol weight) + (list 'leaf symbol weight)) + +(define (leaf? object) + (eq? (car object) 'leaf)) + +(define (symbol-leaf x) + (cadr x)) + +(define (weight-leaf x) + (caddr x)) + +(define (make-code-tree left right) + (list + left + right + (append (symbol-set left) + (symbol-set right)) + (+ (weight left) + (weight right)))) + +(define (left-branch tree) + (car tree)) + +(define (right-branch tree) + (cadr tree)) + +(define (symbol-set tree) + (if (leaf? tree) + (list (symbol-leaf tree)) + (caddr tree))) + +(define (weight tree) + (if (leaf? tree) + (weight-leaf tree) + (cadddr tree))) + +(define (decode bits tree) + (define (decode-1 bits current-branch) + (if (null? bits) + '() + (let ((next-branch + (choose-branch (car bits) current-branch))) + (if (leaf? next-branch) + (cons (symbol-leaf next-branch) + (decode-1 (cdr bits) tree)) + (decode-1 (cdr bits) next-branch))))) + (decode-1 bits tree)) + +(define (choose-branch bit branch) + (cond ((= bit 0) (left-branch branch)) + ((= bit 1) (right-branch branch)) + (else (error "bad bit -- CHOOSE-BRANCH" bit)))) + +(define (adjoin-set x mset) + (cond ((null? mset) (list x)) + ((< (weight x) (weight (car mset)) + (cons x mset))) + (else (cons (car mset) + (adjoin-set x (cdr mset)))))) + +(define (make-leaf-set pairs) + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) + (cadr pair)) + (make-leaf-set (cdr pairs)))))) + +;; 67 +(define sample-tree + (make-code-tree (make-leaf 'A 4) + (make-code-tree + (make-leaf 'B 2) + (make-code-tree + (make-leaf 'D 1) + (make-leaf 'C 1))))) +(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0)) +(decode sample-message sample-tree) +;; '(A D A B B C A) + +;; 68 +(define (encode message tree) + (if (null? message) + '() + (append (encode-symbol (car message) tree) + (encode (cdr message) tree)))) + +(define (encode-symbol s tree) + (define (bits result subtree) + (cond ((and (leaf? subtree) + (equal? s (car (symbol-set subtree)))) + result) + ((leaf? subtree) '()) + (else + (let ((left (bits + (cons 0 result) + (left-branch subtree)))) + (if (null? left) + (bits (cons 1 result) (right-branch subtree)) + left))))) + (reverse (bits '() tree))) +(encode (decode sample-message sample-tree) sample-tree) diff --git a/shared/sets.rkt b/shared/sets.rkt new file mode 100644 index 0000000..e20ba7f --- /dev/null +++ b/shared/sets.rkt @@ -0,0 +1,108 @@ +#lang racket +;; implements convential interfaces on sets represented as binary trees +(provide + entry + left-branch + right-branch + make-entry + element-of-set? + adjoin-set + tree->list + list->tree + union-set + intersection-set) + +(define (entry tree) (car tree)) +(define (left-branch tree) (cadr tree)) +(define (right-branch tree) (caddr tree)) +(define (make-entry entry left right) + (list entry left right)) + +(define (element-of-set? x mset) + (cond ((null? mset) false) + ((= x (entry mset)) true) + ((> x (entry mset)) + (element-of-set? (right-branch mset))) + ((< x (entry mset)) + (element-of-set? (left-branch mset))))) + +(define (adjoin-set x mset) + (cond ((null? mset) (make-entry x '() '())) + ((= x (entry mset)) mset) + ((< x (entry mset)) + (make-entry + (entry mset) + (adjoin-set x (left-branch mset)) + (right-branch mset))) + ((> x (entry mset)) + (make-entry + (entry mset) + (left-branch mset) + (adjoin-set x (right-branch mset)))))) + +(define (tree->list tree) + (define (copy-to-list t result-list) + (if (null? t) + result-list + (copy-to-list (left-branch t) + (cons (entry t) + (copy-to-list (right-branch t) + result-list))))) + (copy-to-list tree '())) + + +(define (list->tree elements) + (car (partial-tree elements (length elements)))) + +(define (partial-tree elts n) + (if (= n 0) + (cons '() elts) + (let ((left-size (quotient (- n 1) 2))) + (let ((left-result (partial-tree elts left-size))) + (let ((left-tree (car left-result)) + (non-left-elts (cdr left-result)) + (right-size (- n (+ left-size 1)))) + (let ((this-entry (car non-left-elts)) + (right-result (partial-tree (cdr non-left-elts) + right-size))) + (let ((right-tree (car right-result)) + (remaining-elts (cdr right-result))) + (cons (make-entry this-entry left-tree right-tree) + remaining-elts)))))))) + +;; 2*O(n) + O(n) + O(n) +(define (union-set s1 s2) + (define (ordered-list-union-set set1 set2) + (cond + ((and (null? set1) (null? set2)) '()) + ((null? set1) (cons (car set2) (ordered-list-union-set set1 (cdr set2)))) + ((null? set2) (cons (car set1) (ordered-list-union-set (cdr set1) set2))) + ((= (car set1) (car set2)) (cons (car set2) (ordered-list-union-set (cdr set1) (cdr set2)))) + ((> (car set1) (car set2)) (cons (car set2) (ordered-list-union-set set1 (cdr set2)))) + ((< (car set1) (car set2)) (cons (car set1) (ordered-list-union-set (cdr set1) set2))))) + (list->tree + (ordered-list-union-set (tree->list s1) (tree->list s2)))) + +;; 2*O(n) + O(n) + O(n) +(define (intersection-set set1 set2) + (define (ordered-list-intersection-set s1 s2) + (if (or (null? s1) (null? s2)) + '() + (let ((x1 (car s1)) (x2 (car s2))) + (cond ((= x1 x2) + (cons x1 + (ordered-list-intersection-set + (cdr s1) + (cdr s2)))) + ((< x1 x2) + (ordered-list-intersection-set + (cdr s1) + s2)) + ((> x1 x2) + (ordered-list-intersection-set + s1 + (cdr s2))))))) + (list->tree + (ordered-list-intersection-set + (tree->list set1) (tree->list set2)))) + -- cgit v1.2.3