diff options
Diffstat (limited to 'coding-exercises/3')
| -rw-r--r-- | coding-exercises/3/3.5.1/50.rkt | 30 | ||||
| -rw-r--r-- | coding-exercises/3/3.5.2/53.rkt | 43 | ||||
| -rw-r--r-- | coding-exercises/3/47.rkt | 36 | ||||
| -rw-r--r-- | coding-exercises/3/48.rkt | 64 |
4 files changed, 171 insertions, 2 deletions
diff --git a/coding-exercises/3/3.5.1/50.rkt b/coding-exercises/3/3.5.1/50.rkt new file mode 100644 index 0000000..7f235e4 --- /dev/null +++ b/coding-exercises/3/3.5.1/50.rkt @@ -0,0 +1,30 @@ +#lang racket + +(require "../../../shared/sicp-stream.rkt") + +(newline) (print "50") (newline) +(stream-map (lambda (a b) (+ 1 a b)) + (stream-enumerate-interval 0 10) + (stream-enumerate-interval 0 10)) + +(newline) (print "51") (newline) +(define x (stream-map show (stream-enumerate-interval 0 10))) +(newline) +(println x) +(stream-ref x 5) +(stream-ref x 7) + +(newline) (print "52") (newline) +(define sum 0) +(define (accum x) (set! sum (+ x sum)) sum) + +(define seq (stream-map accum (stream-enumerate-interval 1 20))) +(define y (stream-filter even? seq)) +(newline) (print "first even is 6 ") (display sum) (newline) +(define z (stream-filter (lambda (x) (= (remainder x 5) 0)) + seq)) +(newline) (print "first divisable by 5 is 10, this would be 15 if memoization was not used.") (display sum) (newline) +(newline) (print "display-ref 7, this just prints the 7th of the filtered seq. Without memoization it would be hard to say what this value is, because it depends on the assignments to sum in the time before this call.") (newline) +(stream-ref y 7) +(newline) (print "display-stream") +(display-stream z) diff --git a/coding-exercises/3/3.5.2/53.rkt b/coding-exercises/3/3.5.2/53.rkt new file mode 100644 index 0000000..776e619 --- /dev/null +++ b/coding-exercises/3/3.5.2/53.rkt @@ -0,0 +1,43 @@ +#lang racket +(require "../../../shared/sicp-stream.rkt") +(newline) (print "54") (newline) +(define (add-streams s1 s2) (stream-map + s1 s2)) +(define (scale-stream s factor) (stream-map (lambda (x) (* factor x)) s)) +(define (mul-streams s1 s2) (stream-map * s1 s2)) +(define ones (stream-cons 1 ones)) +(define integers (stream-cons 1 (add-streams ones integers))) +(define factorials (stream-cons 1 (mul-streams integers factorials))) +(stream-ref factorials 5) + +(newline) (print "55") (newline) +(define (partial-sums s) + (define me (stream-cons 0 (add-streams s me))) + me) +(stream-ref (partial-sums integers) 4) + +(newline) (print "56") (newline) +(define (merge s1 s2) + (cond ((stream-null? s1) s2) + ((stream-null? s2) s1) + (else + (let ((s1car (stream-car s1)) + (s2car (stream-car s2))) + (cond ((< s1car s2car) + (stream-cons s1car (merge (stream-cdr s1) s2))) + ((> s1car s2car) + (stream-cons s2car (merge s1 (stream-cdr s2)))) + (else + (stream-cons s1car + (merge (stream-cdr s1) + (stream-cdr s2))))))))) +(define S (stream-cons 1 (merge (scale-stream S 2) (merge (scale-stream S 3) (scale-stream S 5))))) + +(newline) (print "57") (newline) +(define additions 0) +(define (add-streams-counted s1 s2) (stream-map (lambda (x y) (set! additions (+ additions 1)) (+ x y)) s1 s2)) +(define fibs (stream-cons 0 + (stream-cons 1 + (add-streams-counted (stream-cdr fibs) + fibs)))) +(stream-ref fibs 20) +(println additions) (newline) (println "Streams in racket are forced when car is called.") diff --git a/coding-exercises/3/47.rkt b/coding-exercises/3/47.rkt index e2440ad..f995177 100644 --- a/coding-exercises/3/47.rkt +++ b/coding-exercises/3/47.rkt @@ -33,7 +33,6 @@ (begin (set-mcar! cell true) false))))) - (define (make-mutex-busy) (let ((cell (mlist false))) (define (the-mutex m) @@ -80,6 +79,7 @@ ;; In the book there are only examples that mention that you can use atomic operations on a single processor and for multiple processors there are special instructions that are atomic. ;; But in the racket manual it seems like there is no mention of two processes sharing the same memory space (there is places which run as separate os processes, potentially on a different cpu native processor). ;; So we could get away with atomic mode instead of the n-mutex. +;; NOTE(): does this deadlock? There are two mutexes, but can two processes acquire one mutex and then get stuck waiting on the other? (define (make-semaphore-retry-mutex n) (let ((n-mutex (make-mutex)) (retry-mutex (make-mutex))) @@ -107,4 +107,36 @@ (map (lambda (n) (lambda () (for-each (lambda (i) (sleep 1) (print "thread: ") (print n) (print ", ") (println i)) (enumerate-interval 1 3)))) (enumerate-interval 1 10))))) -(define (make-semaphore-test-and-set n)) +;; Assumes single time-sliced processor context +;; didn't feel like testing this one +(define (make-semaphore-test-and-set n) + (let ((retry-cell (mlist false)) + (n-cell (mlist false))) + (define (the-semaphore m) + (cond ((eq? m 'acquire) + (cond ((test-and-set! retry-cell) + (the-semaphore 'acquire)) + ((> n 0) + (if (test-and-set! n-cell) + (begin + (the-semaphore 'acquire)) + (begin + (set! n (- n 1)) + (clear! n-cell) + (when (> n 0) (clear! retry-cell))))) + ((<= n 0) + (clear! n-cell) + (the-semaphore 'acquire)))) + ((eq? m 'release) + (when (test-and-set! n-cell) + (the-semaphore 'release)) + (set! n (+ n 1)) + (clear! n-cell) + (clear! retry-cell)))) + the-semaphore)) + +(when false + (define s (make-semaphore-test-and-set 3)) + (parallel-execute (map (lambda (f) (lambda () (s 'acquire) (f) (s 'release))) + (map (lambda (n) (lambda () (for-each (lambda (i) (sleep 1) (print "thread: ") (print n) (print ", ") (println i)) (enumerate-interval 1 3)))) + (enumerate-interval 1 5))))) diff --git a/coding-exercises/3/48.rkt b/coding-exercises/3/48.rkt new file mode 100644 index 0000000..a3d2f3e --- /dev/null +++ b/coding-exercises/3/48.rkt @@ -0,0 +1,64 @@ +#lang racket +(define (make-mutex) + (let ((the-mutex (make-semaphore 1))) + (define (dispatch m) + (cond ((eq? m 'acquire) + (semaphore-wait the-mutex)) + ((eq? m 'release) + (semaphore-post the-mutex)))) + dispatch)) + +(define (make-serializer) + (let ((mutex (make-mutex))) + (lambda (p) + (define (serialized-p . args) + (mutex 'acquire) + (let ((val (apply p args))) + (mutex 'release) + val)) + serialized-p))) + +(define (make-numbered-accounts n) + (let ((global-serializer (make-serializer))) + (global-serializer + (lambda (balance) + (define (withdraw amount) + (if (>= balance amount) + (begin (set! balance (- balance amount)) + balance) + "Insufficient funds")) + (define (deposit amount) + (set! balance (+ balance amount)) + balance) + (let ((number (begin (set! n (+ n 1)) + n)) + (balance-serializer (make-serializer))) + (lambda (m) + (cond ((eq? m 'withdraw) withdraw) + ((eq? m 'deposit) deposit) + ((eq? m 'balance) balance) + ((eq? m 'serializer) balance-serializer) + ((eq? m 'number) number)))))))) +(define account (make-numbered-accounts 0)) +(define a1 (account 100)) +(define a2 (account 50)) +(println (a1 'number)) +(println (a2 'number)) + +(define (exchange a1 a2) + (let ((delta (- (a1 'balance) + (a2 'balance)))) + ((a1 'withdraw) delta) + ((a2 'deposit) delta))) + +(define (serialized-exchange a1 a2) + (let ((s1 (a1 'serializer)) + (s2 (a2 'serializer))) + (let ((s (if (< (a1 'number) + (a2 'number)) + (lambda (f) (s1 (s2 f))) + (lambda (f) (s2 (s1 f)))))) + ((s exchange) a1 a2)))) +(serialized-exchange a1 a2) +(println (a1 'balance)) +(println (a2 'balance)) |
