yamasushi:Gauche

yamasushi:Gauche

なぞのアイデア

グラフを書く

ツイッターランド改二

対話とはspeakerとlistenerのペアが基本で，役割を切り替えながら進行する。外野は現在のspeakerの言葉に反応する。つまり，そとからみれば，speaker+listenerというひとつのプレイヤーの独り言と言える。

[image]

[image]

[image]

[image] 

; 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をREPLで使う。

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] チャート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で表現されそうである。これに自己リプを加えると良い。自己リプを使うことで複雑な文脈が記述可能となる。

http://chaton.practical-scheme.net/gauche/a/2013/05/01#entry-5180c620-8b98d

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も多値になればいいような気がしたのでした。

(2013/05/03 10:17:27 UTC)なぞのアイデア、多値の辞書についてメモ

横が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

モジュール

Topics
Sponsored Links
Search
Recent Changes
More ...
Last modified : 2014/11/07 08:28:25 UTC
WiLiKi 0.8.3 running on Gauche 0.9.14