gauche fold,reduce,fold-pair,unfold

どんなもんかなーと。

• Gauche ユーザリファレンス: 10.2 srfi-1 - List library
• Making The Road Wiki  - Programming::Scheme::SRFI1

;; Gauche ユーザリファレンス: 10.2 srfi-1 - List library http://practical-scheme.net/gauche/man/gauche-refj_102.html#SEC310
;; Making The Road Wiki  - Programming::Scheme::SRFI1 http://ow.ly/13jo0
;; fold
(fold +
      0
      '(1 2 3 4 5))
; -> 15
(fold cons
      '()
      '(1 2 3 4 5))
; -> (5 4 3 2 1)
(fold (lambda (e l)
        (display (format "~a : ~a" e l))
        (newline)
        (cons e l))
      '()
      '(1 2 3 4 5))
;; 1 : ()
;; 2 : (1)
;; 3 : (2 1)
;; 4 : (3 2 1)
;; 5 : (4 3 2 1)
;; (5 4 3 2 1)
;; fold-right
(fold-right cons
            '()
            '(1 2 3 4 5))
; -> (1 2 3 4 5)
(fold-right cons
            '()
            '(5 4 3 2 1))
; -> (5 4 3 2 1)
(fold-right (lambda (e l)
              (display (format "~a : ~a" e l))
              (newline)
              (cons e l))
            '()
            '(1 2 3 4 5))
;; 5 : ()
;; 4 : (5)
;; 3 : (4 5)
;; 2 : (3 4 5)
;; 1 : (2 3 4 5)
;; (1 2 3 4 5)
;; pair-fold
; [SRFI-1] fold および fold-right と同様ですが、kons 手続き は与えられた clist の car ではなく、cdr をとります。
; Gauche ユーザリファレンス: 10.2 srfi-1 - List library http://practical-scheme.net/gauche/man/gauche-refj_102.html#SEC310
(use srfi-1)
;; pair-fold
(pair-fold (lambda (e l)
             (display (format "~a : ~a" e l))
             (newline)
             e)
           '()
           '(1 2 3 4 5))
;; (1 2 3 4 5) : ()
;; (2 3 4 5) : (1 2 3 4 5)
;; (3 4 5) : (2 3 4 5)
;; (4 5) : (3 4 5)
;; (5) : (4 5)
;; (5)
(use srfi-1)
;; pair-fold-right
(pair-fold-right (lambda (e l)
                   (display (format "~a : ~a" e l))
                   (newline)
                   e)
                 '()
                 '(1 2 3 4 5))
;; (5) : ()
;; (4 5) : (5)
;; (3 4 5) : (4 5)
;; (2 3 4 5) : (3 4 5)
;; (1 2 3 4 5) : (2 3 4 5)
;; (1 2 3 4 5)
;; reduce
; ridentityが使われるのはlistが空の場合だけです。
; Gauche ユーザリファレンス: 10.2 srfi-1 - List library http://practical-scheme.net/gauche/man/gauche-refj_102.html#SEC310
(reduce + 100 '(1 2 3 4 5))
; -> 15
(reduce + 100 '())
; -> 100
(reduce (lambda (e l)
          (display (format "~a : ~a" e l))
          (newline)
          (cons e l))
        "list is null"
        '(1 2 3 4 5))
;; 2 : 1
;; 3 : (2 . 1)
;; 4 : (3 2 . 1)
;; 5 : (4 3 2 . 1)
;; (5 4 3 2 . 1)
(reduce (lambda (e l)
          (display (format "~a : ~a" e l))
          (newline)
          (cons e l))
        "list is null"
        '())
; -> "list is null"
;; unfold p f g seed &optional tail-gen
;; (unfold p f g seed tail-gen) ≡
;;    (if (p seed)
;;        (tail-gen seed)
;;        (cons (f seed)
;;              (unfold p f g (g seed))))
; http://practical-scheme.net/gauche/man/gauche-refj_102.html#SEC310
(unfold null?
        car
        cdr
        '(1 2 3 4 5))
; -> (1 2 3 4 5)
(unfold null?
        (lambda (x)
          (cons (car x)(car x)))
        cdr
        '(1 2 3 4 5))
; -> ((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5))
        
(display (unfold null?
                 (lambda (x) x)
                 cdr
                 '(1 2 3 4 5)))
; -> ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5))#<undef>
(unfold null?
        (lambda (l)
          (* (car l)(car l)))
        cdr
        '(1 2 3 4 5))
; -> (1 4 9 16 25)

view raw fold,unfold,pair-fold,reduce.scm This Gist brought to you by GitHub.

; fold, fold-right
(fold (lambda (x y z)
        (display (format "x = ~a, y = ~a, z = ~a\n" x y z))
        (+ x y z)) 0 '(1 1 1) '(1 1 1))
;; x = 1, y = 1, z = 0
;; x = 1, y = 1, z = 2
;; x = 1, y = 1, z = 4
;; 6
(fold (lambda (m n o r)
        (display (format "m = ~a, n = ~a, o = ~a, r = ~a\n" m n o r))
        (+ m n o r)) 0 '(1 1 1) '(1 1 1) '(1 1 1))
;; m = 1, n = 1, o = 1, r = 0
;; m = 1, n = 1, o = 1, r = 3
;; m = 1, n = 1, o = 1, r = 6
;; 9
(fold-right (lambda (x y z)
              (display (format "x = ~a, y = ~a, z = ~a\n" x y z))
              (cons x (cons y z))) '() '(1 2 3) '(a b c))
;; x = 3, y = c, z = ()
;; x = 2, y = b, z = (3 c)
;; x = 1, y = a, z = (2 b 3 c)
;; (1 a 2 b 3 c)

view raw TheSeasonedSchemer.scm This Gist brought to you by GitHub.

• Karetta|Gaucheプログラミング(立読み版)|人に優しい出力
• Gauche ユーザリファレンス: 6.19 入出力