Implement till 2.50 and visualize picture language via pil
parent
5b8cae18c4
commit
eeec256c6b
|
|
@ -1,5 +1,7 @@
|
|||
old_ch2
|
||||
# ---> Scheme
|
||||
*.py
|
||||
*.png
|
||||
*.ss~
|
||||
*.ss#*
|
||||
.#*.ss
|
||||
|
|
|
|||
|
|
@ -219,9 +219,73 @@
|
|||
|
||||
(display (unique-sum-triples 6 10)) (newline)
|
||||
|
||||
(display "\nex-2.42\n")
|
||||
(display "\nex-2.42 - eight queens\n")
|
||||
|
||||
; Creates a new list with numbers [1..n] cons'd to the current lists
|
||||
(define (add-numbers n xs)
|
||||
(flatmap
|
||||
(lambda (x) (map (lambda (i) (cons i x)) (enumerate-interval 1 n)))
|
||||
xs))
|
||||
|
||||
; Checks if the first queen on the board is safe relative to the other queens
|
||||
(define (safe? board)
|
||||
(define (valid-position row diag board)
|
||||
(if (null? board)
|
||||
#t
|
||||
(let ((cur_row (car board)))
|
||||
(if (or (= row cur_row) ; same row
|
||||
(= (+ row diag) cur_row) ; upper right diagonal
|
||||
(= (- row diag) cur_row)) ; lower left diagonal
|
||||
#f
|
||||
(valid-position row (+ diag 1) (cdr board))))))
|
||||
(valid-position (car board) 1 (cdr board)))
|
||||
|
||||
(define empty-board (list nil))
|
||||
|
||||
(define (queens n)
|
||||
(define (queens-cols k)
|
||||
(if (= k 0)
|
||||
empty-board
|
||||
(filter safe? (add-numbers n (queens-cols (- k 1))))))
|
||||
(queens-cols n))
|
||||
|
||||
(display (length (queens 8))) (newline)
|
||||
|
||||
; Till here was my own implementation for practice.
|
||||
; Here is the official solution:
|
||||
|
||||
(define (adjoin-position new-row k rest-of-queens)
|
||||
(cons new-row rest-of-queens))
|
||||
|
||||
(define (queens board-size)
|
||||
(define empty-board nil)
|
||||
(define (queen-cols k)
|
||||
(if (= k 0)
|
||||
(list empty-board)
|
||||
(filter
|
||||
(lambda (positions) (safe? positions)) ; removed k because we don't need it
|
||||
(flatmap
|
||||
(lambda (rest-of-queens)
|
||||
(map (lambda (new-row)
|
||||
(adjoin-position new-row k rest-of-queens))
|
||||
(enumerate-interval 1 board-size)))
|
||||
(queen-cols (- k 1))))))
|
||||
(queen-cols board-size))
|
||||
|
||||
(display (length (queens 8))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.43\n")
|
||||
|
||||
(display "\nex-2.43 - see comments\n")
|
||||
;(flatmap
|
||||
; (lambda (new-row)
|
||||
; (map (lambda (rest-of-queens)
|
||||
; (adjoin-position new-row k rest-of-queens))
|
||||
; (queen-cols (- k 1))))
|
||||
; (enumerate-interval 1 board-size))
|
||||
|
||||
; Louis' implementation computes the queens for the remaining columns
|
||||
; board-size times for each column. That means for two columns the program is
|
||||
; two times slower. For three, two times times three times, in other words, the
|
||||
; execution time is (board-size! * T).
|
||||
|
||||
|
|
|
|||
252
ex-2_44-52.scm
252
ex-2_44-52.scm
|
|
@ -1,21 +1,269 @@
|
|||
(load "util.scm")
|
||||
(display "\nex-2.44 - a picture language\n")
|
||||
|
||||
; One solution for 2.51
|
||||
(define (below painter1 painter2)
|
||||
(let ((paint-top
|
||||
(transform-painter painter2
|
||||
(make-vect 0.0 0.5)
|
||||
(make-vect 1.0 0.5)
|
||||
(make-vect 0.0 1.0)))
|
||||
(paint-bottom
|
||||
(transform-painter painter1
|
||||
(make-vect 0.0 0.0)
|
||||
(make-vect 1.0 0.0)
|
||||
(make-vect 0.0 0.5))))
|
||||
(lambda (frame)
|
||||
(lambda (draw-line)
|
||||
((paint-top frame) draw-line)
|
||||
((paint-bottom frame) draw-line)))))
|
||||
|
||||
(define (beside painter1 painter2)
|
||||
(let ((split-point (make-vect 0.5 0.0)))
|
||||
(let ((paint-left
|
||||
(transform-painter painter1
|
||||
(make-vect 0.0 0.0)
|
||||
split-point
|
||||
(make-vect 0.0 1.0)))
|
||||
(paint-right
|
||||
(transform-painter painter2
|
||||
split-point
|
||||
(make-vect 1.0 0.0)
|
||||
(make-vect 0.5 1.0))))
|
||||
(lambda (frame)
|
||||
(lambda (draw-line)
|
||||
((paint-left frame) draw-line)
|
||||
((paint-right frame) draw-line))))))
|
||||
|
||||
|
||||
|
||||
(define (right-split painter n)
|
||||
(if (= n 0)
|
||||
painter
|
||||
(let ((smaller (right-split painter (- n 1))))
|
||||
(beside painter (below smaller smaller)))))
|
||||
|
||||
(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 (up-split painter n)
|
||||
(if (= n 0)
|
||||
painter
|
||||
(let ((smaller (up-split painter (- n 1))))
|
||||
(below painter (beside smaller smaller)))))
|
||||
|
||||
(display "\nex-2.44\n")
|
||||
|
||||
(display "\nex-2.45\n")
|
||||
|
||||
(define (split main-placer smaller-placer)
|
||||
(define (rec painter n)
|
||||
(if (= n 0)
|
||||
painter
|
||||
(let ((smaller (rec painter (- n 1))))
|
||||
(main-placer painter (smaller-placer smaller smaller)))))
|
||||
rec)
|
||||
|
||||
(define right-split (split beside below))
|
||||
(define up-split (split below beside))
|
||||
|
||||
(display "\nex-2.46\n")
|
||||
|
||||
(define (frame-coord-map frame)
|
||||
(lambda (v)
|
||||
(add-vect
|
||||
(origin-frame frame)
|
||||
(add-vect (scale-vect (xcor-vect v)
|
||||
(edge1-frame frame))
|
||||
(scale-vect (ycor-vect v)
|
||||
(edge2-frame frame))))))
|
||||
|
||||
(define make-vect cons)
|
||||
(define xcor-vect car)
|
||||
(define ycor-vect cdr)
|
||||
|
||||
(define (add-vect v w)
|
||||
(make-vect (+ (xcor-vect v) (xcor-vect w))
|
||||
(+ (ycor-vect v) (ycor-vect w))))
|
||||
|
||||
(define (sub-vect v w)
|
||||
(make-vect (- (xcor-vect v) (xcor-vect w))
|
||||
(- (ycor-vect v) (ycor-vect w))))
|
||||
|
||||
(define (scale-vect s v)
|
||||
(make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))
|
||||
|
||||
(define (frame-coord-map frame)
|
||||
(lambda (v)
|
||||
(add-vect
|
||||
(origin-frame frame)
|
||||
(add-vect (scale-vect (xcor-vect v)
|
||||
(edge1-frame frame))
|
||||
(scale-vect (ycor-vect v)
|
||||
(edge2-frame frame))))))
|
||||
|
||||
(display "\nex-2.47\n")
|
||||
|
||||
(define (make-frame origin edge1 edge2)
|
||||
(list origin edge1 edge2))
|
||||
|
||||
(define origin-frame car)
|
||||
(define edge1-frame cadr)
|
||||
(define edge2-frame caddr)
|
||||
|
||||
(define (make-frame origin edge1 edge2)
|
||||
(cons origin (cons edge1 edge2)))
|
||||
|
||||
(define origin-frame car)
|
||||
(define edge1-frame cadr)
|
||||
(define edge2-frame cddr)
|
||||
|
||||
(display "\nex-2.48\n")
|
||||
|
||||
(define (segments->painter segment-list)
|
||||
(lambda (frame)
|
||||
(lambda (draw-line)
|
||||
(for-each
|
||||
(lambda (segment)
|
||||
(draw-line
|
||||
((frame-coord-map frame) (start-segment segment))
|
||||
((frame-coord-map frame) (end-segment segment))))
|
||||
segment-list))))
|
||||
|
||||
(define make-segment list)
|
||||
(define start-segment car)
|
||||
(define end-segment cadr)
|
||||
|
||||
(display "\nex-2.49\n")
|
||||
|
||||
(define simple-frame (make-frame (make-vect 0 1080)
|
||||
(make-vect 1920 0)
|
||||
(make-vect 0 -1080)))
|
||||
|
||||
(define (make-line x1 y1 x2 y2)
|
||||
(make-segment (make-vect x1 y1) (make-vect x2 y2)))
|
||||
|
||||
(define painter-outline
|
||||
(segments->painter
|
||||
(list (make-line 0 0 0 1)
|
||||
(make-line 0 0 1 0)
|
||||
(make-line 1 0 1 1)
|
||||
(make-line 0 1 1 1))))
|
||||
|
||||
(define painter-x
|
||||
(segments->painter
|
||||
(list (make-line 0 0 1 1)
|
||||
(make-line 0 1 1 0))))
|
||||
|
||||
(define painter-diamond
|
||||
(segments->painter
|
||||
(list (make-line 0.5 0 0 0.5)
|
||||
(make-line 0.5 0 1 0.5)
|
||||
(make-line 0 0.5 0.5 1)
|
||||
(make-line 1 0.5 0.5 1))))
|
||||
|
||||
; from here: http://wiki.drewhess.com/wiki/SICP_exercise_2.49
|
||||
(define painter-wave
|
||||
(segments->painter
|
||||
(list (make-line 0.4 0 0.5 0.33)
|
||||
(make-line 0.5 0.33 0.6 0.0)
|
||||
(make-line 0.25 0.0 0.33 0.5)
|
||||
(make-line 0.33 0.5 0.3 0.6)
|
||||
(make-line 0.3 0.6 0.1 0.4)
|
||||
(make-line 0.1 0.4 0.0 0.6)
|
||||
(make-line 0.0 0.6 0.0 0.8)
|
||||
(make-line 0.0 0.8 0.1 0.6)
|
||||
(make-line 0.1 0.6 0.33 0.65)
|
||||
(make-line 0.33 0.65 0.4 0.65)
|
||||
(make-line 0.4 0.65 0.35 0.8)
|
||||
(make-line 0.35 0.8 0.4 1.0)
|
||||
(make-line 0.4 1.0 0.6 1.0)
|
||||
(make-line 0.75 0.0 0.6 0.45)
|
||||
(make-line 0.6 0.45 1.0 0.15)
|
||||
(make-line 1.0 0.15 1.0 0.35)
|
||||
(make-line 1.0 0.35 0.8 0.65)
|
||||
(make-line 0.8 0.65 0.6 0.65)
|
||||
(make-line 0.6 0.65 0.65 0.8)
|
||||
(make-line 0.65 0.8 0.6 1.0))))
|
||||
|
||||
(load "picture_language/draw.scm")
|
||||
|
||||
(draw-to-py (painter-diamond simple-frame) "wave")
|
||||
|
||||
(display "\nex-2.50\n")
|
||||
|
||||
(define (transform-painter painter origin corner1 corner2)
|
||||
(lambda (frame)
|
||||
(let ((m (frame-coord-map frame)))
|
||||
(let ((new-origin (m origin)))
|
||||
(painter
|
||||
(make-frame new-origin
|
||||
(sub-vect (m corner1) new-origin)
|
||||
(sub-vect (m corner2) new-origin)))))))
|
||||
|
||||
(define (flip-vert painter)
|
||||
(transform-painter painter
|
||||
(make-vect 0.0 1.0) ; new origin
|
||||
(make-vect 1.0 1.0) ; new end of edge1
|
||||
(make-vect 0.0 0.0))) ; new end of edge2
|
||||
|
||||
(draw-to-py ((flip-vert painter-wave) simple-frame) "wave-flipped")
|
||||
|
||||
(define (shrink-to-upper-right painter)
|
||||
(transform-painter painter
|
||||
(make-vect 0.5 0.5)
|
||||
(make-vect 1.0 0.5)
|
||||
(make-vect 0.5 1.0)))
|
||||
|
||||
(draw-to-py ((shrink-to-upper-right painter-wave) simple-frame) "wave-shrinked")
|
||||
|
||||
(define (rotate90 painter)
|
||||
(transform-painter painter
|
||||
(make-vect 1.0 0.0)
|
||||
(make-vect 1.0 1.0)
|
||||
(make-vect 0.0 0.0)))
|
||||
|
||||
(draw-to-py ((rotate90 painter-wave) simple-frame) "wave-rotated")
|
||||
|
||||
(define (flip-horiz painter)
|
||||
(transform-painter painter
|
||||
(make-vect 1.0 0.0) ; new origin
|
||||
(make-vect 0.0 0.0) ; new end of edge1
|
||||
(make-vect 1.0 1.0))) ; new end of edge2
|
||||
|
||||
(define (rotate180 painter)
|
||||
(transform-painter painter
|
||||
(make-vect 1.0 1.0)
|
||||
(make-vect 0.0 1.0)
|
||||
(make-vect 1.0 0.0)))
|
||||
|
||||
; both works of course
|
||||
(define (rotate270 painter)
|
||||
(rotate90 (rotate90 (rotate90 painter))))
|
||||
|
||||
(define (rotate270 painter)
|
||||
(transform-painter painter
|
||||
(make-vect 0.0 1.0)
|
||||
(make-vect 0.0 0.0)
|
||||
(make-vect 1.0 1.0)))
|
||||
|
||||
(draw-to-py ((beside painter-wave painter-diamond) simple-frame) "wave-beside-diamond")
|
||||
|
||||
(display "\nex-2.51\n")
|
||||
|
||||
; First implementation is at the beginning of this file.
|
||||
(draw-to-py ((corner-split painter-wave 4) simple-frame) "corner-split-4")
|
||||
(draw-to-py ((below painter-x painter-diamond) simple-frame) "x-below-diamond")
|
||||
|
||||
|
||||
|
||||
|
||||
(display "\nex-2.52\n")
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,26 @@
|
|||
(define (draw-to-py painter name)
|
||||
(define py-name (string-append "picture_language/" name ".py"))
|
||||
(define img-name (string-append name ".png"))
|
||||
(define head (string-append
|
||||
"from PIL import Image, ImageDraw\n"
|
||||
"im = Image.new('RGB', (1921, 1081))\n"
|
||||
"draw = ImageDraw.Draw(im)\n"))
|
||||
(define tail (string-append
|
||||
"im.save('" img-name "', 'PNG')\n"))
|
||||
(let ((port (open-output-file py-name)))
|
||||
(define (draw-line v1 v2)
|
||||
(define n2s number->string)
|
||||
(display
|
||||
(string-append
|
||||
"draw.line(("
|
||||
(n2s (xcor-vect v1)) ", "
|
||||
(n2s (ycor-vect v1)) ", "
|
||||
(n2s (xcor-vect v2)) ", "
|
||||
(n2s (ycor-vect v2)) "), "
|
||||
"fill=128)\n") port))
|
||||
(display head port)
|
||||
(painter draw-line)
|
||||
(display tail port)
|
||||
(close-output-port port)))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue