早貴 - はてな匿名ダイアリー

これは明らかに立憲民主党の敗北である。確かに事前の情勢報道（投開票日終了まで続いていた）では党勢は伸長されるはずであった。前回議席の維持ならば少なくとも敗北に非ずと強弁できるだろう。しかし、現有議席すら守れていないのは明確な敗北だ。就中、今次総選挙は前回大敗し、挽回は容易であるはずであった。議席を失陥し、一敗地に塗れた同志に恥じるところはないか。

これに対し、たもとを分かった国民新党は増、非左派野党である維新は大躍進を遂げた。単に得べかりし議席を、彼らに献上しただけではないか。これは間接的な反党行為とすら評価可能な事態だ。

それとも自民党が減ったから勝利だとでもいうのか。ならば55年体制下社会党と何ら変わらぬ、政権を目指さない安定野党に堕することになるが、それでいいのか。

一、大言の罪

あまつさえ貴君は、選挙前にこう言った。これは政権選択の選挙なのだと、自民政権か非自民政権かを決める選挙であると。

これは現状からすれば、そして選挙前の情勢からしても明らかに大言壮語の類であった。政治家が信頼を得るには、偏に誠実な言動を行うことである。身の程を超えた大風呂敷を広げ続ければ、やがて国民は貴君らの言動をそれなりに値引きしてみるようになるだろう。

他方、狡猾にも貴君は勝敗ラインの設定は行ってこなかった。ならば、政権として選択されず、政権首班として認められなかった貴君は直ちに他に席を譲り捲土重来を期すことこそ憲政の常道といえる。

貴君が代表の座に固執すれば、己の言動にすら責任を取らぬ政治家となる、それでいいのか。

一、管理不行き届きの罪

選挙の前後、立憲民主党所属議員から、多数の失言があった。これらは全てシンパタイザーによって糊塗されたが、明白な誤りである。ただ詫びて済むものではない。特に政策的発言において、党方針と全く異なる方言と言ってもいいような発言があったことは、党員の管理が不十分である明確な証拠である。

また、政策議論における発言を弾劾し、デュープロセスを全く外れたまま処分し追放したことは、立憲主義の看板を著しく損ない泥を塗ったものであると断じざるを得ない。

更には、候補者調整においても明らかに指導力に欠く、もしくは一部の独走を許すような事態も招いている。

明らかに貴君には、党全体を管理し統率する能力か意志に欠けるところ大である。そのような人物を代表に据え続け、今後戦えるのか。答えは否、再びの敗北を招くだけである。貴君は貴君がお山の大将でありさえすれば、それでいいのか。

一、戦略を見誤った罪

総選挙の結果を見れば、自民党に嫌気を指した層が進んだのは左傾化した立憲民主党ではなく、非左派と目された維新であった。

票田は明らかに中央にあり、左傾化したところでとれるのは現有程度であること明白である。さらに政権側は、敵失に敵失を重ねていた。正に棚から牡丹餅が落ちんとしていたのに、それを拾ったものは誰か。現状の選挙で数多くの批判の声をみすみす逃したのは、共産党との共闘によって中道にウイングを伸ばせなかった一点によるものである。

共闘路線は明白な失敗であった。たしかにいくつかの議席は共闘で得られたであろう。首がつながった議員もいるはずだ。自民の大物も仕留めた。しかしそれは単に局地戦における健闘であって、戦略の誤りは明らかである。

このまま進めば、選挙における依存度を増し、文字通り立憲共産党となり果てるが、それでいいのか。

以上、いずれも許されざる大罪である。故に枝野君、君は速やかに立憲民主党代表を辞せ。

政党は貴君の個人商店ではない。民主的存在なのだ。最早貴君の歴史的使命は終了した。党は貴君が立派に育てた。後進に道を譲り、立憲民主党代表選を行い今後の方針を定めるべきという審判が下されたのだ。それにより人材ここにありと、民主主義ここにありと堂々と示す秋が到来したのだ。

立憲民主党は代表を変えることが出来る、共産党の如き独裁ではないことを、己の犠牲を以て示せ。そこから党再生の一歩が始まると確信する。

nwpi

Permalink | 記事への反応(6) | 05:22

2021-08-04

■垢抜けってなんだ？

