这次回顾HW1，主要是熟悉Racket的基本语法。

课程主页：

https://www.coursera.org/learn/programming-languages-part-b/home

B站搬运：

https://www.bilibili.com/video/BV1tZ4y1D7

代码


#lang racket

(provide (all-defined-out)) ;; so we can put tests in a second file

;; put your code below

; 1
(define (sequence low high stride)
  (cond [(> low high) null]
        [#t (cons low (sequence (+ low stride) high stride))]))

; 2
(define (string-append-map xs suffix)
  (map (lambda (x) (string-append x suffix)) xs))

; 3
(define (list-nth-mod xs n)
  (define (helper xs i)
    (if (= i 0)
      (car xs)
      (helper (list-tail xs) (- i 1))))
  (let ([l (length xs)])
    (cond [(< n 0) (error "list-nth-mod: negative number")]
          [(= l 0) (error "list-nth-mod: empty list")]
          [#t (car (list-tail xs (remainder n l)))])))

; 4
(define (stream-for-n-steps s n)
  (if (= n 0)
    null
    (cons (car (s)) (stream-for-n-steps (cdr (s)) (- n 1)))))

; 5
(define funny-number-stream
  (letrec ([f (lambda (x) 
            (if (= (remainder x 5) 0)
              (cons (- x) (lambda () (f (+ x 1))))
              (cons x (lambda () (f (+ x 1))))))])
    (lambda () (f 1))))

; 6
(define dan-then-dog
  (letrec ([f (lambda (x) 
            (if (= (remainder x 2) 1)
              (cons "dan.jpg" (lambda () (f (+ x 1))))
              (cons "dog.jpg" (lambda () (f (+ x 1))))))])
    (lambda () (f 1))))

; 7
(define (stream-add-zero s)
  (lambda () (cons (cons 0 (car (s))) (stream-add-zero (cdr (s))))))

; 8
(define (cycle-lists xs ys)
  (letrec ([f (lambda (n) 
              (cons (cons (list-nth-mod xs n) (list-nth-mod ys n)) (lambda () (f (+ n 1)))))])
    (lambda () (f 0))))

; 9
(define (vector-assoc v vec)
  (letrec ([l (vector-length vec)]
           [f (lambda (i)
                (cond [(= i l) #f]
                      [(let ([x (vector-ref vec i)])
                        (and (cons? x) (equal? v (car x)))) (vector-ref vec i)]
                      [#t (f (+ i 1))]))])
    (f 0)))

; 10
(define (cached-assoc xs n)
  (let ([memo (make-vector n #f)]
        [index 0])
    (lambda (v) 
      (let ([r1 (vector-assoc v memo)])
        (if (equal? r1 #f)
          (let ([r2 (assoc v xs)])
            (begin
              (vector-set! memo index r2)
              (set! index (remainder (+ index 1) n)))
              r2)
          r1)))))

; 11
(define-syntax while-less
  (syntax-rules (do)
    [(while-less e1 do e2)
     (let ([a e1])
       (letrec ([loop (lambda ()
                        (let ([res e2])
                          (if (< res a)
                              (loop)
                              #t)))])
         (loop)))]))

测试

#lang racket
;; Programming Languages Homework4 Simple Test
;; Save this file to the same directory as your homework file
;; These are basic tests. Passing these tests does not guarantee that your code will pass the actual homework grader

;; Be sure to put your homework file in the same folder as this test file.
;; Uncomment the line below and change HOMEWORK_FILE to the name of your homework file.
;;(require "HOMEWORK_FILE")

(require rackunit)
(require "01_homework-4-auto-grader_hw4.rkt")

;; Helper functions
(define ones (lambda () (cons 1 ones)))
(define a 2)
(define powers-of-two
  (letrec ([f (lambda (x) (cons x (lambda () (f (* x 2)))))])
    (lambda () (f 2))))

(define tests
  (test-suite
   "Sample tests for Assignment 4"
   
   ; sequence test
   (check-equal? (sequence 0 5 1) (list 0 1 2 3 4 5) "Sequence test")
   (check-equal? (sequence 3 11 2) (list 3 5 7 9 11) "Sequence test")
   (check-equal? (sequence 3 8 3) (list 3 6) "Sequence test")
   (check-equal? (sequence 3 2 1) null "Sequence test")

   ; string-append-map test
   (check-equal? (string-append-map 
                  (list "dan" "dog" "curry" "dog2") 
                  ".jpg") '("dan.jpg" "dog.jpg" "curry.jpg" "dog2.jpg") "string-append-map test")
   
   ; list-nth-mod test
   (check-equal? (list-nth-mod (list 0 1 2 3 4) 2) 2 "list-nth-mod test")
   ; 手动测试
   ; (list-nth-mod (list 0 1 2 3 4) -1)
   ; (list-nth-mod null 5)
   
  ;  ; stream-for-n-steps test
   (check-equal? (stream-for-n-steps ones 2) (list 1 1) "stream-for-n-steps test")
   (check-equal? (stream-for-n-steps powers-of-two 4) (list 2 4 8 16) "stream-for-n-steps test")
   
   ; funny-number-stream test
   (check-equal? (stream-for-n-steps funny-number-stream 16) (list 1 2 3 4 -5 6 7 8 9 -10 11 12 13 14 -15 16) "funny-number-stream test")
   
   ; dan-then-dog test
   (check-equal? (stream-for-n-steps dan-then-dog 1) (list "dan.jpg") "dan-then-dog test")
   (check-equal? (stream-for-n-steps dan-then-dog 4) (list "dan.jpg" "dog.jpg" "dan.jpg" "dog.jpg") "dan-then-dog test")
   
   ; stream-add-zero test
   (check-equal? (stream-for-n-steps (stream-add-zero ones) 1) (list (cons 0 1)) "stream-add-zero test")
   (check-equal? (stream-for-n-steps (stream-add-zero powers-of-two) 3) (list (cons 0 2) (cons 0 4) (cons 0 8)) "stream-add-zero test")

   ; cycle-lists test
   (check-equal? (stream-for-n-steps (cycle-lists (list 1 2 3) (list "a" "b")) 3) (list (cons 1 "a") (cons 2 "b") (cons 3 "a")) 
                 "cycle-lists test")
   (check-equal? (stream-for-n-steps (cycle-lists (list 1 2 3) (list "a" "b")) 6) (list (cons 1 "a") (cons 2 "b") (cons 3 "a")  (cons 1 "b") (cons 2 "a") (cons 3 "b"))
                 "cycle-lists test")
   
   ; vector-assoc test
   (check-equal? (vector-assoc 4 (vector (cons 2 1) (cons 3 1) (cons 4 1) (cons 5 1))) (cons 4 1) "vector-assoc test")
   (check-equal? (vector-assoc 6 (vector (cons 2 1) (cons 3 1) (cons 4 1) (cons 5 1))) #f "vector-assoc test")
   ; cached-assoc tests
   (check-equal? ((cached-assoc (list (cons 1 2) (cons 3 4)) 3) 3) (cons 3 4) "cached-assoc test")
   (check-equal? ((cached-assoc (list (cons 1 2) (cons 3 4)) 3) 3) (cons 3 4) "cached-assoc test")
   
   ; while-less test
   (check-equal? (while-less 7 do (begin (set! a (+ a 1)) a)) #t "while-less test")
   (check-equal? (while-less 7 do (begin (set! a (+ a 1)) a)) #t "while-less test")
   ))

(require rackunit/text-ui)
;; runs the test
(run-tests tests)

运行结果：

21 success(es) 0 failure(s) 0 error(s) 21 test(s) run