yamasushi(2013/05/04 04:55:48 UTC)多値のコレクションです。
http://chaton.practical-scheme.net/gauche/a/2013/05/04#entry-5184950c-c6cb8
yamasushi
なぞの概念として「多値のコレクション」と書いてきましたが、とりあえず、形にしてみました。 http://practical-scheme.net/wiliki/wiliki.cgi?Gauche%3aExperimental%3aMultiCollection
多値は目に見えないもので、直積、タプルとして見えるのは、そういうふうに観測したからと解釈しました。つまり、観測できないデータ構造という考え方です。
これがあるとなにが嬉しいのかと問われると、困るのですが、ただイテレータが多値になったらどうなの？という自分への問いに答えてみたというか・・・
また、generatorは終端条件がeofオブジェクトなので、多値に拡張できないので、コレクションを使ってみたとも言えます。
;;; collection.scmを改造
;;; Shuji Yamamoto ("yamasushi")
;;; collection.scm - collection generics
;;;
;;; Copyright (c) 2000-2013 Shiro Kawai <shiro@acm.org>
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
; マニュアルより:
;--------------------------------------------------------------------------------------------
; call-with-iterator collection proc :key start
; 基礎となるイテレータ構築メソッドです。
; このメソッドはコレクションCOLLECTIONから繰り返しのための二つの手続きを作成し、
; それらを引数として手続きPROCを呼びます。
;
; 作られる最初の手続きは終了判定手続きで、引数無しで呼び出され、繰り返しが
; 終了していれば`#t'を、まだ要素が残っていれば`#f'を返します。
;
; 作られる二番目の手続きはインクリメント手続きで、呼ばれる度に現在の要素を返し、
; 内部のポインタを次の要素へと進めます。
;
; 終了判定手続きが`#t'を返した後にインクリメント手続きを呼んだ場合の動作は未定義です。
;
; コレクションがシーケンスでもある場合、インクリメント手続きはシーケンスの順番に要素を取り出します。
;
; キーワード引数STARTが与えられていればイテレーションの範囲は
; START番目の要素から最後の要素までとなります。シーケンスでないコレクションに
; 対してはSTART引数は意味を持ちません。
;--------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------
; call-with-builder collection-class proc :key size
; 基礎的なビルダー構築メソッドです。
; ビルダーはコレクションをインクリメンタルに作成する方法です。
; コレクションクラスによってはこの手続きを提供しないものもあります。
;
; COLLECTION-CLASSは作成されるコレクションのクラスです。
; このメソッドは、追加手続きと結果手続きの二つの手続きを作成し、それらを
; 引数としてPROCを呼びます。
;
; 追加手続きは *一つ* 引数を取り、それを作成中のコレクションに追加します。
; 結果手続きは引数を取らず、作成されたコレクションを返します。
; 結果手続きが呼ばれた後で追加手続きを呼んだ場合の動作は未定義です。
;
; 作られるコレクションのサイズが分かっている場合、キーワード引数SIZEを与える
; ことができます。
; コレクションクラスによってはその情報を使って効率的にコレクションを作成することができます。
; その情報を単に無視するコレクションクラスもあります。
; SIZE個より多くの要素が追加されたり、SIZE個の要素が追加される前に
; 結果手続きが呼ばれたりした場合の動作は未定義です。
;
; コレクションクラスがシーケンスクラスであった場合、追加手続きは要素を
; シーケンスの順に追加してゆきます。
;
; コレクションクラスによっては、コレクションオブジェクトの初期化のために
; 他のキーワード引数を取るかもしれません。
;
; このメソッドはPROCが返す値を返します。
;--------------------------------------------------------------------------------------------
; call-with-iteratorで渡される、インクリメント手続きが多値を返せばどうなるだろうか？
; これは多値のコレクションを決めるのだろうか?
; call-with-builderの追加手続きが複数のパラメータを受け取るとき、多値のコレクションを構築すると言えるか？
(define-module multi.multi-collection
;(use srfi-1)
(use gauche.collection)
(use gauche.mop.singleton)
(use util.queue)
;
(export
<unfold>
empty-collection null-collection
empty?
collections->multi-collection x->multi-collection
multi-unfold multi-unfoldn
for-each
map-to map multi-map
fold multi-foldn
filter filter-to
multi-concatenate multi-append
with-multi-iterator with-multi-builder
call-with-multi-iterator call-with-multi-builder
<multi-collection>)
)
(select-module multi.multi-collection)
(autoload komono-combinator tee) ; tee for debug
(define-class <multi-collection> [] [] )
; ----------------
;; call-with-builders
;; ( call-with-iteratorsを改造 )
;; n-ary case aux. proc
(define (call-with-builders clases proc)
(let loop ([clases clases]
[aprocs '()]
[gprocs '()])
(if (null? clases)
(proc (reverse! aprocs) (reverse! gprocs))
(with-builder ((car clases) add! get)
(loop (cdr clases) (cons add! aprocs) (cons get gprocs))))))
; basic operation
(define-method empty? ((coll <collection>))
(with-iterator (coll end? _ )
(end?) ) )
(define-method empty? ((list <list>)) (null? list))
; <unfold>
(define-class <unfold> [<collection>]
[ (p :init-keyword :p :init-value #f)
(f :init-keyword :f :init-value #f)
(g :init-keyword :g :init-value #f)
(tail-gen :init-keyword :tail-gen :init-value #f)
(seed :init-keyword :seed :init-value (undefined) )
] )
(define-method call-with-iterator ((self <unfold>) proc :key start)
(and-let* [ [p (slot-ref self'p)]
[f (slot-ref self'f)]
[g (slot-ref self'g)]
]
(let [[seed (slot-ref self'seed)]
[tail-gen (slot-ref self'tail-gen) ]
[tail-end? #f]
[tail-next #f]
]
(if (undefined? seed)
#f
(proc
; end?
(^[]
(let/cc next-of-end?
(if tail-end?
(tail-end?)
(if (p seed)
(if tail-gen
(call-with-iterator (tail-gen seed)
(^[end? next]
(set! tail-end? end?)
(set! tail-next next)
(next-of-end? (tail-end?) )
) )
#t)
#f) ) ) )
; next
(^[]
(if tail-next
(tail-next)
(begin0 (f seed) (set! seed (g seed) ) ) ) )
) ) ) ) )
; ----------------
(define-syntax with-multi-iterator
(syntax-rules ()
[(_ (coll end? next . opts) . body)
(call-with-multi-iterator coll (^[end? next] . body) . opts)]))
(define-syntax with-multi-builder
(syntax-rules ()
[(_ (class add! get . opts) . body)
(call-with-multi-builder class (^[add! get] . body) . opts)]))
(define-method call-with-multi-iterator ((collection <multi-collection> proc :key start))
(error "call-with-multi-iterator が実装されていない" ) )
;--------------------------------------------------------------------
; 自明なコレクション
; empty
; 空のコレクションは列挙そのものをしないから、<collection>でもあり<multi-collection>でもある。
(define-class <empty-collection> [<multi-collection> <collection> <singleton-mixin>] [] )
(define empty-collection (instance-of <empty-collection>) )
(define-method call-with-multi-iterator ((self <empty-collection>) proc :key start)
(proc (^[] #t) ; (end?) is always true
(^[] (error "attempt to iterate empty!") ) ) )
(define-method call-with-iterator ((self <empty-collection> proc :key start))
(proc (^[] #t) ; (end?) is always true
(^[] (error "attempt to iterate empty!") ) ) )
(define-method write-object ((self <empty-collection>) port)
(format port "<empty-collection>") )
; 空の多値を返す無限collection(emptyではない)
(define-class <null-collection> [<multi-collection> <singleton-mixin>] [] )
(define null-collection (instance-of <null-collection>) )
(define-method call-with-multi-iterator ((self <null-collection> proc :key start))
(proc (^[] #f) (^[] (values) ) ) )
(define-method write-object ((self <null-collection>) port)
(format port "<null-collection>") )
;--------------------------------------------------------------------
; multi-concatenateで使う
(define-class <concat-multi-collection> [<multi-collection>]
[(colls :init-keyword :colls :init-value #f)] )
(define-method call-with-multi-iterator ((self <concat-multi-collection>) proc :key start)
(if (slot-ref self'colls)
($ values
$* fold (^[coll _ ] ($ values->list $ call-with-multi-iterator coll proc) ) #f (slot-ref self'colls) )
(errorf "call-with-multi-iterator ~a" self) ) )
(define-method write-object ((self <concat-multi-collection>) port)
(format port "<concat-multi-collection colls:~a >" (slot-ref self'colls) ) )
;--------------------------------------------------------------------
; multi-map でつかう。
(define-class <mapped-multi-collection> [<multi-collection>]
[(proc :init-keyword :proc :init-value #f)
(coll :init-keyword :coll :init-value #f) ] )
(define-method call-with-multi-iterator ((self <mapped-multi-collection>) proc :key start)
(if (and (slot-ref self'coll) (slot-ref self'proc) )
(with-multi-iterator ((slot-ref self'coll) end? next)
(proc end? (^[] (call-with-values next (slot-ref self'proc) ) ) ) )
(errorf "call-with-multi-iterator ~a" self) ) )
(define-method write-object ((self <mapped-multi-collection>) port)
(format port "<mapped-multi-collection coll:~a proc:~a>" (slot-ref self'coll) (slot-ref self'proc) ) )
;--------------------------------------------------------------------
; collections->multi-collectionで使う
(define-class <colls-multi-collection> [<multi-collection>]
[(colls :init-keyword :colls :init-value #f)] )
(define-method call-with-multi-iterator ((self <colls-multi-collection>) proc :key start)
(if-let1 colls (slot-ref self'colls)
(call-with-iterators colls
(^[eprocs nprocs]
(proc
(^[] (any (cut <>) eprocs) )
(^[] ($ values $* map (cut <>) nprocs) ) ) ) )
(errorf "call-with-multi-iterator ~a" self) ) )
(define-method write-object ((self <colls-multi-collection>) port)
(format port "<colls-multi-collection colls:~a >" (slot-ref self'colls) ) )
;-------------------------------------------------------
; multi-unfoldで使う
;
; p : 1 to 1 : seedをみて終了判定
; g : 1 to 1 : seed --> 次のseed
; f : 1 to n : seed --> element
(define-class <unfold-multi-collection> [<multi-collection>]
[ (p :init-keyword :p :init-value #f)
(f :init-keyword :f :init-value #f)
(g :init-keyword :g :init-value #f)
(tail-gen :init-keyword :tail-gen :init-value #f)
(seed :init-keyword :seed :init-value (undefined) )
] )
(define-method call-with-multi-iterator ((self <unfold-multi-collection>) proc :key start)
(and-let* [ [p (slot-ref self'p)]
[f (slot-ref self'f)]
[g (slot-ref self'g)]
]
(let [[seed (slot-ref self'seed)]
[tail-gen (slot-ref self'tail-gen) ]
[tail-end? #f]
[tail-next #f]
]
(if (undefined? seed)
#f
(proc
; end?
(^[]
(let/cc next-of-end?
(if tail-end?
(tail-end?)
(if (p seed)
(if tail-gen
(call-with-multi-iterator (tail-gen seed)
(^[end? next]
(set! tail-end? end?)
(set! tail-next next)
(next-of-end? (tail-end?) )
) )
#t)
#f) ) ) )
; next
(^[]
(if tail-next
(tail-next)
(begin0 (f seed) (set! seed (g seed) ) ) ) )
) ) ) ) )
(define-method write-object ((self <unfold-multi-collection>) port)
(format port "<unfold-multi-collection p:~a f:~a g:~a seed:~a >"
(slot-ref self'p)
(slot-ref self'f)
(slot-ref self'g)
(slot-ref self'seed)
) )
; multi-unfoldnで使う
; seeds .... m個
; p : m to 1 : seedをみて終了判定
; g : m to m : seed --> 次のseed
; f : m to n : seed --> element
(define-class <unfoldn-multi-collection> [<multi-collection>]
[ (p :init-keyword :p :init-value #f)
(f :init-keyword :f :init-value #f)
(g :init-keyword :g :init-value #f)
(tail-gen :init-keyword :tail-gen :init-value #f)
(seeds :init-keyword :seeds :init-value #f )
] )
(define-method call-with-multi-iterator ((self <unfoldn-multi-collection>) proc :key start)
(and-let* [ [p (slot-ref self'p)]
[f (slot-ref self'f)]
[g (slot-ref self'g)]
[seeds (slot-ref self'seeds)]
]
(let [[tail-gen (slot-ref self'tail-gen)]
[tail-end? #f]
[tail-next #f] ]
(proc
; end?
(^[]
(let/cc next-of-end?
(if tail-end?
(tail-end?)
(if (apply p seeds)
(if tail-gen
(call-with-multi-iterator (apply tail-gen seeds)
(^[end? next]
(set! tail-end? end?)
(set! tail-next next)
(next-of-end? (tail-end?) )
) )
#t)
#f) ) ) )
; next
(^[]
(if tail-next
(tail-next)
(begin0 (apply f seeds) (set! seeds ($ values->list $ apply g seeds) ) ) ) )
) ) ) )
(define-method write-object ((self <unfoldn-multi-collection>) port)
(format port "<unfoldn-multi-collection> p:~a f:~a g:~a seeds:~a >"
(slot-ref self'p)
(slot-ref self'f)
(slot-ref self'g)
(slot-ref self'seeds)
) )
;-------------------------------------------------------
; basic operation
(define-method empty? ((coll <multi-collection>))
(with-multi-iterator (coll end? _ ) (end?) ) )
;-------------------------------------------------------
; multi-concatenate
(define (multi-concatenate colls)
(make <concat-multi-collection> :colls colls) )
;-------------------------------------------------------
; multi-append
(define-method multi-append ( (coll <multi-collection>) . rest )
(multi-concatenate `(,coll . ,rest) ) )
;-------------------------------------------------------
;; convertion from collections --------------------------
(define (collections->multi-collection colls )
(make <colls-multi-collection> :colls colls) )
; -------------------------------------------------------
; 実験的。引数なしでx->multi-collection = (values)を無限にもつnull-collection
(define-method x->multi-collection () null-collection )
; 複数のコレクションからmulti-collection
(define-method x->multi-collection ( (coll <collection>) . rest )
(collections->multi-collection `(,coll . ,rest) ) )
; --------------------------------------------------------
;; unfold
; p : 1 to 1 : seedをみて終了判定
; g : 1 to 1 : seed --> 次のseed
; f : 1 to n : seed --> element
; tail-gen pが#tを返したときのseedから残りの列を生成する
(define (multi-unfold p f g seed :optional (tail-gen #f) )
(make <unfold-multi-collection> :p p :f f :g g :seed seed :tail-gen tail-gen) )
; --------------------------------------------------------
;; unfoldn
; seeds .... m個
; p : m to 1 : seedをみて終了判定
; g : m to m : seed --> 次のseed
; f : m to n : seed --> element
; tail-gen pが#tを返したときのseedから残りの列を生成する
(define (multi-unfoldn p f g tail-gen . seeds)
(make <unfoldn-multi-collection> :p p :f f :g g :seeds seeds :tail-gen tail-gen) )
;; for-each ---------------------------------------------
; proc : n to *
(define-method for-each (proc (coll <multi-collection>) )
;#?=coll
(with-multi-iterator (coll end? next) ; nextが多値を返す
(until (end?)
(call-with-values next proc) ) ) )
(define (for-each$ proc) (pa$ for-each proc))
;; fold -------------------------------------------------
; proc : n + 1 to 1
(define-method fold (proc seed (coll <multi-collection>) )
(with-multi-iterator (coll end? next) ; nextが多値を返す
(let loop ( (seed seed) )
(if (end?)
seed
(loop ($ apply proc `( ,@($ values->list $ next) ,seed) )
) ) ) ) )
; proc : n + m to m
(define-method multi-foldn ((coll <multi-collection>) proc seed)
(fold proc seed coll))
(define-method multi-foldn ((coll <multi-collection>) proc . seeds )
(with-multi-iterator (coll end? next) ; nextが多値を返す
(let loop ( (seeds seeds) )
(if (end?)
(apply values seeds)
($ loop $ values->list $ apply proc `( ,@($ values->list $ next) ,@seeds ) )
) ) ) )
;; multi-map --------------------------------------------------
; http://chaton.practical-scheme.net/gauche/a/2013/05/04#entry-51849847-4efb2
; Shiro
; あ、あと多値コレクションという主題からは外れますが、<multi-collection>へのmapは要素へのprocの適用をlazyにやるわけですが、
; 同じ関数で引数がeagerな構造ならeagerな評価、引数がlazyな構造ならlazyな評価、とオーバロードするのは私はうまくないと思いま
; す。このへんの関係: http://chaton.practical-scheme.net/gauche/a/2013/04/09#entry-5164639a-811eb
;
; http://chaton.practical-scheme.net/gauche/a/2013/04/09#entry-5164639a-811eb
; shiro
; ScalaのRangeの話 https://groups.google.com/forum/?hl=ja&fromgroups=#!topic/scala--tohoku/oKmOIiUPB04
; これってmapの動作を「入力がlazyなら出力もlazy; 入力がstrictなら出力もstrict
; 」にしてるのが根本的な問題な気がするんだけどどうなんだろ。
; lazy版とstrict版は色々違うのではっきり分けといた方が幸せではないかなあ。まあ2009
; 年の話だから今は違ってるのかもしれないけど。
; Gaucheは、動的型ってせいもあるけど、出力(動作)がlazyかどうかでlmapとmapで分けてて、どちらも入力はlazyでもstrict
; でもいい。計算済みのリスト突っ込んで出力はlazyに得たいって場合もあるし、入力lazy
; だけどどうせ全部使うから出力は一気に得たいって場合もある。lazy->lazy, strict->strict
; とする実用的な必然性ってあまり無いと思う。
(define-method multi-map(proc (coll <multi-collection>) )
(make <mapped-multi-collection> :coll coll :proc proc) )
;; map --------------------------------------------------
; http://chaton.practical-scheme.net/gauche/a/2013/05/04#entry-5184975d-e6448
; Shiro
; mapが<multi-collection>を受け取って<multi-collection>を返す、というのは、理屈の上では綺麗です。
; Gaucheでmapは問答無用でリストを返すのは実用にすり寄ってる。
; proc : n to 1
(define-method map (proc (coll <multi-collection>) )
(with-multi-iterator (coll end? next)
(do ([q (make-queue)])
[(end?) (queue->list q)]
(enqueue! q (call-with-values next proc)))))
;; map-to --------------------------------------------------
; http://chaton.practical-scheme.net/gauche/a/2013/05/04#entry-5184975d-e6448
; Shiro
; ただまあGaucheのコンベンションに合わせるなら、
; mapはリストを返すのにとっといて、
; map-to <multi-collection-meta> でコレクションへの射影をやるのがいいかなあ。
(define-method map-to ((class <class>) proc (coll <multi-collection>) )
(with-multi-builder (class add! get :size (size-of coll))
(with-multi-iterator (coll end? next)
(do ()
[(end?) (get)]
(call-with-values (compose proc next) add!) ) ) ) )
;; filter-to -----------------------------------------------
; pred : n --> boolean
(define-method filter-to ((class <class>) pred (coll <multi-collection>))
(with-multi-builder (class add! get) ; add!は複数パラメータを受け入れる
(with-multi-iterator (coll end? next) ; nextは多値を返す
(do ()
[(end?) (get)]
(let1 e ($ values->list $ next )
(when (apply pred e) (apply add! e) )
) ) ) ) )
;; filter ------------------------------
; pred : n to boolean
(define-method filter (pred (coll <multi-collection>))
(let1 q (make-queue)
(with-multi-iterator (coll end? next)
(until (end?)
(let1 e ($ values->list $ next)
(when (apply pred e) (enqueue! q e))))
(queue->list q))))
;;------------------------------
;;------------------------------
(define-class <multi-test> [<multi-collection>]
[(n :init-keyword :n :init-value 0) ] )
(define-method size-of ((self <multi-test>))
(slot-ref self'n) )
(define-method call-with-iterator ((self <multi-test>) proc :key start)
(let1 counter (slot-ref self'n)
(proc (^[] (< counter 1) )
(^[] (begin0 (values " hoge " counter " foo " ) (dec! counter) ) ) ) ) )
(define-class <multi-test2-meta> [<class>] [] )
(define-class <multi-test2> [<multi-collection>]
[(coll :init-keyword :coll :init-value '()) ]
:metaclass <multi-test2-meta> )
(define-method write-object ((self <multi-test2>) port)
(format port "<multi-test2 ~a >" (slot-ref self'coll) ) )
(define-method call-with-iterator ((self <multi-test2>) proc :key start)
(with-iterator ( (slot-ref self'coll) end? next :start start )
(proc end? (^[] ($ values $* next ) ) )
) )
(define-method call-with-builder ((class <multi-test2-meta>) proc :key size)
(let1 v (make <multi-test2> :coll '())
(proc (^ arg (push! (slot-ref v'coll ) arg) )
(^[] v) ) ) )
($ print
;$ map vector
;$ tee write
$ filter ($ odd? $ + $*)
$ with-builder (<multi-test2> add! get)
(add! 0 1 2)
(add! 1 2 3)
(add! 2 3 4)
(add! 3 4 5)
(add! 4 5 6)
(add! 5 6 7)
(add! 6 7 8)
(add! 7 8 9) (get) )
(define x (make <multi-test> :n 3))
(for-each print x)
($ for-each print
;$ tee write
$ map-to <multi-test2> (cut values <> 'a <> " jag " <> ) x)
($ print
$ fold (^[x y z s] (cons* x y z s) ) '() x )
gosh> (define x (collections->multi-collection '((1 2) (3 4)))) x gosh> (map vector x) (#(1 3) #(2 4)) gosh> (multi-map vector x) <mapped-multi-collection coll:<colls-multi-collection colls:((1 2) (3 4)) > proc:#<subr vector>> gosh> ($ for-each print $ multi-map vector x) #(1 3) #(2 4) #t
(define x (collections->multi-collection '((1 2 3)( 3 4 5)( 5 6 7)( 7 8 9)) ) )
(define y (collections->multi-collection '((11 12)(23 24)(35 36)(47 48)) ) )
(define z (collections->multi-collection '((31 32)(33 34)(35 36)(37 38)) ) )
(define w (multi-append x y z))
($ print $ values->list
$ multi-foldn w (^ args
(print args)
(values (apply + args) (apply * args) ) )
1 1 )
(define x (x->multi-collection '(1 2 3) '( 3 4 5) '( 5 6 7) '( 7 8 9) ) )
(for-each (cut print <> " " <>) (multi-unfold (^s (> s 5)) (^s (quotient&remainder s 3) ) (^s (+ s 1)) 0 ) ) (for-each (cut print <> " " <> " " <>) (multi-unfoldn (^[s t] (> s 5) ) (^[s t] (values (* 10 s) (* 100 t) (* 1000 (+ s t) ) ) ) (^[s t] (values (+ s 1) (+ t 3) ) ) #f 1 1 ) )
; tail-gen指定のunfold
(for-each (cut print <> " " <>)
(multi-unfold
(^s (> s 5))
(^s (quotient&remainder s 3) )
(^s (+ s 1))
0
(^s
(x->multi-collection
(iota 10 s)
(iota 10 (* 2 s) ) ) )
) )
(for-each (cut print <> " " <> " " <>)
(multi-unfoldn
(^[s t] (> s 5) )
(^[s t] (values (* 10 s) (* 100 t) (* 1000 (+ s t) ) ) )
(^[s t] (values (+ s 1) (+ t 3) ) )
(^[s t]
(x->multi-collection
(iota 10 s)
(iota 10 t)
(iota 10 (+ s t) ) ) )
1 1 ) )
- fuyuki: applyでの多値のsplicingはfoldをいじくってたときにほしくなりました。 なんでfoldは多値を回せないんだろうって疑問に思ったことありません？
- Shiro: あるある。無理矢理やろうとすると、srfi-37みたいに 複数のseedを持ち回ることになるんだけれど、あれはあれで使いにくいし、 fold対象のリストが複数になった場合との相性が良くない。結局、 いちいちリストにパックしたりとかしなくちゃならない。
コレクションを経由すると多値の先頭しか取られない。 でも、多値のコレクションはあってもいいような気がする。
- yamasushi
手続きがn-in,m-outなように、dictionaryもn-in,m-outならばいいのではないかと思うのです。n個のkeyに対してm個の多値を返す。そのインターフェースをどうしたものかと、いろいろ考えるのですが、うまくまとまりません。(まとまらないので、とりあえず、ここに流してみることにしました。)
(1)n個のkeyに対して、異なる等価判定(eq?,equal?など)をしなければならない。(2)可変の長さをもつパラメータが２種類(key,value)があるので、これを指定するインターフェース (3) (2)と同時に与えるオプショナルなパラメータ。など
- shiro
n-outについてはまだ正直、リストじゃいかんの? という感じです。数が固定されていることに意味がある?
- shiro
出力に関しては、(apply values (dict-get ...)) で簡単に多値に変換できるんで、多値にしてとりわけうれしいシチュエーションというのがイメージできないというか。辞書のインタフェースの一部として「必ず3個の値が返ってくる」とかがわかると何か便利である、とかそういう話はありえるのかなとは思うけど具体例がまだ思いつかない。
- yamasushi
そうなのですが、多値のジェネレータを原理的には作成可能なこともあり、辞書も原理的には可能かなあとか。
なにに役にたつのかは、よくわかりません。
多値というインターフェースがデータ構造の表現となったらどうなるのか？みたいな。
わたしの理解の範囲では、多値は手続きの世界の話みたいなのですが、それだけだろうか？のような謎かけをしています。
コレクションもイテレータ次第で多値になるということもあります・・・・
どうも、まとまりません。(汗
- shiro
データをパイプのように流してゆくことを考えると、パイプの合流や分岐がn-inやm-outに相当しますね。ただ、そういう世界ってのは手続きのネットワークに綺麗にマップできるんで、辞書とか具体的なデータ構造を持ち込む必要があるのかな? と思います。辞書を取ってn-in/m-outなマッピング手続きを作れば、そういうネットワークに組み込むことはできるわけですよね。
つまり私のイメージだと、データを流してゆく機構の方は手続きで、辞書だのコレクションだのという具体的なデータ構造は「流れるデータ」の方にあるものだと考えるとすっきりするんじゃないの、ということです。わざわざ手続き以外の構造を頑張って機構の方に組み入れる必要があるのかな、という。
- yamasushi
インターフェースの見た目から言えば、入力要素にn個あたえて、等価判定をm個用意したとすると、先頭のm個がSet(キー)となり、残りがBag(値)になる。
先頭のm個については、trieと同じようなprefixが考えられる。同じprefixの「辞書」を定義できる、と。
lset-*が等価判定を用意しているように、一つの入力に一つの等価判定を用意しているケースが集合。
等価判定を用意しなかったら、Bagということになる。
等価判定ではなく、整列を定義するような関数をあたえたなら、Sorted*のようなもの？ができるか？とか。
- shiro
a:Set × b:Set × c:Set -> Bag から a:Set -> (b:Set × c:Set) -> Bag をくくりだす、みたいな操作ですよね。でも理屈の上では先頭を特別扱いする必然性は無くて、 b:Set -> (a:Set × c:Set) -> Bag みたいな分解だってできるわけで… 話としては、 a:Set × b:Set -> Bag から a:Set -> b:Set -> Bag にするオペレータを用意しとくから、それに都合の良いように使う人が順番を決めてね、っていうことになるのかな。
- yamasushi
先頭を特別扱いしたのがcurry化なのではないかとか。
- shiro
ああ、あとそういうインタフェースにしたとして、同じキーで異なる値になってるデータが与えられた場合はどうなるんでしょ。というのは φ -> Bag な構造と統一しようとしたらそういうのを扱わざるを得ないですよね。
- yamasushi
(make-duck-dict 'eq)でdをつくったとすると、(put-duck-dict d k v)はhashを生成する。(put-duck-dict d k)は集合を生成する。
(make-duck-dict)でdをつくったならば、dはコレクションとなる。(put-duck-dict d v),(put-duck-dict d v w)<---多値のコレクション
ここで、多値のコレクションとしたものと、いまのhashをくらべると、現在のdict-fold,dict-mapはkがキーだとか関係がないわけです。
さて、(make-duck-dict 'eq 'eqv)でdをつくったとして、(put-duck-dict d k)したなら、それはkに(make-duck-dict 'eqv)を割り当てることを意味します。
これで、自然にn-inのdictha
n-inの辞書は導入される。これが順序に意味があるという理由です。
ダックタイプで集合、ハッシュ、コレクションを扱おうという視点です。
関係モデルのタプルとなにか関係があるような気がするのですが、いかんせん不勉強なもので・・・・
問題点としては、(make-duck-dict 'eq)で生成したdに対して、(put-duck-dict d k v),(put-duck-dict d k)のように、集合とハッシュが混在したような代物もできるということでしょうか。
利点としては、n-in,m-outの手続きのメモ化を自然にかけるように思います。
(f x y z)--->(values a b c) なら($ apply put-duck-dict d x y z $* values->list $ f x y z)
dはfのアリティをしらべて、適切に生成します。
argをリストとしてまとめてequal?するのではなく、x y zに異なる等価判定を設定することができます。
- shiro
なるほど＞yamasushiさん。等価性判定関数の数で任意個のキーを持たせられるってアイディアは確かに面白いです。これは制限された関係モデルのようにも見えますね。(1)タプルのうち、先頭からn個の要素のみユニークキーにできる(2)ルックアップは、先頭からk個 (0<=k<=n) の属性値を指定して、残りの属性値からなるタプルの集合を得るprojection。
あーでもn個のキーを指定したときには具体的な値が返ってくるけどn個より小さい場合は辞書が返ってくるから、そのへんの扱いが微妙だな。
「集合とハッシュが混在」という上に挙がってる問題点としては、makeする時点でputに渡せる値の個数を指定させちゃうのはだめですか。キーが2個、値が3個、という構造を作ったら、(put d k1 k2 v1 v2 v3) 以外の形で呼び出すとエラー。そもそも「返ってくる値の個数が不定」っていうのはものすごく扱いにくいんで、「getでいくつ値が返ってくるかわからない辞書」ってあんまり便利じゃなさそうな。
- shiro
<multi-collection>へのmapは要素へのprocの適用をlazyにやるわけですが、同じ関数で引数がeagerな構造ならeagerな評価、引数がlazyな構造ならlazyな評価、とオーバロードするのは私はうまくないと思います。このへんの関係: http://chaton.practical-scheme.net/gauche/a/2013/04/09#entry-5164639a-811eb
- shiro
ScalaのRangeの話
https://groups.google.com/forum/?hl=ja&fromgroups=#!topic/scala--tohoku/oKmOIiUPB04
これってmapの動作を「入力がlazyなら出力もlazy; 入力がstrictなら出力もstrict」にしてるのが根本的な問題な気がするんだけどどうなんだろ。
lazy版とstrict版は色々違うのではっきり分けといた方が幸せではないかなあ。まあ2009年の話だから今は違ってるのかもしれないけど。
Gaucheは、動的型ってせいもあるけど、出力(動作)がlazyかどうかでlmapとmapで分けてて、どちらも入力はlazyでもstrictでもいい。
計算済みのリスト突っ込んで出力はlazyに得たいって場合もあるし、入力lazyだけどどうせ全部使うから出力は一気に得たいって場合もある。lazy->lazy, strict->strictとする実用的な必然性ってあまり無いと思う。
Tags: Experimental, 多値
Post a comment