From: Ramakrishnan Muthukrishnan Date: Fri, 17 Sep 2010 18:41:26 +0000 (+0530) Subject: implementing some of the sec 2.2 examples in Racket X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/bcase/nxhtml.html?a=commitdiff_plain;h=758a18092e28e95a6ec0cd7bd00b8948a9fabac3;p=sicp.git implementing some of the sec 2.2 examples in Racket --- diff --git a/src/sicp/ch2_2.rkt b/src/sicp/ch2_2.rkt new file mode 100644 index 0000000..db58d8c --- /dev/null +++ b/src/sicp/ch2_2.rkt @@ -0,0 +1,66 @@ +#lang scheme + +(require (planet soegaard/sicp:2:1/sicp)) + +;; count-leaves +(define (count-leaves x) + (cond + [(null? x) 0] + [(not (pair? x)) 1] + [else (+ (count-leaves (first x)) + (count-leaves (rest x)))])) + +;; scale tree +(define (scale-tree tree factor) + (cond [(null? tree) '()] + [(not (pair? tree)) (* tree factor)] + [else (cons (scale-tree (first tree) factor) + (scale-tree (rest tree) factor))])) + +(define (scale-tree-map tree factor) + (map (lambda (x) + (if (not (pair? x)) + (* x factor) + (scale-tree-map x factor))) + tree)) + +(define (square-of-four tl tr bl br) + (lambda (painter) + (let ((top (beside (tl painter) (tr painter))) + (bottom (beside (bl painter) (br painter)))) + (below bottom top)))) + +(define (flipped-pairs painter) + (let ((combine4 (square-of-four identity flip-vert + identity flip-vert))) + (combine4 painter))) + +(define (identity x) x) + +(define (corner-split painter n) + (if (= n 0) + painter + (let ((up (up-split painter (- n 1))) + (right (right-split painter (- n 1)))) + (let ((top-left (beside up up)) + (bottom-right (below right right)) + (corner (corner-split painter (- n 1)))) + (beside (below painter top-left) + (below bottom-right corner)))))) + +(define (right-split painter n) + (if (= n 0) + painter + (let ((smaller (right-split painter (- n 1)))) + (beside painter (below smaller smaller))))) + +(define (up-split painter n) + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below painter (beside smaller smaller))))) + +(define (square-limit painter n) + (let ((combine4 (square-of-four flip-horiz identity + rotate180 flip-vert))) + (combine4 (corner-split painter n)))) diff --git a/src/sicp/ch2_2.scm b/src/sicp/ch2_2.scm deleted file mode 100644 index 8d03232..0000000 --- a/src/sicp/ch2_2.scm +++ /dev/null @@ -1,44 +0,0 @@ -#lang scheme - -(require (planet soegaard/sicp:2:1/sicp)) - -(define (square-of-four tl tr bl br) - (lambda (painter) - (let ((top (beside (tl painter) (tr painter))) - (bottom (beside (bl painter) (br painter)))) - (below bottom top)))) - -(define (flipped-pairs painter) - (let ((combine4 (square-of-four identity flip-vert - identity flip-vert))) - (combine4 painter))) - -(define (identity x) x) - -(define (corner-split painter n) - (if (= n 0) - painter - (let ((up (up-split painter (- n 1))) - (right (right-split painter (- n 1)))) - (let ((top-left (beside up up)) - (bottom-right (below right right)) - (corner (corner-split painter (- n 1)))) - (beside (below painter top-left) - (below bottom-right corner)))))) - -(define (right-split painter n) - (if (= n 0) - painter - (let ((smaller (right-split painter (- n 1)))) - (beside painter (below smaller smaller))))) - -(define (up-split painter n) - (if (= n 0) - painter - (let ((smaller (up-split painter (- n 1)))) - (below painter (beside smaller smaller))))) - -(define (square-limit painter n) - (let ((combine4 (square-of-four flip-horiz identity - rotate180 flip-vert))) - (combine4 (corner-split painter n))))