未经作者许可禁止转载
本文地址:https://jxcn.org/2022/11/htdp/

看了几天SICP没看明白,于是决定先看看HtDP,感觉scheme的入门书籍还挺有意思的

11.4 阶乘

#lang racket

(require racket/trace)
(define (sub1 x) (- x 1))
(trace-define (! x)
  (trace-let !-helper ([y x] [val 1]) 
  (cond
    [(zero? y) val]
    [else (!-helper (sub1 y) (* val y))]
    )))

(trace-define (o! x)
  (cond
    [(zero? x) 1]
    [else (* x (o! (sub1 x)))]
    ))

12.4 单词重列

#lang racket
(require racket/trace)
; x + () = ()
; x + (a) = (xa ax)
; x + (b a) = ((b (x + (a))) (x (b a)))

;; list of word -> list of word
;; a (x y z) -> (ax ay az)
(define (concat-word a low)
  (cond
    [(empty? low) empty]
    [else (append (list (cons a (first low))) (concat-word a (rest low)))]
))

;; word -> list of word
(define (insert-inword a word)
  (cond
    [(empty? word) (list (list a))]
    [else (append (list (cons a word)) (concat-word (first word) (insert-inword a (rest word))))]
    ))

;; list of word -> list of word
;; insert a in list of word
(define (insert-inlist a list-of-word)
  (cond
    [(empty? list-of-word) empty]
    [else (append (insert-inword a (first list-of-word)) (insert-inlist a (rest list-of-word)))]
  ))

;; word : '(a b c)
;; arrangements: works -> list-of-words
;; create list of a-word
(define (arrangement a-word)
  (cond
    [(empty? a-word) empty]
    [(empty? (cdr a-word)) (list a-word)]
    [else (insert-inlist (first a-word) (arrangement (cdr a-word)))]
    ))

14.2 二叉搜索树

#lang racket

(struct node (ssn name left right)
  #:methods gen:custom-write
  [(define (write-proc node-val output-port output-mode)
     (fprintf output-port "#<node:~a ~a L:~a R:~a>" (node-ssn node-val)
              (node-name node-val)
              (node-left node-val)
              (node-right node-val)))])


(define (inorder BT)
  (cond
    [(and (boolean? BT) (false? BT)) empty]
    ; (inorder BT-left) + BT + (inorder BT-right)
    [else (append (inorder (node-left BT)) (list BT) (inorder (node-right BT)))]
    )
  )