日記

女も男もメイクだの垢抜けだのと声高に叫ばれる昨今の風潮はよく分からない。そもそも垢抜けとは何だろうか。誰も教えてはくれないが、お洒落をしなければどうやら人権が無いらしい……という訳でGoogle先生に聞いてみると出るわ出るわの精神論。一応添えられているアドバイスも何だか心許無い内容な気がする。結局のところふんわりとした概念なのかなぁ？

とりあえず眉毛を剃るといいらしいので剃った。垢抜けたのだろうか、自分ではよく分からない。ついでに顔の産毛も剃った。これはなかなかいい感じかもしれない。

そうこうしていたら、見かねた母親にメイク教室に連れていかれた。頬のファンデーション(？)がおかめさんみたいで気持ちが悪かった。不細工はメイクで変わると言われているがそれは嘘である。パタリロと日本人形の悪い所を併せ持った人間はどう足掻いてもブスであった。惨い現実を突きつけられたが、親から見ると違うらしく褒められた。反吐が出そうだった。あと単純に顔が痒い。逆に肌に悪い気がする。

次いでに眼鏡も外せと言われたが、眼科の先生にコンタクトを断られるくらいの目の狭さの人間に何を求めているのだろうか。

今度は服を買えと言われた。

ファッションサイトによると、ユニクロではダメらしいので勧められていたブランドのサイトを覗いてみる。……値段が高い。その割には個人的な感性には引っかからないオフィス・ファッションが並んでいる。生憎、此方は女子アナウンサーでも事務職でもない。仕事場に着けば作業着に着替えるだけの肉体労働者である。汗を吸って作業着からはみ出さない服が欲しいのだ。実用性の無い服に五千円も出していられない。なぜみんなあんなに高い服を買えるのだろう。白いフリルの様なものが付けられたシャツ(この名称も多分違う)が四千円、私が着れば肩は増強されることは確実。真っ黄色なスカートが七千円、原色だがたしかに可……愛い……？(よく分からない)

これらを買える人間はブルジョワを通り越して最早貴族であり、きっと華奢で可愛らしい子なのであろう。実際モデルもなんか女子アナっぽくて合コンとか行ってそうだし。なで肩チビ短足太足には着こなせないのは伝わってきた。南無三。

うだうだしていても埒が明かないので、とりあえず可愛いなと思った服を買ったら「懇談会の母親」「相も変わらず30代経産婦のまま」の称号を得てしまった。10代後半なんだけどなぁ。一応、平均体重未満だけどスタイルが悪いからこうなるのかもしれない(腹出てるし猫背、直らない)。辛い。

このあとも色々調べたけれど、やっぱり分からない。美人は美人で不細工は不細工だし、可愛い子が着ている服は不細工が着るとダサくなることが分かったことしか収穫がなかった。私は地元のサティに入っている適当な店で買ったシャツと三千円のジーンズと安売りしてた花柄のスカートで事足りるのだが、世間様はそれを「人間ではない」「社会不適合者」と嘲笑っているという余計な知識まで得てしまった。TwitterとInstagramのファッション垢は怖いこともよくわかった。お洒落な店にはそんな格好で来たら迷惑だし雰囲気が壊れるのだとか。それじゃあ服を買うための服が必要ではないか。お洒落とは資本なのか、と1人で納得する。

いやほんとに垢抜けわっかんね～！！！！もう体裁とかどうでもいいや。世界には可愛い女の子が沢山いるんだから私が別に可愛い服着て周り満足させる必要なくね？？？？わからん！！！！毎日服洗ってるし風呂入ってるし働いてるからそれでよくね？？？多分清潔だと思う！！！なんか損してるらしいけどわからん！！！！お洒落って何……？ほんとにわからん。

世間がわからん…………怖…………知りたくなかったなぁ……

まさか知らず知らずの内に人権守る価値すらない下等生物扱いされててるとは。

個人的にはダサい(と思ってる)服装の人を盗撮して嘲笑ってる方が性格悪いと思うけどどうなんだろう…………

言い訳がましくなってしまったけど私は今日もダッサイ女のままだ。垢抜けが何なのかもわからないま過ごしている。おわり。

Permalink | 記事への反応(2) | 19:30

