diff --git "a/\351\231\210\344\271\220\345\244\251/README.md" "b/\351\231\210\344\271\220\345\244\251/README.md" index a128615..af308b8 100644 --- "a/\351\231\210\344\271\220\345\244\251/README.md" +++ "b/\351\231\210\344\271\220\345\244\251/README.md" @@ -12,4 +12,8 @@ - 八皇后那题做得好丑。。。完全就是用递归替代循环写了一遍八皇后的dfs,写到第六题的时候突然发现八皇后那题应该用第六题那种方法写,但是好像想想似乎构造出来长度为8的序列之后好像还是得用类似于两重循环的递归去判断是否符合呀(且不说长度为8的序列写出来我已经画美不看了),求指教,如何用优雅的方式写八皇后那题 - 感觉这周终于有点函数式的感觉了😂再接再厉! +## Week4 +- 第四周作业题已全部AC +- 画小人那个确实蛮有意思,绘图质量这么高我竟然有点在考虑用racket做生产力工具了(卧槽这东西写出来是不是永远别想维护了),要是有个好的IDE真的可能会选择racket + diff --git "a/\351\231\210\344\271\220\345\244\251/Week4/graphic.rkt" "b/\351\231\210\344\271\220\345\244\251/Week4/graphic.rkt" new file mode 100644 index 0000000..1ef32e2 --- /dev/null +++ "b/\351\231\210\344\271\220\345\244\251/Week4/graphic.rkt" @@ -0,0 +1,215 @@ +#lang racket/gui +(require racket/gui/base) + +;定义向量 +(define (make-vect x y) (cons x y)) +(define (xcor-vect v)(car v)) +(define (ycor-vect v)(cdr v)) +(define (add-vect v1 v2) + (make-vect (+ (xcor-vect v1) + (xcor-vect v2)) + (+ (ycor-vect v1) (ycor-vect v2)))) +(define (sub-vect v1 v2) + (make-vect (- (xcor-vect v1) + (xcor-vect v2)) (- (ycor-vect v1) + (ycor-vect v2)))) +(define (scale-vect s v) + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) +;定义线段 +(define (make-segment start end) (cons start end)) +(define (start-segment seg) (car seg)) +(define (end-segment seg) (cdr seg)) +(define (scale-segments seg-list scale) + (map + (lambda (segment) + (cons (scale-vect scale (start-segment segment)) (scale-vect scale (end-segment segment)))) + seg-list)) +;start, end都是线段端点(向量),坐标相对于绝对原点 + +;定义frame +(define (make-frame origin edge1 edge2) + (list origin edge1 edge2)) ;edge1和edge2也可以看做点,其坐标是相对于frame原点的 +(define (origin-frame f) (car f)) +(define (edge1-frame f) (cadr f)) +(define (edge2-frame f) (caddr f)) +;向量转换器 +(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)))))) +;定义painter +(define (segments->painter segment-list) ;segment-list是线段列表 + (lambda (frame) + (for-each + (lambda (segment) + (draw-line ;假定draw-line可以画线(以绝对原点作为原点) + ((frame-coord-map frame) (start-segment segment)) + ((frame-coord-map frame) (end-segment segment)))) + segment-list))) ;本过程生成一个painter,其原图形是一系列线段 +;accumulate +(define (accumulate op initial sequence) + (if (null? sequence) + initial + (op (car sequence) + (accumulate op initial (cdr sequence))))) +;flatmap +(define (flatmap proc seq) + (accumulate append '() (map proc seq))) +;将点组成的集合的集合转化为线段 +(define (point->segments lst) + (flatmap + (lambda (point-list) + (define (getSegment points) + (if (null? (cdr points)) + '() + (cons (make-segment (car points) (cadr points)) (getSegment (cdr points))))) + (getSegment point-list)) + lst)) +;转换painter +(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);frame的两条边是相对于frame原点的 + (sub-vect (m corner2) new-origin))))))) +;一系列转换painter的方法 +;恒等 +(define (identity painter) painter) +;水平翻转 +(define (flip-horz painter) + (transform-painter painter + (make-vect 1 0) + (make-vect 0 0) + (make-vect 1 1))) +;竖直翻转 +(define (flip-vert painter) + (transform-painter painter + (make-vect 0 1) + (make-vect 1 1) + (make-vect 0 0))) +;旋转180度 +(define (rotate180 painter) + (transform-painter painter + (make-vect 1 1) + (make-vect 0 1) + (make-vect 1 0))) +;上下排列 +(define (below painter1 painter2) + (let ((up (transform-painter painter1 + (make-vect 0 0) + (make-vect 1 0) + (make-vect 0 0.5))) + (down (transform-painter painter2 + (make-vect 0 0.5) + (make-vect 1 0.5) + (make-vect 0 1)))) + (lambda (frame) + (up frame) + (down frame)))) +;左右排列 +(define (beside painter1 painter2) + (let ((left (transform-painter painter1 + (make-vect 0 0) + (make-vect 0.5 0) + (make-vect 0 1))) + (right (transform-painter painter2 + (make-vect 0.5 0) + (make-vect 1 0) + (make-vect 0.5 1)))) + (lambda (frame) + (left frame) + (right frame)))) +;在右侧递归排列 +(define (right-split painter n) ;生成新painter,右分n次 + (if (= n 0) + painter + (let ((smaller (right-split painter (- n 1)))) + (beside painter (below smaller smaller))))) +;在上侧递归排列 +(define (up-split painter n) ;生成新painter,右分n次 + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below (beside smaller smaller) painter)))) +;在右上递归排列 +(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)) + (top-right (corner-split painter (- n 1)))) + (beside (below top-left painter) (below top-right bottom-right)))))) +;将四个方块结合 +(define (square-of-four tl tr bl br) + (lambda (painter) + (let ((top (beside (tl painter) (tr painter))) (bottom (beside (bl painter) (br painter)))) + (below top bottom)))) +;square-limit +(define (square-limit painter n) + (let ((combine4 (square-of-four flip-horz identity + rotate180 flip-vert))) + (combine4 (corner-split painter n)))) + +;drawLine +(define linesToDraw '()) +(define (draw-line a b) + (set! linesToDraw (cons (make-segment a b) linesToDraw))) + +;处理小人的数据 +(define figure + (list + (list (make-vect 0 26) + (make-vect 6 17) + (make-vect 12 25) + (make-vect 14 21) + (make-vect 10 0)) + (list (make-vect 16 0) + (make-vect 21 13) + (make-vect 25 0)) + (list (make-vect 31 0) + (make-vect 25 19) + (make-vect 41 6)) + (list (make-vect 41 15) + (make-vect 31 27) + (make-vect 25 27) + (make-vect 27 35) + (make-vect 25 41)) + (list (make-vect 16 41) + (make-vect 14 35) + (make-vect 16 27) + (make-vect 12 27) + (make-vect 6 25) + (make-vect 0 35)))) +(define figure-segments (scale-segments (point->segments figure) 0.024)) + +;开始画图 +(define wave (flip-vert (segments->painter figure-segments))) +(define frame1 (make-frame (make-vect 0 0) (make-vect 400 0) (make-vect 0 400))) +((square-limit wave 4) frame1) +(define frame2 (make-frame (make-vect 500 0) (make-vect 300 50) (make-vect 150 300))) +((beside wave (flip-horz (rotate180 wave))) frame2) + +;创建窗体及画布 +(define frame (new frame% [label "萌萌的小人"] [width 1000] [height 500])) +(new canvas% [parent frame] + [paint-callback + (lambda (canvas dc) + (send dc set-pen "red" 1 'solid) + (for-each + (lambda (line) + (let ((p1 (start-segment line)) + (p2 (end-segment line))) + (send dc draw-line + (xcor-vect p1) (ycor-vect p1) + (xcor-vect p2) (ycor-vect p2)))) + linesToDraw))]) +(send frame show #t) \ No newline at end of file diff --git "a/\351\231\210\344\271\220\345\244\251/Week4/homework4-1.rkt" "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-1.rkt" new file mode 100644 index 0000000..885bb49 --- /dev/null +++ "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-1.rkt" @@ -0,0 +1,34 @@ +#lang racket + +(define (min a b) + (if (< a b) + a + b)) +(define (doWork a b result) + (define (find-min x nowmin now) + (if (= now (- (length x) 1)) + (min nowmin (list-ref x now)) + (if (< (list-ref x now) nowmin) + (find-min x (list-ref x now) (+ now 1)) + (find-min x nowmin (+ now 1))))) + (cond ((and (empty? a) (empty? b)) (displayln result)) + ((empty? a) + (define minb (find-min b (car b) 0)) + (define minNumber minb) + (doWork (filter (lambda (num) (not (= num minNumber))) a) (filter (lambda (num) (not (= num minNumber))) b) (append result (list minNumber)))) + ((empty? b) + (define mina (find-min a (car a) 0)) + (define minNumber mina) + (doWork (filter (lambda (num) (not (= num minNumber))) a) (filter (lambda (num) (not (= num minNumber))) b) (append result (list minNumber)))) + (else + (define mina (find-min a (car a) 0)) + (define minb (find-min b (car b) 0)) + (define minNumber (min mina minb)) + (doWork (filter (lambda (num) (not (= num minNumber))) a) (filter (lambda (num) (not (= num minNumber))) b) (append result (list minNumber)))))) +(define (myloop) + (let ((a (read)) + (b (read))) + (if (eq? a eof) + (void) + (begin (doWork a b (list)) (myloop))))) +(myloop) diff --git "a/\351\231\210\344\271\220\345\244\251/Week4/homework4-2.rkt" "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-2.rkt" new file mode 100644 index 0000000..0309f06 --- /dev/null +++ "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-2.rkt" @@ -0,0 +1,128 @@ +#lang racket + +(define (generate-huffman-tree lst) + (define leaf-set (make-leaf-set lst)) + (define (generater node) + (if (null? (cdr node)) + (car node) + (begin + (let ((one (car node)) + (two (cadr node))) + (define newNode (make-code-tree one two)) + (generater (adjoin-set newNode (cddr node))))))) + (generater leaf-set)) + +(define (encode str tree) + (define (isin? x tree) + (define sym (symbols tree)) + (define (find x syms) + (if (null? syms) + #f + (if (equal? (symbol->string (car syms)) (string x)) + #t + (find x (cdr syms))))) + (find x sym)) + (define (encode-1 codes sub-tree) + (if (null? codes) + '() + (if (leaf? sub-tree) + (encode-1 (cdr codes) tree) + (if (isin? (car codes) (left-branch sub-tree)) + (cons 0 (encode-1 codes (left-branch sub-tree))) + (cons 1 (encode-1 codes (right-branch sub-tree))))))) + (define charlist (string->list (symbol->string str))) + (encode-1 charlist tree)) + + +(define (make-leaf symbol weight) + (list 'leaf symbol weight)) + +(define (leaf? object) + (eq? (car object) 'leaf)) + +(define (symbol-leaf x) (cadr x)) +(define (weight-leaf x) (caddr x)) + +(define (make-code-tree left right) + (list left + right + (append (symbols left ) (symbols right)) + (+ (weight left) (weight right)))) + +(define (left-branch tree) (car tree)) +(define (right-branch tree) (cadr tree)) +(define (symbols tree) + (if (leaf? tree) + (list (symbol-leaf tree)) + (caddr tree))) + +(define (weight tree) + (if (leaf? tree) (weight-leaf tree) + (cadddr tree))) + + + +(define (decode bits tree) + (define (decode-1 bits current-branch) + (if (null? bits) + '() + (let ((next-branch + (choose-branch (car bits) current-branch))) + (if (leaf? next-branch) + (cons (symbol-leaf next-branch) + (decode-1 (cdr bits) tree)) + (decode-1 (cdr bits) next-branch))))) + (decode-1 bits tree)) + +(define (choose-branch bit branch) + (cond ((= bit 0) (left-branch branch)) + ((= bit 1) (right-branch branch)) + (else (error "bad bit " bit)))) + + +(define (adjoin-set x set) +; (display "in adjoin-set:" ) (display "x=") (display x) (display " set=" ) (display set) (newline);addfor debug + (cond ((null? set) (list x)) + ((< (weight x) (weight (car set))) (cons x set)) + (else (cons (car set) + (adjoin-set x (cdr set)))))) + + +(define (make-leaf-set pairs) +; (display "in make-leaf-set:" ) (display pairs) (newline) ;addfor debug + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) + (cadr pair)) + (make-leaf-set (cdr pairs)))))) + + +;(define (my-number->list num) +; (if (< num 10) +; (cons num '()) +; (append (my-number->list (floor (/ num 10))) (list (remainder num 10))))) +;(define tmp '((A 10000000) (B 1000000) (C 100000) (D 10000) (E 1000) (F 100) (G 10) (H 1))) +;(define tmptmp (make-leaf-set tmp)) +;(define mytree (generate-huffman-tree tmp)) +;(encode 'ABEFG mytree) + + +(define huffman-tree '()) +(define (myloop) + (define (display-list lst) + (if (null? lst) + (void) + (begin (display (car lst)) (display-list (cdr lst))))) + + (let ((a (read))) + (if (eq? a eof) + (void) + (cond ((eq? a 'B) + (set! huffman-tree (generate-huffman-tree (read))) (myloop)) + ((eq? a 'E) + (display-list (decode (encode (read) huffman-tree) huffman-tree)) + (newline) + (myloop)))))) + +(myloop) \ No newline at end of file diff --git "a/\351\231\210\344\271\220\345\244\251/Week4/homework4-3.rkt" "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-3.rkt" new file mode 100644 index 0000000..2f30978 --- /dev/null +++ "b/\351\231\210\344\271\220\345\244\251/Week4/homework4-3.rkt" @@ -0,0 +1,98 @@ +#lang racket + + +(define (createList a) + (if (list? a) + a + (list a))) + +(define (variable? exp) (symbol? exp)) + +(define (same-variable? v1 v2) + (and (variable? v1) (variable? v2) (eq? v1 v2))) + +(define (sum? exp) + (define (findPlus now) + (if (null? now) + #f + (if (eq? (car now) '+) + #t + (findPlus (cdr now))))) + (if (pair? exp) + (findPlus exp) + #f)) + +(define (make-sum a1 a2) + (cond ((=number? a1 0) a2) + ((=number? a2 0) a1) + ((and (number? a1) (number? a2)) (+ a1 a2)) (else (append (createList a1) (list '+) (createList a2))))) + +(define (addend exp) + (define (plusBefore now) + (if (eq? (car now) '+) + '() + (cons (car now) (plusBefore (cdr now))))) + (define beforeExp (plusBefore exp)) + (if (null? (cdr beforeExp)) + (car beforeExp) + beforeExp)) + +(define (augend exp) + (define (plusAfter now) + (define (plusAfterReally now) + (if (null? now) + '() + (cons (car now) (plusAfterReally (cdr now))))) + (if (eq? (car now) '+) + (plusAfterReally (cdr now)) + (plusAfter (cdr now)))) + (define afterExp (plusAfter exp)) + (if (null? (cdr afterExp)) + (car afterExp) + afterExp)) + +(define (product? exp) (and (pair? exp) (eq? (cadr exp) '*))) + +(define (make-product a1 a2) + (cond ((or (=number? a1 0) (=number? a2 0)) 0) + ((=number? a1 1) a2) + ((=number? a2 1) a1) + ((and (number? a1) (number? a2)) (* a1 a2)) (else (list a1 '* a2)))) + +(define (multiplicand exp) + (if (null? (cdddr exp)) + (caddr exp) + (cddr exp))) + +(define (multiplier exp) (car exp)) + +(define (=number? a b) + (if (number? a) + (if (= a b) + #t + #f) + #f)) + +(define (deriv exp var) + (cond ((number? exp ) 0) + ((variable? exp) + (if (same-variable? exp var) 1 0)) + ((sum? exp) + (make-sum (deriv (addend exp) var) + (deriv (augend exp) var))) + ((product? exp) + (make-sum + (make-product (multiplier exp) + (deriv (multiplicand exp) var)) + (make-product (deriv (multiplier exp) var) + (multiplicand exp)))) + (else + (error "wrong format")))) + +(define (myloop) + (let ((a (read))) + (if (eq? a eof) + (void) + (begin (display (deriv a 'x)) (newline) (myloop))))) + +(myloop) \ No newline at end of file