対話とはspeakerとlistenerのペアが基本で，役割を切り替えながら進行する。外野は現在のspeakerの言葉に反応する。つまり，そとからみれば，speaker+listenerというひとつのプレイヤーの独り言と言える。
![[image]](http://chart.apis.google.com/chart?cht=gv&chl=digraph{node+%5B+shape+%3D+record+%5D%3B+X+%5B+label+%3D+%22Tweet%7C%7B%7BContent%7CContextTail%7D%7CReplyTail%7D%22%5D%3B}&foo=.png)
![[image]](http://chart.apis.google.com/chart?cht=gv&chl=digraph{node+%5B+shape+%3D+record+%5D%3B+X+%5B+label+%3D+%22Quote%7C%7BCommentText%7CQuoteText%7CQuotedPerson%7D%22%5D%3B}&foo=.png)
![[image]](http://chart.apis.google.com/chart?cht=gv&chl=digraph{node+%5B+shape+%3D+record+%5D%3B+X+%5B+label+%3D+%22Content%7C%7BText%7CPerson%7D%22%5D%3B}&foo=.png)
![[image]](http://chart.apis.google.com/chart?cht=gv&chl=digraph{node+%5B+shape+%3D+record+%5D%3B+Tweet+%5B+label+%3D+%22Pair%7C%7BSpeaker%7CListner%7D%22%5D%3B}&foo=.png)
; Twitter land
; https://gist.github.com/yamasushi/927557399cafe8eb3cbd
; - - - - - - - - - - - - - - - - - -
; context : [content]
; reply : [content]
; reply-tail : [content] , reply : content . reply-tail
; tweet : (context . reply-tail )
; (caar tweet) = (car context) = content of tweet
; content : (text . person)
; quote-text : (text quote-text . quoted-person) )
; quote-content : ((text quote-text . quoted-person) . person)
(define (make-content text p)
(cons* text p) )
(define (content-get-person content)
(cdr content) )
(define (tweet-get-content tweet)
;#?= tweet
(if (or (null? tweet) (null? (car tweet) ) )
'()
(caar tweet) ) )
(define (tweet-get-context tweet)
;#?= tweet
(if (null? tweet)
'()
(car tweet) ) )
(define (tweet-get-context-tail tweet)
;#?= tweet
(if (or (null? tweet) (null? (car tweet)) )
'()
(cdar tweet) ) )
(define (tweet-get-person tweet)
($ content-get-person $ car $ tweet-get-context tweet ) )
(define (make-quote text qtext qp)
(cons* text qtext qp) )
; - - - - - - - - - - - - - - - - - -
(define (tweet-get-reply-tail tweet)
(if (null? tweet)
'()
(cdr tweet) ) )
(define (tweet-get-reply tweet)
(if (or (null? tweet) (null? (car tweet) ) )
'()
(cons (caar tweet) (tweet-get-reply-tail tweet) ) ) )
(define null-tweet '( () . () ) )
(define (tweet-reply me to content)
(cons
(cons content (tweet-get-context me) )
(tweet-get-reply to) ) )
(define (tweet-post me content)
(cons (cons content (tweet-get-context me) ) '() ) )
(define (tweet-self-reply me content)
(tweet-reply me me content ) )
(define (tweet-retweet me to)
(cons
(cons (tweet-get-content to) (tweet-get-context me) )
(tweet-get-reply-tail to ) ) )
(define (tweet-println tweet)
(format #t "content:~s~% context-tail:~s~% reply-tail:~s~%"
(tweet-get-content tweet)
(tweet-get-context-tail tweet)
(tweet-get-reply-tail tweet) ) )
; - - - - - - - - - - - - - - - - - -
; timeline : [ tweet ]
(define (timeline-println tl)
(for-each tweet-println tl) )
; - - - - - - - - - - - - - - - - - -
; profile : (timeline . person)
(define (profile-get-person prof)
(cdr prof) )
(define (profile-get-timeline prof)
(car prof) )
(define (profile-get-tweet prof i) (~ (profile-get-timeline prof) i) )
(define (profile-get-last-tweet prof) ($ car $ profile-get-timeline prof) )
(define (profile-println prof)
(format #t "person:~s~%timeline:~%" (profile-get-person prof) )
($ timeline-println $ profile-get-timeline prof) )
(define (make-profile p)
(cons* `(,null-tweet) p) )
; - - - - - - - - - - - - - - - - - -
; pair (speaker . listner)
(define (make-pair p q) (cons p q) )
(define (pair-get-speaker p) (car p) )
(define (pair-get-listener p) (cdr p) )
(define (pair-swap p) (make-pair (pair-get-listener p) (pair-get-speaker p) ) )
; - - - - - - - - - - - - - - - - - -
(define (reply to text prof)
(let [(tl (car prof) ) (p (cdr prof) )]
(cons*
(cons (tweet-reply (car tl) to (make-content text p) ) tl ) p ) ) )
(define (post text prof)
(let [(tl (car prof) ) (p (cdr prof) )]
(cons*
(cons (tweet-post (car tl) (make-content text p)) tl) p ) ) )
(define (self-reply text prof)
(let [(tl (car prof) ) (p (cdr prof) )]
(cons*
(cons (tweet-self-reply (car tl) (make-content text p) ) tl ) p ) ) )
(define (retweet to prof)
(let [(tl (car prof) ) (p (cdr prof) )]
(cons*
(cons (tweet-retweet (car tl) to) tl) p ) ) )
(define (reply-last text prof)
(reply (profile-get-last-tweet prof) text prof) )
; - - - - - - - - - - - - - - - - - -
(define (pair-talk text p)
(let [(speaker (pair-get-speaker p) ) (listener (pair-get-listener p) ) ]
(make-pair
(reply (profile-get-last-tweet listener) text speaker)
listener ) ) )
(define (pair-monologue text p)
(let [(speaker (pair-get-speaker p) ) (listener (pair-get-listener p) ) ]
(make-pair (self-reply text speaker) listener ) ) )
(define (pair-quote text quote-text p)
(let* [
(speaker (pair-get-speaker p) )
(listener (pair-get-listener p) )
(quoted-tweet (profile-get-last-tweet listener) ) ]
(make-pair
(reply quoted-tweet (make-quote text quote-text (tweet-get-person quoted-tweet) ) speaker)
listener ) ) )
; Twitter land
; https://gist.github.com/yamasushi/927557399cafe8eb3cbd
(define shuji (make-profile 'shuji) )
(define yamasushi (make-profile 'yamasushi) )
(define syamamoto (make-profile 'syamamoto) )
(define shuji-data-0
( $ post "3rd(reply/RT it)"
$ post "2nd"
$ post "1st" shuji ) )
(define yamasushi-data-0
( $ post "this is shuji's"
$ retweet (profile-get-last-tweet shuji-data-0)
$ post "hello!" yamasushi ) )
(define syamamoto-data-0
(let1 tw (profile-get-last-tweet shuji-data-0)
( $ reply tw (make-quote "WTF!! :(" "3rd" (tweet-get-person tw) )
$ reply-last "that is a table."
$ reply-last "this is a pen."
$ post ":-)" syamamoto ) ) )
(define shuji-data-1
( $ reply (profile-get-last-tweet syamamoto-data-0) "hehe"
$ reply (profile-get-last-tweet yamasushi-data-0) "THX!" shuji-data-0) )
(define syamamoto-data-1
( $ reply-last "Whooooaa!!!"
$ reply-last "Booo"
$ retweet (profile-get-tweet shuji-data-1 1) syamamoto-data-0 ) )
; Twitter land
; https://gist.github.com/yamasushi/927557399cafe8eb3cbd
; talk
(define shuji (make-profile 'shuji) )
(define yamasushi (make-profile 'yamasushi) )
(define syamamoto (make-profile 'syamamoto) )
(define talk-0
( $ pair-quote "What?" "Hmmmm" $ pair-swap
$ pair-monologue "Hmmmm...... :-< "
$ pair-talk "hi" $ pair-swap
$ pair-talk "hello" (make-pair shuji yamasushi) ) )
slop( https://github.com/naelstrof/slop )なるマウス入力を取ってくるコマンドがすばらしいので，REPLで使ってみる。
slopを起動するとクロスヘアカーソルが現れるので，デスクトップの領域をそれで指定すると，その領域の情報が得られる。
gosh> (with-input-from-process "slop -f'(%c %i (%x . %y) (%w . %h) )' 2>/dev/null " read :on-abnormal-exit (^ _ ) ) (false 0 (534 . 869) (155 . 54))
%cはキャンセルしたかどうか。つまり，falseなら取得できた。
gosh> (with-input-from-process "slop -f'(%c %i (%x . %y) (%w . %h) )' 2>/dev/null " read :on-abnormal-exit (^ _ ) ) (true 0 (0 . 0) (0 . 0))
これがキャンセル時。
![[image]](http://chart.apis.google.com/chart?cht=gv&chl=digraph{x-%3Ey}&foo=.png)
チャートAPIは許可してほしい・・・・がこれはどうなのだろうか？
よく考えるとトリプルじゃないほうが簡単な気がした。 トリプルとして捉えてはいるが，実装上は文脈のリストのCARを現在のつぶやきにして，replyチェインはそれを使うという流れ。
; tweet : (context . reply-chain)
; (caar tweet) = (car context) = content of tweet
(define null-tweet '( () . () ) )
(define (tweet-reply me to content)
(cons
(cons content (car me) )
(cons (caar to) (cdr to) ) ) )
(define (tweet-post me content)
(cons
(cons content (car me) ) '() ) )
(define (tweet-self-reply me content)
(tweet-reply me me content ) )
(define (tweet-retweet me to)
(cons
(cons (caar to) (car me) )
(cdr to) ) )
(define (reply to content tl)
(cons
(tweet-reply (car tl) to content) tl) )
(define (post content tl)
(cons
(tweet-post (car tl) content) tl) )
(define (self-reply content tl)
(cons
(tweet-self-reply (car tl) content) tl) )
(define (retweet to tl)
(cons
(tweet-retweet (car tl) to) tl) )
(define shuji `(,null-tweet))
(define yamasushi `(,null-tweet))
(define syamamoto `(,null-tweet))
(define shuji-data-0
( $ post "3rd(reply/RT it)"
$ post "2nd"
$ post "1st" shuji ) )
(define yamasushi-data-0
( $ post "this is shuji's"
$ retweet (car shuji-data-0)
$ post "hello!" yamasushi ) )
(define syamamoto-data-0
( $ reply (car shuji-data-0) "WTF!! :("
$ post ":-)" syamamoto ) )
(define shuji-data-1
( $ reply (car syamamoto-data-0) "hehe"
$ reply (car yamasushi-data-0) "THX!" shuji-data-0) )
(define syamamoto-data-1
( $ reply (~ shuji-data-1 1) "Booo"
$ retweet (~ shuji-data-1 1) syamamoto-data-0 ) )
gosh> shuji-data-0
((("3rd(reply/RT it)" "2nd" "1st")) (("2nd" "1st")) (("1st")) (()))
gosh> yamasushi-data-0
((("this is shuji's" "3rd(reply/RT it)" "hello!")) (("3rd(reply/RT it)" "hello!")) (("hello!")) (()))
gosh> syamamoto-data-0
((("WTF!! :(" ":-)") "3rd(reply/RT it)") ((":-)")) (()))
gosh> shuji-data-1
((("hehe" "THX!" "3rd(reply/RT it)" "2nd" "1st") "WTF!! :(" "3rd(reply/RT it)") (("THX!" "3rd(reply/RT it)" "2nd" "1st") "this is shuji's") (("3rd(reply/RT it)" "2nd" "1st")) (("2nd" "1st")) (("1st")) (()))
gosh> syamamoto-data-1
((("Booo" "THX!" "WTF!! :(" ":-)") "THX!" "this is shuji's") (("THX!" "WTF!! :(" ":-)") "this is shuji's") (("WTF!! :(" ":-)") "3rd(reply/RT it)") ((":-)")) (()))
gosh> (self-reply "Hoo" shuji-data-1)
((("Hoo" "hehe" "THX!" "3rd(reply/RT it)" "2nd" "1st") "hehe" "WTF!! :(" "3rd(reply/RT it)") (("hehe" "THX!" "3rd(reply/RT it)" "2nd" "1st") "WTF!! :(" "3rd(reply/RT it)") (("THX!" "3rd(reply/RT it)" "2nd" "1st") "this is shuji's") (("3rd(reply/RT it)" "2nd" "1st")) (("2nd" "1st")) (("1st")) (()))
gosh> (caar *1)
("Hoo" "hehe" "THX!" "3rd(reply/RT it)" "2nd" "1st")
gosh> (cdar *2)
("hehe" "WTF!! :(" "3rd(reply/RT it)")
自己リプを使うと，複数の並列する文脈を記述できる。その文脈同士はリプ/RTで交流する。
可能性演算子として<>とか。（いや，何に使うのかはよくわからない。
-< でcontain? を表現してタイプに応じた定義を作ればいいのではないか？ <-のほうが字形に近いが矢印の意味のほうが強いので・・・
長さ３のdotted-listをトリプルと呼ぶ。
(cons* 'car 'cdrl 'cdrr)
先頭をcarと呼ぶ。二番目以降は左右のCDRと考える。つまり，トリプルは二つのリストと対応する。
gosh> (cons* 'car 'cdrl 'cdrr) (car cdrl . cdrr) gosh> (cons (car *1) (cadr *1)) (car . cdrl) gosh> (cons (car *2) (cddr *2)) (car . cdrr)
carが同じ二つのリストはトリプルとして扱える。
トリプル同士の演算の例として，下のツイッターランドがある。cdrl,cdrrの付け替えである。
トリプルの要素の一つを'()とすることで二つ組を表す。
gosh> (cons* 's 'e '()) (s e) gosh> (cons* 's '() 'e) (s () . e) gosh> (cons* '() 's 'e) (() s . e)
３種類の二つ組が表現できる。
つぶやきの文脈というのはそれを先頭に持つタイムライン。リプライの構造というのはそのつぶやきで終わるリプのパス。この二つのリストはCARを共有する。CARを共有する二つのリストをトリプルとして表現する。トリプルのリストがつぶやき主を表している。CARが最新のつぶやき。トリプル自身が文脈とリプの構造を持つのが特徴。
たぶん，図で書いたほうがわかりやすい。
; tweet : (content timeline reply-chain)
(define null-tweet '(() () . () ) )
(define (tweet-reply me to content)
`(,content
,(cons (car me) (cadr me))
. ,(cons (car to) (cddr to)) ) )
(define (tweet-post me content)
(tweet-reply me null-tweet content ) )
(define (reply tl-me to content)
(cons
(tweet-reply (car tl-me) to content) tl-me) )
(define (post tl-me content)
(cons
(tweet-post (car tl-me) content) tl-me) )
(define shuji `(,null-tweet))
(define yamasushi `(,null-tweet))
(define syamamoto `(,null-tweet))
トリプル (content timeline . reply-chain)を操作していく流れ。
gosh> (post shuji 1) ((1 (()) ()) (() ())) gosh> (post *1 2) ((2 (1 ()) ()) (1 (()) ()) (() ())) gosh> (car *1) (2 (1 ()) ()) gosh> (post shuji 1) ((1 (()) ()) (() ())) gosh> (post *1 2) ((2 (1 ()) ()) (1 (()) ()) (() ())) gosh> (post *1 3) ((3 (2 1 ()) ()) (2 (1 ()) ()) (1 (()) ()) (() ())) gosh> (post *1 4) ((4 (3 2 1 ()) ()) (3 (2 1 ()) ()) (2 (1 ()) ()) (1 (()) ()) (() ())) gosh> (reply yamasushi (car *1) 999) ((999 (()) 4 ()) (() ())) gosh> (reply *1 (car *1) 888) ((888 (999 ()) 999 4 ()) (999 (()) 4 ()) (() ())) gosh> (reply *1 (car *1) 777) ((777 (888 999 ()) 888 999 4 ()) (888 (999 ()) 999 4 ()) (999 (()) 4 ()) (() ()))
RT追加
(define (tweet-retweet me to)
`(,(car to) ,(cons (car me) (cadr me)) . ,(cddr to) ))
(define (retweet tl-me to)
(cons
(tweet-retweet (car tl-me) to) tl-me) )
gosh> (post shuji 1) ((1 (()) ()) (() ())) gosh> (post *1 2) ((2 (1 ()) ()) (1 (()) ()) (() ())) gosh> (retweet yamasushi (car *1) ) ((2 (()) ()) (() ()))
$記法に対応するため仕様変更
; tweet : (content context reply-chain)
(define null-tweet '(() () . () ) )
(define (tweet-reply me to content)
`(,content
,(cons (car me) (cadr me))
. ,(cons (car to) (cddr to)) ) )
(define (tweet-post me content)
(tweet-reply me null-tweet content ) )
(define (tweet-retweet me to)
`(,(car to) ,(cons (car me) (cadr me)) . ,(cddr to) ))
(define (reply to content tl)
(cons
(tweet-reply (car tl) to content) tl) )
(define (post content tl)
(cons
(tweet-post (car tl) content) tl) )
(define (retweet to tl)
(cons
(tweet-retweet (car tl) to) tl) )
(define shuji `(,null-tweet))
(define yamasushi `(,null-tweet))
(define syamamoto `(,null-tweet))
(define shuji-data-0
( $ post "3rd(reply/RT it)"
$ post "2nd"
$ post "1st" shuji ) )
(define yamasushi-data-0
( $ post "this is shuji's"
$ retweet (car shuji-data-0)
$ post "hello!" yamasushi ) )
(define syamamoto-data-0
( $ reply (car shuji-data-0) "WTF!! :("
$ post ":-)" syamamoto ) )
(define shuji-data-1
( $ reply (car syamamoto-data-0) "hehe"
$ reply (car yamasushi-data-0) "THX!" shuji-data-0) )
(define syamamoto-data-1
( $ reply (~ shuji-data-1 1) "Booo"
$ retweet (~ shuji-data-1 1) syamamoto-data-0 ) )
shujiの"3rd(reply/RT it)"をyamasushiがRTして，syamamotoがリプライ。shujiが双方にリプライ返し。syamamotoがshujiとyamasuhiとのリプをRTして，そこにリプ。（クソリプ
つぶやきの所有についてはcontentが責任を負う。ツイッターランドそのものはパクツイを許容するし，それを排除することはできない。
たいていの文章は上のreply,retweeetで表現されそうである。これに自己リプを加えると良い。自己リプを使うことで複雑な文脈が記述可能となる。
yamasushi
手続きがn-in,m-outなように、dictionaryもn-in,m-outならばいいのではないかと思うのです。
n個のkeyに対してm個の多値を返す。そのインターフェースをどうしたものかと、いろいろ考えるのですが、うまくまとまりません。(まとまらないので、とりあえず、ここに流してみることにしました。)
(1)n個のkeyに対して、異なる等価判定(eq?,equal?など)をしなければならない。
(2)可変の長さをもつパラメータが２種類(key,value)があるので、これを指定するインターフェース
(3) (2)と同時に与えるオプショナルなパラメータ。など
また、いまのdictinaryフレームワークではfallbackが定数なのですが、これをf手続き(applicable)にできれば、若干柔軟な処理ができそうな気がします。
SourceForge.net: Gauche:
http://sourceforge.net/mailarchive/message.php?msg_id=29772717
にて指摘されているように、多値の関数のメモ化を考えるならば、dictionaryも多値になればいいような気がしたのでした。
横がeqの数
縦がtupleサイズ
| 0 | 1 | 2 | 3 | 4 | |
| 0 | ()? | X | X | X | X |
| 1 | Bag | Set | X | X | X |
| 2 | Multi Bag | Map 1:1 | Multi Set | X | X |
| 3 | Multi Bag | Map 1:2 | Map 2:1 | Multi Set | X |
| 4 | Multi Bag | Map 1:3 | Map 2:2 | Map 3:1 | Multi Set |
(define-module htmlprag
(export html->sxml))
(select-module htmlprag)
(load "htmlprag-0-16.scm") ; http://www.neilvandyke.org/htmlprag/
(provide "htmlprag")
(define-module pretty-print
(export pretty-print))
(select-module pretty-print)
(load "pp.scm") ; http://www.cs.indiana.edu/pub/scheme-repository/code/string/pp.scm
(provide "pretty-print")