2021-07-25

■垢抜けってなんだ？

日記

女も男もメイクだの垢抜けだのと声高に叫ばれる昨今の風潮はよく分からない。そもそも垢抜けとは何だろうか。誰も教えてはくれないが、お洒落をしなければどうやら人権が無いらしい……という訳でGoogle先生に聞いてみると出るわ出るわの精神論。一応添えられているアドバイスも何だか心許無い内容な気がする。結局のところふんわりとした概念なのかなぁ？

とりあえず眉毛を剃るといいらしいので剃った。垢抜けたのだろうか、自分ではよく分からない。ついでに顔の産毛も剃った。これはなかなかいい感じかもしれない。

そうこうしていたら、見かねた母親にメイク教室に連れていかれた。頬のファンデーション(？)がおかめさんみたいで気持ちが悪かった。不細工はメイクで変わると言われているがそれは嘘である。パタリロと日本人形の悪い所を併せ持った人間はどう足掻いてもブスであった。惨い現実を突きつけられたが、親から見ると違うらしく褒められた。反吐が出そうだった。あと単純に顔が痒い。逆に肌に悪い気がする。

次いでに眼鏡も外せと言われたが、眼科の先生にコンタクトを断られるくらいの目の狭さの人間に何を求めているのだろうか。

今度は服を買えと言われた。

ファッションサイトによると、ユニクロではダメらしいので勧められていたブランドのサイトを覗いてみる。……値段が高い。その割には個人的な感性には引っかからないオフィス・ファッションが並んでいる。生憎、此方は女子アナウンサーでも事務職でもない。仕事場に着けば作業着に着替えるだけの肉体労働者である。汗を吸って作業着からはみ出さない服が欲しいのだ。実用性の無い服に五千円も出していられない。なぜみんなあんなに高い服を買えるのだろう。白いフリルの様なものが付けられたシャツ(この名称も多分違う)が四千円、私が着れば肩は増強されることは確実。真っ黄色なスカートが七千円、原色だがたしかに可……愛い……？(よく分からない)

これらを買える人間はブルジョワを通り越して最早貴族であり、きっと華奢で可愛らしい子なのであろう。実際モデルもなんか女子アナっぽくて合コンとか行ってそうだし。なで肩チビ短足太足には着こなせないのは伝わってきた。南無三。

うだうだしていても埒が明かないので、とりあえず可愛いなと思った服を買ったら「懇談会の母親」「相も変わらず30代経産婦のまま」の称号を得てしまった。10代後半なんだけどなぁ。一応、平均体重未満だけどスタイルが悪いからこうなるのかもしれない(腹出てるし猫背、直らない)。辛い。

このあとも色々調べたけれど、やっぱり分からない。美人は美人で不細工は不細工だし、可愛い子が着ている服は不細工が着るとダサくなることが分かったことしか収穫がなかった。私は地元のサティに入っている適当な店で買ったシャツと三千円のジーンズと安売りしてた花柄のスカートで事足りるのだが、世間様はそれを「人間ではない」「社会不適合者」と嘲笑っているという余計な知識まで得てしまった。TwitterとInstagramのファッション垢は怖いこともよくわかった。お洒落な店にはそんな格好で来たら迷惑だし雰囲気が壊れるのだとか。それじゃあ服を買うための服が必要ではないか。お洒落とは資本なのか、と1人で納得する。

いやほんとに垢抜けわっかんね～！！！！もう体裁とかどうでもいいや。世界には可愛い女の子が沢山いるんだから私が別に可愛い服着て周り満足させる必要なくね？？？？わからん！！！！毎日服洗ってるし風呂入ってるし働いてるからそれでよくね？？？多分清潔だと思う！！！なんか損してるらしいけどわからん！！！！お洒落って何……？ほんとにわからん。

世間がわからん…………怖…………知りたくなかったなぁ……

まさか知らず知らずの内に人権守る価値すらない下等生物扱いされててるとは。

個人的にはダサい(と思ってる)服装の人を盗撮して嘲笑ってる方が性格悪いと思うけどどうなんだろう…………

言い訳がましくなってしまったけど私は今日もダッサイ女のままだ。垢抜けが何なのかもわからないま過ごしている。おわり。

