Quantcast
Channel: 懒得折腾
Viewing all articles
Browse latest Browse all 764

Programming Languages Programming Assignment 4

$
0
0
#lang racket
(define ones (lambda () (cons 1 ones)))
(define nats
  (letrec ([f (lambda (x) (cons x (lambda () (f (+ x 1)))))])
    (lambda () (f 1))))
(define powers-of-two
  (letrec ([f (lambda (x) (cons x (lambda () (f (* x 2)))))])
    (lambda () (f 2))))

(define (sequence low high stride)
  (if (> low high)
      null
      (cons low (sequence (+ low stride) high stride))))

(define (string-append-map xs suffix)
  (map (lambda (str) (string-append str suffix))
       xs))

(define (list-nth-mod xs n)
  (cond [(< n 0) (error "list-nth-mod: negative number")]
        [(null? xs) (error "list-nth-mod: empty list")]
        [#t (let 
              ([i (remainder n (length xs))]) 
              (car (list-tail xs i))
             )]))

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

(define (stream-maker fn arg)
  (letrec ([f (lambda (x)
                (cons x (lambda () (f (fn x arg)))))])
     (lambda () (f arg))))

(define funny-number-stream (stream-maker (lambda (x y) (cond [(= (remainder x 5) 4) (- (+ x 1))]
                                                              [(= (remainder x 5) 0) (- (- x 1))]
                                                              [#t (+ x 1)])) 1))

(define dan-then-dog (stream-maker (lambda (x y) (cond [(equal? x "dan.jpg") "dog.jpg"]
                                                       [#t "dan.jpg"])) "dan.jpg"))	

(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-ref xs (remainder n (length xs))) 
                            (list-ref ys (remainder n (length ys)))) 
                      (lambda () (f (+ n 1)))))])
     (lambda () (f 0))))

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

(define (cached-assoc xs n)
  (letrec([memo (make-vector n #f)]
          [curIdx 0]
          [f (lambda (x)
             (let ([ans (vector-assoc x memo)])
               (if ans
                 ans
                 (let ([new-ans (assoc x xs)])
                   (if new-ans 
                       (begin (vector-set! memo curIdx new-ans) 
                                      (set! curIdx (remainder (+ curIdx 1) n)) 
                                      new-ans) 
                       #f)
                   ))))])
  f))


Viewing all articles
Browse latest Browse all 764

Trending Articles