Scheme - Land of Scheme - LISP は対称なり - より進んだデータ型とジェネリックプログラミング(データをジェネリックに扱う、シーケンスを使う、探索のためのシーケンス関数)

Land of Lisp
(オライリージャパン)
M.D. Conrad Barski (著) 川合 史朗 (翻訳)
原書: Land of LISP
Learn to Program in Lisp, One Game at a Time!

開発環境

• OS X El Capitan - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• kscheme (github), Gauche, MIT/GNU Scheme, GNU Guile (処理系)

Land of Lisp (M.D. Conrad Barski (著)、川合 史朗 (翻訳)、オライリージャパン)の第2部(LISP は対称なり)、9章(より進んだデータ型とジェネリックプログラミング)、9.4(データをジェネリックに扱う、シーケンスを使う、探索のためのシーケンス関数)を Scheme で取り組んでみる。

9.4(データをジェネリックに扱う、シーケンスを使う、探索のためのシーケンス関数)

コード(Emacs)

(begin
  (define (for-each proc . lists)
    (define (exist-null? list-of-list)
      (if (null? list-of-list)
          #f
          (let ((lst (car list-of-list)))
            (if (null? lst)
                #t
                (exist-null? (cdr list-of-list))))))
    (define (heads list-of-list)
      (define (iter list-of-list)
        (if (null? list-of-list)
            '()
            (let ((lst (car list-of-list)))
              (if (not (pair? lst))
                  (display "error")
                  (cons (car lst)
                        (iter (cdr list-of-list)))))))
      (if (or (null? list-of-list)
              (exist-null? list-of-list))
          '()
          (iter list-of-list)))
    (define (rests list-of-list)
      (define (iter list-of-list)
        (if (null? list-of-list)
            '()
            (let ((lst (car list-of-list)))
              (if (not (pair? lst))
                  (display "error")
                  (cons (cdr lst)
                        (iter (cdr list-of-list)))))))
      (if (or (null? list-of-list)
              (exist-null? list-of-list))
          '()
          (iter list-of-list)))
    (define (iter list-of-list)
      (let ((args (heads list-of-list)))
        (if (null? args)
            '()
            (begin (apply proc args)
                   (iter (rests list-of-list))))))
    (if (null? lists)
        (display "error")
        (iter lists))
    ;; undefined
    (if #f #f))

  (define print (lambda (obj) (display obj) (newline)))


  (define (sequence? obj) (or (list? obj) (string? obj) (vector? obj)))
  (define (sequence->list obj)
    (if (not (sequence? obj))
         (begin (display "Invalid type: sequence->list -- ")
                (print obj))
         (cond ((list? obj) obj)
               ((string? obj) (string->list obj))
               ((vector? obj) (vector->list obj)))))
  (define generic-length
    (lambda (obj)
      (if (sequence? obj)
          (length (sequence->list obj))
          (begin (display "Invalid type: generic-length -- ")
                 (print obj)))))
  
  (for-each (lambda (obj)
              (display obj)
              (display ": ")
              (print (generic-length obj)))
            (list '(a b c) "blub" (make-vector 5 0)))

  (define (find-if pred seq)
    (cond ((null? seq) #f)
          ((pred (car seq)) (car seq))
          (else (find-if pred (cdr seq)))))

  (print (find-if number? '(a b 5 d)))

  (define (count obj seq)    
    (define (iter seq n)
      (cond ((null? seq) n)
            ((eqv? obj (car seq))
             (iter (cdr seq) (+ n 1)))
            (else (iter (cdr seq) n))))
    (if (sequence? seq)
        (iter (sequence->list seq) 0)
        (begin (display "Invalid type: count -- ")
               (print seq))))

  (print (count #\s "mississippi"))
  
  (define (position obj seq)
    (define (iter seq n)
      (cond ((null? seq) n)
            ((eqv? obj (car seq)) n)             
            (else (iter (cdr seq) (+ n 1)))))
    (if (sequence? seq)
        (iter (sequence->list seq) 0)
        (begin (display "Invalid type: position -- ")
               (print seq))))

  (print (position #\4 "2kewl4skewl"))

  (define (some pred seq)
    (define (iter seq)
      (cond ((null? seq) #f)
            ((pred (car seq)) #t)
            (else (iter (cdr seq)))))
    (if (sequence? seq)
        (iter (sequence->list seq))
        (begin (display "Invalid type: some -- ")
               (print seq))))
  
  (print (some number? '(a b 5 d)))

  (define (every pred seq)
    (if (some (lambda (obj) (not (pred obj))) seq)
        #f
        #t))

  (print (every number? '(a b 5 d)))
  )

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ ./kscheme sample4.scm
(a b c): 3
blub: 4
#(0 0 0 0 0): 5
5
4
5
#t
#f
$