Permalink | 記事への反応(2) | 12:08

2021-04-28

■anond:20210428143429

須藤早貴でググったが美乳写真は見つからなかった

Permalink | 記事への反応(0) | 14:43

2007-09-07

■ようこそ、℃-ute な Lisp の世界へ

発祥: http://ex23.2ch.net/test/read.cgi/morningcoffee/1188654905/

はじめに

Scheme という Lisp 語族の言語を用いて ℃-ute の相関関係をプログラムし、様々な角度から関係性を分析する手法を紹介していきます（ソースコードは最後に張ります）。

まずは、メンバー間の関係を「リスト」というデータ型で表現します。例えば「栞菜->愛理」という関係は

(kanna . airi)

という形で表すことができます。これに、「大好き」という情報を付加し、ついでにその関係の性質を数値化したものを加えると

((kanna . airi) (desc "大好き") (score . 1))

のようになり、関係図における一つの矢印の情報をデータ化できたことになります（暫定的に、好意は 1、良好・中立は 0、険悪は -1 の３段階で表すことにします）。

メンバー間の全ての関係性をこのデータ単位で定義し、データベース化しておくことで、色んな条件に基づいた検索やスコア計算などが可能となります。

例 1: リンク状況の調査

ここで相関関係図における矢印を「リンク」と呼ぶことにして、あるメンバーから他のメンバーへどのようにリンクし、またリンクされているかを調べることができます。

全関係の中からリンクの起点を抽出してソートしてみると

(sort-nodes (number-list (from-links)))

結果:

((kanna . 6) (saki . 5) (maimi . 4) (erika . 3) (mai . 3) (chisato . 3) (airi . 2))

栞菜ちゃんがメンバー全員にリンクを張っていることが分かり、℃-ute ラブっぷりが伺えます。なっきーにも同様の事が言えます。例の「女の子が好き」発言を数値的に裏付ける結果と言えるかもしれません。

ただ、データ不足でリンク件数がまだ少ないのと、リンクの性質（好意／反感など）までは分からない点を考慮する必要があるでしょう。

例 2: 被リンク状況の調査

同様に、リンクの終点の件数を調べてみます。

(sort-nodes (number-list (to-links)))

((chisato . 5) (erika . 5) (kanna . 4) (maimi . 4) (airi . 4) (mai . 3) (saki . 1))

えりかちゃんと千聖ちゃんが高ポイントです。メンバーからの人気や注目度の高さを示すデータですが、千聖ちゃんの場合敵対的なリンクが２件含まれている点に注意してください。

