diff options
Diffstat (limited to 'coding-exercises')
| -rw-r--r-- | coding-exercises/2/29.rkt | 103 | ||||
| -rw-r--r-- | coding-exercises/2/30.rkt | 38 | ||||
| -rw-r--r-- | coding-exercises/2/31.rkt | 11 | ||||
| -rw-r--r-- | coding-exercises/2/32.rkt | 21 | ||||
| -rw-r--r-- | coding-exercises/2/33.rkt | 2 |
5 files changed, 173 insertions, 2 deletions
diff --git a/coding-exercises/2/29.rkt b/coding-exercises/2/29.rkt index 8b9138b..e4fa7d7 100644 --- a/coding-exercises/2/29.rkt +++ b/coding-exercises/2/29.rkt @@ -1,8 +1,107 @@ #lang racket (require sicp) +;;(define (make-mobile left right) +;; (list left right)) (define (make-mobile left right) - (list left right)) + (cons left right)) (define (make-branch len structure) - (list len structure)) + (cons len structure)) + +(define (left-branch m) + (car m)) +(define (right-branch m) + (cdr m)) + +(define m (make-mobile (make-branch 2 3) (make-branch 4 5))) + +(define (branch-length b) + (car b)) +(define (branch-structure b) + (cdr b)) + +(define (total-weight mobile) + (define (maybe-recurse s) + (if (pair? s) + (rec s) + s)) + (define (rec m) + (let ((l (branch-structure (left-branch m))) + (r (branch-structure (right-branch m)))) + (+ (maybe-recurse l) (maybe-recurse r)))) + (rec mobile)) + +;; We don't want to call total-weight multiple times, because it has a typical binary tree recursion time +;; complexity of 2^n. +;; Instead we modify total weight to return a pair (weight balance). +;; Weight is calculated as before, but we now also calculate the balance of a tree and its subtrees. +;; So instead of n*2^n we have still 2^n. +(define (balanced? mobile) + (define (equal-torque? len1 w1 len2 w2) + (= (* len1 w1) (* len2 w2))) + (define (rec m) + (let + ((ls (branch-structure (left-branch m))) + (ll (branch-length (left-branch m))) + (rs (branch-structure (right-branch m))) + (rl (branch-length (right-branch m)))) + (cond + ((not (or (pair? ls) (pair? rs))) + (cons (+ ls rs) + (equal-torque? ll ls rl rs))) + ((and (pair? ls) (not (pair? rs))) + (let ((result-l (rec ls))) + (cons (+ (car result-l) rs) + (and (cdr result-l) + (equal-torque? ll (car result-l) + rl rs))))) + ((and (not (pair? ls)) (pair? rs)) + (let ((result-r (rec rs))) + (cons (+ ls (car result-r)) + (and (cdr result-r) + (equal-torque? ll ls + rl (car result-r)))))) + (else + (let ((result-l (rec ls)) + (result-r (rec rs))) + (cons (+ (car result-l) (car result-r)) + (and + (cdr result-l) + (cdr result-r) + (equal-torque? ll (car result-l) + rl (car result-r))))))))) + (rec mobile)) + +(define (print) + (define balanced (make-mobile (make-branch 2 3) (make-branch 3 2))) + (define unbalanced (make-mobile (make-branch 2 3) (make-branch 3 3))) + + (newline) + (display (balanced? balanced)) + (newline) + (display (balanced? unbalanced)) + + (define balanced-nested + (make-mobile + (make-branch 2 3) + (make-branch + 3 + (make-mobile + (make-branch 1 1) + (make-branch 1 1))))) + + (define unbalanced-nested + (make-mobile + (make-branch 2 3) + (make-branch + 4 + (make-mobile + (make-branch 1 1) + (make-branch 1 1))))) + (newline) + (display (balanced? balanced-nested)) + (newline) + (display (balanced? unbalanced-nested))) + +(print) diff --git a/coding-exercises/2/30.rkt b/coding-exercises/2/30.rkt new file mode 100644 index 0000000..785a8dc --- /dev/null +++ b/coding-exercises/2/30.rkt @@ -0,0 +1,38 @@ +#lang racket +(define (scale-tree tree factor) + (cond ((null? tree) nil) + ((not (pair? tree)) (* tree factor)) + (else (cons (scale-tree (car tree) factor) + (scale-tree (cdr tree) factor))))) + +(define (scale-tree tree factor) + (map (lambda (sub-tree) + (if (pair? sub-tree) + (scale-tree subtree factor) + (* sub-tree factor))) + tree)) + +;; analogous to, but we now also have to test when to recurse in the middle of the tree +;; (define (square-list items) +;; (if (null? items) +;; (list) +;; (cons (square (car items)) (square-list (cdr items))))) +(define (square-tree tree) + (cond ((null? tree) nil) + ((not (pair? tree)) (* tree tree)) + (else (cons (square-tree (car tree)) + (square-tree (cdr tree)))))) + +(define test-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))) +((lambda () + (display (square-tree test-tree)))) + +;; Can I also pass some state combining sequence and recursive operations? +(define (square-tree-map tree) + (map (lambda (subtree) + (if (pair? subtree) + (square-tree-map subtree) + (* subtree subtree))) + tree)) +((lambda () + (display (square-tree-map test-tree)))) diff --git a/coding-exercises/2/31.rkt b/coding-exercises/2/31.rkt new file mode 100644 index 0000000..08e0d51 --- /dev/null +++ b/coding-exercises/2/31.rkt @@ -0,0 +1,11 @@ +#lang racket +(define (tree-map fn tree) + (map (lambda (subtree) + (if (pair? subtree) + (tree-map fn subtree) + (fn subtree))) + tree)) + +(define test-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))) +((lambda () + (display (tree-map (lambda (x) (* x x)) test-tree)))) diff --git a/coding-exercises/2/32.rkt b/coding-exercises/2/32.rkt new file mode 100644 index 0000000..b7616ac --- /dev/null +++ b/coding-exercises/2/32.rkt @@ -0,0 +1,21 @@ +#lang racket + +;; Accumulates all combinations with the car element and without the car element in a list +;; The appends: +;; 1. (()) + ((3)) +;; 2. (() (3)) + ((2) (2 3)) +;; ... +;; +;; Lisp-wise it works out because the empty set follows from these rules when the input set is empty, +;; so every level introduces the list with the car element itself and combinations with all previous combinations +(define (subsets s) + (if (null? s) + (list nil) + (let ((rest (subsets (cdr s)))) + (append rest (map (lambda (x) + (cons (car s) x)) rest))))) +((lambda () + (display (subsets (list 1 2 3))))) + +(println (cons 2 '())) +(println (list 2)) diff --git a/coding-exercises/2/33.rkt b/coding-exercises/2/33.rkt new file mode 100644 index 0000000..cda82ce --- /dev/null +++ b/coding-exercises/2/33.rkt @@ -0,0 +1,2 @@ +#lang racket + |