1. 程式人生 > >華盛頓大學程式設計語言B作業4

華盛頓大學程式設計語言B作業4

#lang racket


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

;; put your code below
(define (sequence low high stride)
  (if (> low high)
      null
      (cons low (sequence (+ low stride) high stride))))
(define (string-append-map xs suffix)
      (map (lambda (x) (string-append x suffix)) xs))

(define (list-nth-mod xs n)
  (if (< n 0)
      (error "list-nth-mod: negative number")
      (if (null? xs)
          (error "list-nth-mod: empty list")
          (car (list-tail xs (remainder n (length xs)))))))
(define (stream-for-n-steps s n)
  (if (= n 0)
      null
     (cons (car (s)) (stream-for-n-steps (cdr (s)) (- n 1)))))
(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))))
(define dan-then-dog
  (letrec ([dog-then-dan (lambda () (cons "dog.jpg" dan-then-dog))])
    (lambda () (cons "dan.jpg" dog-then-dan))))
(define (stream-add-zero s)
  (lambda () (cons (cons 0 (car (s))) (stream-add-zero (cdr (s))))))

(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)))))])
    (f 0)))

(define (vector-assoc v vec)
  (letrec ([helper (lambda(n) (if (< n (vector-length vec))
                                 (letrec ([x (vector-ref vec n)])
                                   (if (pair? x)
                                       (if (equal? (car x) v)
                                           x
                                           (helper (+ n 1)))
                                       (helper (+ n 1))))
                                 #f))])
           (helper 0)))

(define (cached-assoc xs n)
  (letrec ([cache (make-vector n #f)]
           [pos 0]
           [f (lambda(v)
                (let([exist (vector-assoc v cache)])
                  (if exist exist
                    (let ([newpair (assoc v xs)])
                      (if newpair
                        (begin (vector-set! cache pos newpair)
                               (if (= pos (- n 1)) (set! pos 0) (set! pos (+ pos 1)))
                               newpair)
                        #f)))))])
    f))
(define-syntax while-less
  (syntax-rules (do)
    [(while-less e1 do e2)
     (let ([a e1])
       (letrec ([loop (lambda()
                        (letrec ([b e2])
                          (if (< a b)
                              #t
                              (loop))))])
         (loop)))]))