なっきーの被リンク数が極端に少ないですが、単純にデータ不足のためだと思われます。はぶら(ryとか言わないようにお願いします。

例 3: 愛情度の評価

リンクに付随するスコアを計算することで、愛情の度合いを測ることができるのではないか、という考えに基づく研究です。

まず、全ての関係性を対象として、スコアがマイナスの関係を抽出してみます。

(filter-nodes (lambda (n)
		(< (score-relation n) 0)))

結果:

(((kanna . chisato) (desc "愛理に手出すんじゃねぇよ") (score . -1))
 ((saki . chisato) (desc "愛理に手出すんじゃねぇよ") (score . -1)))

件数だけを得ると

(length (filter-nodes (lambda (n)
			(< (score-relation n) 0))))

僅か２件です。

良好・中立的な関係は

(length (filter-nodes (lambda (n)
			(= (score-relation n) 0))))

愛に満ちた関係は

(length (filter-nodes (lambda (n)
			(> (score-relation n) 0))))

非常に多いです。舞美ちゃんの「℃-ute同士でラブラブなんですよ」発言（例のラジオ）を数値的に裏付ける結果と言えるんじゃないでしょうか。

次に、メンバーごとのスコアを算出してみます。Lisp 的には以下のようにフィルタリングと畳み込み (fold) で計算することができます。例えば

(foldr (lambda (n acc)
	 (+ (get-score n) acc))
       0
       (filter-nodes (cut to? <> 'kanna)))

で栞菜ちゃんに対するリンクのスコアが得られます。結果:

上式を一般化して一挙にメンバー全員に適用してみると

(sort-nodes (map (lambda (x)
		   (cons x (score-loved x)))
		 (all-members)))

結果:

((airi . 4) (kanna . 3) (mai . 2) (erika . 2) (maimi . 2) (saki . 1) (chisato . 0))

愛理ちゃんが好意を寄せられやすい傾向が伺えます。

今度は逆方向のスコアを計算してみると

(sort-nodes (map (lambda (x)
		   (cons x (score-loving x)))
		 (all-members)))

((kanna . 3) (maimi . 3) (chisato . 2) (airi . 2) (saki . 2) (mai . 1) (erika . 1))

まいまいとえりかちゃんが特に堅い・一途だという傾向を読み取ることができます。

例 4: 相性の調査

今度は組み合わせ（カップリング）の評価です。

２点間相互のリンク・スコアを加算したものを「相性」と考えられるものとします。最大値 (互いに好意を寄せている場合の数値) は現在のスコアリング方式では 2 です。例えば

(score-between 'kanna 'airi)

の値は

となります。1 であれば一方通行と考えます。

関係性が未定義の場合もあるので 0 のものを除外して算出すると

(sort-nodes (filter (lambda (n)
		      (not (= (cdr n) 0)))
		    (map (lambda (n)
			   (cons n (apply score-between n)))
			 (all-combinations))))

(((chisato mai) . 2)
 ((chisato airi) . 2)
 ((airi kanna) . 2)
 ((saki kanna) . 2)
 ((kanna maimi) . 2)
 ((erika maimi) . 2)
 ((saki airi) . 1)
 ((saki erika) . 1)
 ((kanna mai) . 1)
 ((maimi airi) . 1)
 ((saki chisato) . -1)
 ((kanna chisato) . -1))

となります。若干ピンとこない部分もあるかも知れませんが、計算上は矛盾無くデータの内容を表しています。

参考までに、スコア 1 の相互関係の中身を見てみると

(map (lambda (p)
       (find-relation (cons (caar p) (cadar p))
		      identity))
     (filter (lambda (n)
	       (= (cdr n) 1))
	     (map (lambda (n)
		    (cons n (apply score-between n)))
		  (all-combinations))))

(((kanna . mai) (desc "喰ってやるよ") (score . 1))
 ((saki . airi) (desc "好き") (score . 1))
 ((maimi . airi) (desc "良き妹") (score . 1))
 ((saki . erika) (desc "彼氏にしたい") (score . 1)))

のようになります。

まとめ

以上の調査を経て気になった問題点を列挙してみます。

リンクの点数化の基準があいまい・恣意的
スコアリングの方式（３段階で良いのか・中立と良好を区別すべきか）
相関関係全体を俯瞰（可視化・画像化）する方法が未確立
データベースの拡充および修正

特に最初の点に関して、「百合的」なるものの質的評価がなかなか難しいと感じました。例えば「大好き」も「良き妹」も同じ 1 と評価してしまっているのが妥当かどうか、といったことです。

また、スレにて与えられた情報を評価・分析する方法としては有効だとしても、逆方向のフィードバックの手段がなかなか見つからないというのが三つ目の問題です（技術力不足とも言います）。（注：画像化の方法が分かりました。追記参照）

最後に、プログラムのソースを示します。実行には PLT Scheme が必要です。文字コードは UTF-8 で保存した上で、(load "c-ute.ss") としてください。文字化けする場合はターミナルが UTF-8 を表示できるよう設定する必要があります。がんばってください。

プログラム

c-ute.ss:

(require (lib "etc.ss")
         (lib "list.ss")
         (lib "26.ss" "srfi")
         (lib "delete.ss" "srfi" "1"))

;;; Utilities

(define true? (compose not not))

(define (ignore _) #f)

(define fif
  (case-lambda
    ((predicate consequent)
     (fif predicate consequent ignore))
    ((predicate consequent alternative)
     (lambda (x)
       (if (predicate x)
           (consequent x)
           (alternative x))))))

(define (concat! xs) (apply append! xs))

(define (mapconcat f lst sep)
  (let lp ((str (f (car lst)))
           (lst (cdr lst)))
    (if (null? lst)
        str
        (lp (string-append str sep (f (car lst)))
            (cdr lst)))))

(define (slice-string str len)
  (let lp ((res '())
           (str str))
    (if (<= (string-length str) len)
        (reverse! (cons str res))
        (lp (cons (substring str 0 len) res)
            (substring str len)))))

(define (break-string str len)
  (mapconcat identity (slice-string str len) "\\n"))

;; NOTE: input and output ports have to be either file-stream or #f
;; (i.e., cannot be a string port)
(define (run exe opt in out)
  (let-values (((p p-i p-o p-e)
                (subprocess out in #f exe opt)))
    (subprocess-wait p)
    (close-input-port p-e)))

;;; Database

;; http://ja.wikipedia.org/wiki/%E2%84%83-ute

(define names
  '((erika . "えりか") (maimi . "舞美") (saki . "早貴") (airi . "愛理")
    (chisato . "千聖") (mai . "舞") (kanna . "栞菜")))

(define (symbol->name sym)
  ((fif true?
        cdr)
   (assq sym names)))

(define nodes '())
(define edges '())

(define (relate from to desc score)
  (let ((n (cons from to)))
    (or (find-relation n
                       (lambda (r)
                         (let ((d (assq 'desc r))
                               (s (assq 'score r)))
                           (set-cdr! d (cons desc (cdr d)))
                           (set-cdr! s (+ score (cdr s))))))
        (begin
          (set! nodes (cons n nodes))
          (set! edges (cons (cons n `((desc ,desc)
                                      (score . ,score)))
                            edges))))))

(define (find-relation n k)
  ((fif true? k)
   (assoc n edges)))

(define (related? x y)
  (find-relation (cons x y) (lambda (_) #t)))

(define (from? n x)
  (eq? (car n) x))

(define (to? n x)
  (eq? (cdr n) x))

(define flip-relation
  (case-lambda
    ((n)
     (and (related? (cdr n) (car n))
          (cons (cdr n) (car n))))
    ((n k)
     ((fif true? k)
      (flip-relation n)))))

(define (get-score n)
  (cdr (assq 'score n)))

(define (get-description n)
  (cdr (assq 'desc n)))

(define (describe-relation n)
  (find-relation n get-description))

(define (score-relation n)
  (or (find-relation n get-score) 0))

(define (print-node . ns)
  (for-each (cute find-relation <>
                  (lambda (r)
                    (display
                     (format "| ~a => ~a  (~a)~%"
                             (caar r) (cdar r)
                             (mapconcat (lambda (s)
                                          (string-append "\"" s "\""))
                                        (cdr (assq 'desc r))
                                        ", ")))))
            ns))

(define (iter-nodes k)
  (let lp ((nodes nodes))
    (unless (null? nodes)
      (k (car nodes))
      (lp (cdr nodes)))))

(define (filter-nodes p)
  (let ((ns '()))
    (iter-nodes (fif p
                     (cut find-relation <> (lambda (n)
                                             (set! ns (cons n ns))))))
    ns))

(define (from-links)
  (map car nodes))

(define (to-links)
  (map cdr nodes))

(define (all-members)
  (delete-duplicates! (from-links)))

(define (all-pairs) nodes)

(define (ordered-pairs)
  (concat! (map (lambda (x)
                  (map car
                       (sort (filter-nodes (cute to? <> (car x)))
                             (lambda (x y)
                               (> (get-score x) (get-score y))))))
                (sort-nodes (map (lambda (x)
                                   (cons x (score-loved x)))
                                 (all-members))))))

(define (all-combinations)
  (let lp ((cs '()) (ns nodes))
    (if (null? ns)
        cs
        (let ((n (car ns)))
          (lp (if (member (list (cdr n) (car n))
                          cs)
                  cs
                  (cons (list (car n) (cdr n)) cs))
              (cdr ns))))))

;; number-list :: [a] -> [(a . Int)]
(define (number-list ls)
  (let lp ((ns '()) (ls ls))
    (if (null? ls)
        ns
        (let ((x (car ls)))
          (lp ((fif not
                    (lambda (_) (cons (cons x 1) ns))
                    (lambda (n)
                      (set-cdr! n (add1 (cdr n)))
                      ns))
               (assq x ns))
              (cdr ls))))))

;; sort-nodes :: [(a . Int)] -> [(a . Int)]
(define (sort-nodes ns)
  (sort ns (lambda (x y)
             (> (cdr x) (cdr y)))))

(define (diff-nodes ms ns)
  (let lp ((ds '()) (ns ns))
    (if (null? ns)
        (sort-nodes ds)
        (lp (let* ((n (car ns))
                   (m (assq (car n) ms)))
              (cons (cons (car n)
                          (- (cdr m) (cdr n)))
                    ds))
            (cdr ns)))))

(define (get-total-score x p)
  (foldr (lambda (n acc)
           (+ (get-score n) acc))
         0
         (filter-nodes (cut p <> x))))

(define (score-loved x)
  (get-total-score x to?))

(define (score-loving x)
  (get-total-score x from?))

(define (score-between x y)
  (+ (score-relation (cons x y))
     (score-relation (cons y x))))

(define (-> x)
  (display (format "~%Links from [~a]~%" x))
  (iter-nodes (fif (cut from? <> x)
                   print-node)))

(define (<- x)
  (display (format "~%Links towards [~a]~%" x))
  (iter-nodes (fif (cut to? <> x)
                   print-node)))

(define (<-> x)
  (display (format "~%Reciprocal links for [~a]~%" x))
  (iter-nodes (fif (cut to? <> x)
                   (lambda (n)
                     (flip-relation n
                                    (lambda (m)
                                      (print-node m n)))))))

(define (<=> x)
  (display (format "~%Reciprocal matches for [~a]~%" x))
  (iter-nodes
   (fif (cut to? <> x)
        (lambda (n)
          (flip-relation n
                         (lambda (m)
                           (if (ormap (lambda (x)
                                        (ormap (lambda (y)
                                                 (equal? x y))
                                               (describe-relation m)))
                                      (describe-relation n))
                               (print-node m n))))))))

(define (<?> x)
  (let ((to (assq x (number-list (from-links))))
        (from (assq x (number-list (to-links)))))
    (display (string-append
              (format "~%Link statistics for [~a]~%"
                      x)
              (format "| ~a => ~a (love ~a)~%"
                      x
                      (cdr to)
                      (score-loving x))
              (format "| ~a => ~a (love ~a)~%"
                      (cdr from)
                      x
                      (score-loved x))))))

(define (info x)
  (for-each (cut <> x)
            (list <- <-> <=> -> <?>)))

;;; GraphViz (http://www.graphviz.org/) support

(define graphviz "C:/Program Files/ATT/Graphviz/bin/dot.exe")

(define (nodes->dot ns)
  (string-append "digraph cute {\n"
                 ;;"\tordering=out;\n"
                 ;;"\trankdir=LR;\n"
                 "\toverlap=true;\n"
                 "\tnode[fontname=\"msgothic.ttc\"];\n"
                 "\tedge[fontname=\"msgothic.ttc\",fontsize=9];\n"
                 (let lp ((str "") (ns ns))
                   (if (null? ns)
                       str
                       (let* ((n (car ns))
                              (s (score-relation n)))
                         (lp (string-append
                              str
                              (format "\t\"~a\" -> \"~a\""
                                      (symbol->name (car n))
                                      (symbol->name (cdr n)))
                              (format "[label=\"~a\",color=\"~a\","
                                      (break-string
                                       (car (describe-relation n))
                                       7)
                                      (cond ((> s 0) "red")
                                            ((= s 0) "green")
                                            (else "blue")))
                              (format "style=\"bold~a\"];\n"
                                      (if (and (not (= s 0)) (< s 1) (> s -1))
                                          ",dashed"
                                          "")))
                             (cdr ns)))))
                 "}"))

(define (write-dotfile dot file)
  (and (file-exists? file) (delete-file file))
  (with-output-to-file file
    (lambda ()
      (display dot)))
  file)

(define (dot->png dot png)
  (call-with-input-file (write-dotfile dot "c-ute.dot")
    (lambda (in)
      (and (file-exists? png) (delete-file png))
      (call-with-output-file png
        (lambda (out)
          (run graphviz "-Tpng" in out)))))
  'done)

;;; Setup database

;; Based on:
;; http://ex23.2ch.net/test/read.cgi/morningcoffee/1188654905/116-142
(begin
  (relate 'maimi 'erika "大好き" 1)
  (relate 'maimi 'kanna "良き妹" 1)
  (relate 'maimi 'airi "良き妹" 1)
  (relate 'maimi 'mai "姉妹" 0)
  (relate 'erika 'maimi "一番可愛いよ" 1)
  (relate 'erika 'kanna "仲間" 0)
  (relate 'erika 'chisato "おソロパジャマ" 0)
  (relate 'kanna 'erika "仲間" 0)
  (relate 'kanna 'maimi "好き" 1)
  (relate 'kanna 'saki "喰ってやるよ" 1)
  (relate 'kanna 'mai "喰ってやるよ" 1)
  (relate 'kanna 'airi "大好き" 1)
  (relate 'kanna 'chisato "愛理に手出すんじゃねぇよ" -1)
  (relate 'saki 'maimi "荷物整理" 0)
  (relate 'saki 'erika "彼氏にしたい" 1)
  (relate 'saki 'kanna "興味がある" 0.5)
  (relate 'saki 'chisato "愛理に手出すんじゃねぇよ" -1)
  (relate 'saki 'airi "好き" 1)
  (relate 'airi 'kanna "受け入れる" 1)
  (relate 'airi 'chisato "最近親密" 1)
  (relate 'mai 'erika "保護者" 0)
  (relate 'mai 'maimi "姉妹" 0)
  (relate 'mai 'chisato "恋人" 1)
  (relate 'chisato 'erika "おソロパジャマ" 0)
  (relate 'chisato 'mai "恋人" 1)
  (relate 'chisato 'airi "最近親密" 1))

;; query relations / draw graphs

(if (file-exists? graphviz)
    (dot->png (nodes->dot (ordered-pairs))
              "c-ute.png")
    (for-each info (all-members)))

追記（グラフ描画について）

Graphviz というソフトによって関係図を可視化できる、ということを教えていただきました（既に上プログラムを実行すると自動的に関係図画像を作成するようにしてあります）。ここでは技術的な観点から幾つか注意点を挙げておきます。

まず、Scheme プログラムから Graphviz を動かす方法について。コマンドラインからの起動のように、プログラムへのオプション文字列で入出力ファイルを指定する方法ではどうも上手く行きませんでした。調査の結果、入出力ファイルのポートを Scheme 側で用意しておく必要があるようです。処理系によって異なりますが、PLT Scheme の場合 subprocess という関数を次のように呼び出します。

(subprocess output-port input-port #f "/path/to/dot.exe" "-Tpng")

ここで output-port は png 等画像ファイルへの出力ポート。input-port は dot ファイル（グラフの定義ファイル）の入力ポートです。エラーポートは必要無いでしょう (#f)。

dot という名前の実行ファイルが、関係図のような有向グラフを描画するプログラムです。最後にオプション文字列として出力形式を指定します（png, jpeg, gif, etc.）。

次に dot ファイルを Scheme で書く方法ですが、以下の基本的な有向グラフの書式

digraph g {
  A -> B;
  B -> C;
  C -> A;
}

を理解すれば、後は実直に Scheme のデータを当てはめて format 関数等で変換するだけです。

(string-append
 "digraph g {"
 (format "~a -> ~a;" (car node) (cdr node))
 "}")

問題は、ノードを配置する順番によって出来上がる画像が変わってくる、ということです。

より見た目に分かりやすくするための工夫としては、相互にリンクするノード同士が dot ファイル上でも近接して出力されるようにすると良いでしょう。関連の強いものが画像の上でも近くに表示されるようになります。

また上述（特に例３）のスコアの概念を応用し、スコアの低いものが後に出力されるようにすることで、重力感覚に一致するような関係図を得ることができるでしょう。

Permalink | 記事への反応(0) | 17:26

「早貴」を含む日記

■令和の女って最早貴族だよな

■#枝野、降りろ

一、総選挙敗北の罪

一、大言の罪

一、管理不行き届きの罪

一、戦略を見誤った罪

■垢抜けってなんだ？

■垢抜けってなんだ？

■ようこそ、℃-ute な Lisp の世界へ

はじめに

例 1: リンク状況の調査

例 2: 被リンク状況の調査

例 3: 愛情度の評価

例 4: 相性の調査

まとめ

追記（グラフ描画について）