From: Ramakrishnan Muthukrishnan Date: Thu, 17 Feb 2011 19:41:35 +0000 (+0530) Subject: solutions to 3.24 and 3.25. Please review, particularly 3.25 X-Git-Url: https://git.rkrishnan.org/(%5B%5E?a=commitdiff_plain;h=496e93fc7ef998610af188ba50a553cce12392a0;p=sicp.git solutions to 3.24 and 3.25. Please review, particularly 3.25 --- diff --git a/src/sicp/ex3_24.rkt b/src/sicp/ex3_24.rkt new file mode 100644 index 0000000..14d25ca --- /dev/null +++ b/src/sicp/ex3_24.rkt @@ -0,0 +1,60 @@ +#lang r5rs + +(define error display) + +(define (make-table same-key?) + (let ((local-table (list '*table*))) + (define (assoc key records) + (cond + ((null? records) #f) + ((same-key? key (car (car records))) (car records)) + (else (assoc key (cdr records))))) + + (define (lookup key-1 key-2) + (let ((subtable (assoc key-1 (cdr local-table)))) + (if subtable + (let ((record (assoc key-2 (cdr subtable)))) + (if record + (cdr record) + #f)) + #f))) + (define (insert! key-1 key-2 value) + (let ((subtable (assoc key-1 (cdr local-table)))) + (if subtable + (let ((record (assoc key-2 (cdr subtable)))) + (if record + (set-cdr! record value) + (set-cdr! subtable + (cons (cons key-2 value) + (cdr subtable))))) + (set-cdr! local-table + (cons (list key-1 + (cons key-2 value)) + (cdr local-table))))) + 'ok) + (define (dispatch m) + (cond + ((eq? m 'lookup-proc) lookup) + ((eq? m 'insert-proc!) insert!) + (else (error "Unknown operation -- TABLE")))) + dispatch)) + +;(define operation-table (make-table equal?)) +;(define get (operation-table 'lookup-proc)) +;(define put (operation-table 'insert-proc!)) + +#| +> (define numeric-table + (make-table (lambda (key-1 key-2) (< (abs (- key-2 key-1)) 2)))) +> (define get-val (numeric-table 'lookup-proc)) +> (define put-val (numeric-table 'insert-proc!)) +> (put-val '1 1 1) +'ok +> (put-val '4 4 16) +'ok +> (get-val '4 4) +16 +> (get-val '5 4) +16 +> +|# \ No newline at end of file diff --git a/src/sicp/ex3_25.rkt b/src/sicp/ex3_25.rkt new file mode 100644 index 0000000..2481d26 --- /dev/null +++ b/src/sicp/ex3_25.rkt @@ -0,0 +1,83 @@ +#lang r5rs + +(define (lookup key table) + (let ((record (assoc key (cdr table)))) + (if record + (cdr record) + #f))) + +(define (assoc key records) + (cond ((null? records) #f) + ((equal? key (caar records)) (car records)) + (else (assoc key (cdr records))))) + +(define (insert! key value table) + (let ((record (assoc key (cdr table)))) + (if record + (set-cdr! record value) + (set-cdr! table + (cons (cons key value) (cdr table))))) + 'ok) + +(define (assoc-in key-list records) + (if (not (null? key-list)) + (if (not (null? (cdr key-list))) + (assoc-in (cdr key-list) + (assoc (car key-list) (cdr records))) + (assoc (car key-list) (cdr records))) + #f)) + +(define (lookup-in key-list records) + (let ((record (assoc-in key-list records))) + (if record + (cdr record) + #f))) + +(define (form-table keys value) + (cond + ((null? (cdr keys)) (cons (car keys) value)) + (else (list (car keys) + (form-table (cdr keys) value))))) + +(define (insert-in! key-list value records) + (let loop ((k (car key-list)) + (ks (cdr key-list)) + (table (cdr records))) + (let ((record (assoc k table))) + (if record + (if (null? ks) + (set-cdr! record value) + (loop (car ks) (cdr ks) (cdr record))) + (if (null? ks) + (set-cdr! table + (cons (cons k value) + (cdr table))) + (set-cdr! records + (cons (list k + (form-table ks value)) + (cdr records)))))))) + + + + + +#| +> (define t (list '*table* + (list 'math + (cons '+ 43) + (cons '- 45) + (cons '* 42)) + (list 'letters + (cons 'a 97) + (cons 'b 98)))) + +> (lookup-in '(math +) t) +43 +> (lookup-in '(math /) t) +#f +> (lookup-in '(letters /) t) +#f +> (lookup-in '(letters a) t) +97 +> +|#