2010/10/04

plus1

学生さんもカッコだらけの言語が宿題に出るなんて大変ですね。
;; (plus1 5) => error 発生
;; (plus1 '()) => ()
;; (plus1 '(5)) => (6)
;; (plus1 '(1 2 3 7)) => (2 3 4 8)

;; map
(define (plus1 ls)
  (map (lambda (n)
         (+ n 1)) ls))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; unfold
(use srfi-1)
(define (plus1 ls)
  (unfold null?
          (lambda (ls)
            (+ (car ls) 1))
          cdr ls))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; recursive
(define (plus1 ls)
  (if (null? ls)
      '()
      (cons (+ 1 (car ls))
            (plus1 (cdr ls)))))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; tail call recursive
(define (plus1 ls)
  (let rec ((ls ls)(acc '()))
    (if (null? ls)
        (reverse acc)
        (rec (cdr ls)(cons (+ (car ls) 1) acc)))))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)





;; (min 5) => error発生
;; (min '()) => error
;; (min '(20 15)) => 15
;; (min '(30 5 90 25)) => 5

(define (min ls)
  (if (null? ls)
      (error)
      (fold (lambda (e ret)
              (if (< e ret)
                  e
                  ret))(car ls) ls)))

(min 5)
;; error
(min '())
;; error
(min '(20 15))
;; 15
(min '(30 5 90 25))
;; 5

(define (min ls)
  (if (null? ls)
      (error)
      (let rec ((ls ls)(ret (car ls)))
        (if (null? ls)
            ret
            (rec (cdr ls)(if (< (car ls) ret)
                             (car ls)
                             ret))))))

(min 5)
;; error
(min '())
;; error
(min '(20 15))
;; 15
(min '(30 5 90 25))
;; 5
The Little Schemer, 4th Edition

0 件のコメント:

コメントを投稿