; 
(define (search-bst B n)
  (cond
    [(and (boolean? B) (false? B)) #f]
    [(= (node-ssn B) n) (node-name B)]
    [else (or (search-bst (node-left B) n) (search-bst (node-right B) n))]
    ))

; create a BST base on BST B
(define (create-bst B SSN Name)
  (cond
    [(eq? B #f) (node SSN Name #f #f)]
    [else 
     (cond
       [(< SSN (node-ssn B))
        (node (node-ssn B)
              (node-name B)
              (create-bst (node-left B) SSN Name)
              (node-right B))]
       [(> SSN (node-ssn B))
        (node (node-ssn B)
              (node-name B)
              (node-left B)
              (create-bst (node-right B) SSN Name)
              )]
       )]
    ))

(define (create-bst-from-list l)
  (cond
    [(empty? l) #f]
    [else (create-bst (create-bst-from-list (cdr l)) (caar l) (cdar l))]
    )
  )

16.3 目录树

#lang racket


(struct dir (name dirs files))
(struct file (name size content)
    #:methods gen:custom-write
  [(define (write-proc node-val output-port output-mode)
     (fprintf output-port "#<file:~a>" (file-name node-val)
))])


(define (how-many-file lof)
  (cond
    [(empty? lof) 0]
    [else (+ 1 (how-many-file (cdr lof)))]
    ))

(define (how-many-file-indirs lod)
  (cond
    [(empty? lod) 0]
    [else (+ (how-many (car lod)) (how-many-file-indirs (cdr lod))) ]
    ))

(define (how-many d)
  (+ (how-many-file (dir-files d)) (how-many-file-indirs (dir-dirs d)))
  )

(define (size-files files)
  (cond
    [(empty? files) 0 ]
    [else (+ (file-size (car files)) (size-files (cdr files)))]
    ))

(define (size-dirs dirs)
  (cond
    [(empty? dirs) 0]
    [else (+ (du-dir (car dirs)) (size-dirs (cdr dirs)))]
    ))

(define (du-dir d)
  (+ (size-files (dir-files d)) (size-dirs (dir-dirs d))))


(require racket/trace)

(define (find-files files name)
  (cond
    [(empty? files) #f]
    [(symbol=? name (file-name (car files))) #t]
    [else (find-files (cdr files) name)]
    ))

; find name in dirs, return list or false
; empty -> false
; if found in a dir return (cons + (find dirs))
(define (find-dirs dirs name)
  (cond
    [(empty? dirs) #f]
    [(find-files (dir-files (first dirs)) name) (list (dir-name (first dirs)))]
    [(list? (find (first dirs) name)) (cons (dir-name (first dirs)) (find-dirs (dir-dirs (first dirs)) name))]
    [else (find-dirs (cdr dirs) name)]
    )
)


; find name in dir, return list or false
; (find d name) = find files -> return d -> ()
(define (find d name)
  (cond
    [(find-files (dir-files d) name) (list (dir-name d))]
    [(list? (find-dirs (dir-dirs d) name)) (cons (dir-name d) (find-dirs (dir-dirs d) name))]
    [else #f]
  ))


(define make-file file)
(define make-dir dir)

;; files: 
(define hang (make-file 'hang 8 empty))
(define draw (make-file 'draw 2 empty))
(define read (make-file 'read! 19 empty))
(define one  (make-file 'part1 99 empty))
(define two  (make-file 'part2 52 empty))
(define thre (make-file 'part3 17 empty))
(define rdme (make-file 'read 10 empty))

;; directories: 
(define Code (make-dir 'Code '() (list hang draw)))
(define Docs (make-dir 'Docs '() (list read)))
(define Libs (make-dir 'Libs (list Code Docs) '()))
(define Text (make-dir 'Text '() (list one two thre)))
(define Top  (make-dir 'TS (list Text Libs) (list rdme)))

22.3.1 list->number

;; 其实这里可以用foldr
;; (foldr (lambda (digit num) (+ (* num 10) digit)) 0 lod)
;; 但是foldr不是尾调用,虽然看起来更简单
(define (build-number x)
  (local ((define (build-number-helper lod num)
  (cond
    [(empty? lod) num]
    [else (build-number-helper (cdr lod) (+ (car lod) (* num 10))) ]
    )))
  (build-number-helper x 0))
)

22.2.3 pad->gui

(require htdp/gui)

;; pad->gui : (listof (listof number|symbol))  ->  (listof (listof gui-item))
;; convert a list of number|symbol list to gui-item list. 
;; the first row displays the latest button that the user clicked.
;; others are button genrate base on argument.
(define (pad->gui pad)
  (local 
    ((define val (make-message "N")))
    (cons (list val)
          (map
           (lambda (x)
             (map
              (lambda (x)
                ((lambda (x) (make-button x (lambda (e) (draw-message val x))))
                 (cond
                   [(symbol? x) (symbol->string x)]
                   [(number? x) (number->string x)]
                   [else "unknow"]
                   ))
                ) x)) pad))
    )
  )

;; Example
(define pad
  '((1 2 3)
    (4 5 6)
    (7 8 9)
    (\# 0 *)))
   	
(define pad2 
  '((1 2 3  +)
    (4 5 6  -)
    (7 8 9  *)
    (0 = \. /)))
(create-window (append (list (list (make-message "Calculator"))) (pad->gui pad)))

23.1.1 series-local

;; series: (number -> number) -> ((number -> number))
;; input a sequence function, return a function return sum of sequence.
(define (series-local f)
  (local
    ((define (series n)
       (cond
    [(= n 0) (f n)]
    [else (+ (f n) 
	     (series (- n 1)))])
       ))
    series
    )
)

(define (make-even i)
  (* 2 i))

((series-local make-even) 10)

23.2 arithmetic sequence

(define (a-fives n)
  (cond
    [(= n 0) (+ 3 5)]
    [else (+ 5 (a-fives (- n 1)))]
    )
  )

(define (a-fives-closed n)
  (+ (* n 5) (+ 3 5)))

(define (my-build-list n f)
  (cond
    [(= n 0) (list (f 0))]
    [else (append (my-build-list (- n 1) f) (list (f n)))]
  ))

(define (seq-g-fives n)
  (my-build-list n a-fives)
  )

;; example
(seq-g-fives 10)

(define (arithmetic-series start s)
  (local
    ((define (a n)
       (+ (* n 5) (+ start s))))
       
  a
    ))

((arithmetic-series 0 2) 10)