「千聖」を含む日記 RSS

はてなキーワード: 千聖とは

2019-10-14

ジークリサの弟?」

「俺の命令に従え!!すべてのユミルの民から生殖能力を奪えと言っているんだ!!今すぐやれ!!ユミル!!」

ジークは叫んだ。

「俺は王家の血を引く者だ!!」

ジーク最後に目にしたのは、涙する始祖ユミルと、それを支えるエレンだった。次の瞬間、すべてが暗転した。

いかなる原理によるものか。宇宙真空の量子揺らぎからインフレーションにより生じたものだと言う。ある世界線の内部を往来するうち、量子的に絡みあう複数世界線が混線した。そして、ジークは他の世界線へと転落した…

店舗と住居を兼ねる北沢精肉店の二階で、はぐみの兄は目を覚ました。

はぐみの兄はボリボリと頭を掻き、寝惚け眼で放心した。朝日がその横顔を照らしている。大学講義もなく、朝の身支度をする必要がなかった。

しばらくして、はぐみの兄は股間をまさぐり、やがて絶叫した。

「た、勃たなくなってるーッ!」

その大声でジークは体を起こした。眼鏡位置を直す。

「《うるさいな…》」

マーレ語で言ったが、はぐみの兄には通じなかった。

(《ここは…ヒィズル国か?俺は始祖ユミルといたはずだが、どうしてここにいるんだ?あれからどうなったんだ?ユミルの民から生殖能力を奪うことはできたのか?》)

思考に沈潜するジークに対し、はぐみの兄はふたたび絶叫した。

「うわーッ!裸にジーパンの髭のオッサンが、俺の部屋にーッ!」

地上から商店街を走る自転車チリンチリンというベルの音が聞こえていた。

「あたしがもう一人!?どういうことだ!?しかもなんか胸がデケェし!」

「うるせー!胸のことは言うんじゃねー!」

流星堂の土蔵の前で、二人の有咲が言いあいをしていた。

「うわー、有咲が二人!これで次の定期試験は楽勝だね!」

「はァ…もう一人の私、声が大きくて苦手かも」

二人の香澄が声を出すと、二人の有咲はさっとそれぞれの香澄の背後に回った。異なる香澄とはいえ、対人恐怖症は拭えないらしい。

香澄と有咲に偽物がいる。…双子の入替わりトリック?」

「これがもう一人の自分っスか。正直、信じたくないっス…」

一人のたえの泰然とした様子に、もう一人のたえは肩を落とした。

「いったい何が起きたんだろうね。うち、すこし怖いかも。あ、関西弁が出ちゃった!」

りみがわざとらしく怖がる。が、混乱の最中にあって誰も反応しなかった。

「うわー。ポピパはまた大変なことになってるね」

流星堂の門内を覗いたリサが大げさに言う。おどけた態度と裏腹に、表情に疲労が滲んでいた。

リサの腰には小学生ほどの少年がまとわりついていた。

リサさん、そのガキ…いや、子供は?」

胸が大きいほうの有咲が尋ねる。もう一人の有咲はリサと面識がないため、対人恐怖症を発揮しオドオドとしていた。

「アタシの弟ってことみたい。気づいたらいたんだ。どうにも、ポピパでも似たようなことが起きているみたいだね」

リサの後ろにはRoseliaの残りのメンバーもいた。

「でもリサさん、いくらガキとはいえ、知らない異性が家にいるのはキツくないですか?」

リサはすばやく片目で瞬きした。

「え?《年下の少年性的な目で見られて気持ち悪いけど、それを口にして傷つけるほどでもないし、気付かないフリをしている》?リサさんすげー!一瞬のアイコンタクトでこれだけの情報を伝えてきた!」

有咲は感嘆した。一方、リサの弟はリサ本音暴露されてショックを受けていた。

「でも、異常は人が増えたり現れたりしていることだけじゃないみたいよ」

千聖流星堂の門内に入る。

「あッ、紗夜さん!助けてください!」

「待ってください、紗夜さん!助けるなら私を!」

日菜の両脇につぐみが一人ずつ抱えられていた。

「は、羽沢さんが二人…」

紗夜はその光景を見て呆然とした。

「アハハ。面白いよね。こっちのつぐちゃんおっぱいちょっと大きくてー、こっちのつぐちゃんはまっ平らなんだ」

「また人が増えた…それで白鷺先輩、他の異常ってなんですか」

「なんと言ったらいいのかわからないのだけど…

千聖ちゃん生理が来なくなったんだよねー」

言葉を濁す千聖無視し、日菜は直接的に言った。

「それはオメデタ…じゃないですよね。ピルを飲んだりとかしたんですか?」

千聖の殺気立った気配を感じ、有咲はすばやく言葉を変えた。

「そうね。昨日までは普通に生理は来てたのよ。それで、この異常でしょう。気になってスタッフさんたちや知人に尋ねてみたら、やはり急に生理がとまった人がいたのよ。というより、生理という現象がなくなったというほうが自然ね。個人的にはありがたいけれど…」

千聖ちゃん、いつも生理中はイライラしてるもんねー」

彩は自分失言に気付き、顔を青ざめさせた。

花音たちにも同じような異常が起きているみたいなの。ここに呼ぶわね」

しばらくして、ハローハッピーワールドメンバーが現れた。

はぐみはスーツを着た会社勤めらしい女性に背負われている。

「見て見て。この人、はぐみのお姉ちゃんなんだ。はぐみ、ずっとお姉ちゃんがほしかたから嬉しい!」

紗夜は口元に手を当てた。

「つまり、今現在わかる異常はこのようになるでしょうか。第一に、異なる可能性の同一人物が同時に存在している。第二に、存在しないはずの兄弟姉妹存在している。第三に、広い範囲で人々の生殖能力が停止している」

「第二の異常が重要だと思うな。もし第二の異常が第一の異常と同じ原因なら、第三の異常は独立した問題ってことになるもん。ただ、第二の異常が第一と第三、それぞれの異常と同じ原因のものが混ざってるってこともありえるけどねー」

日菜が紗夜の分析をすばやく補足した。

「でも本当、どうしたらいいだろうねー。もう一人の私に学校に行ってもらって、私たちバンド練習しよっか。あ、でもさーやはもう一人のさーやが夜学らしいから、どのみち二人とも学校に行かなきゃ!」

「うー。やっぱり、この私は苦手だ…」

暗いほうの香澄がため息をつく。

そのとき、怒声が聞こえた。

「待てー!モカ!」

一同が路上に出ると、上半身が裸でジーパンを履いた髭男が走ってきた。その後ろをモカが追っていて、時折ふり返りつつ、石を投げている。

大学生らしい青年と、Afterglowメンバーが二人を追っていた。

「あッ、はぐみ」

「兄ちゃん!」

大学生らしい青年ははぐみを認めた。

そいつを止めてくれ!俺のEDそいつが原因なんだ!」

一同は髭男を見た。

「みんな、ジークさんの邪魔をしないで!」

モカが鬼気迫る表情で叫ぶ。

「よくわからないけど、あの男、友希那のお父さんと同じ雰囲気がする!自堕落無責任無能力だけど、ときどき妙な行動力を発揮して周囲に大きな迷惑をかけるタイプだよ!」

リサあなた、私のお父さんのことをそう思っていたの…」

友希那は表情に微妙なショックを浮かべた。

一同が道を塞ぎ、モカジークは包囲された。

「はァはァ…ヒィズル国の言葉が通じて協力者を得ることができたのはいいが、そのために敵もできてしまったな。まあいい…どういうわけか、いまの俺は《始祖の巨人》の力を手にしているのだからな。舞台は変わったが、計画は続行する!このまま、この世界のすべての住民生殖能力剥奪する!」

「そんなこといいわけないでしょ!モカ、なんでそんな気持ち悪いオジさんに手助けするの!もうあたしの『ゼクシィ』貸さないよ!」

「そうだぞ、モカ人間は守るべき家族をもって一人前だろうが!そして自分を産んで育ててくれた親と町、国に感謝だ!ソイヤぁ!」

まりと巴が問詰する。

モカ淡々と言った。

「ごめーん。でも、モカちゃんもう決めたから。あたしたちが最後人類になるの。それで、これまでのすべての人類の屍の上に、あたしと蘭だけがきのこるんだ。それって素敵じゃない?」

蘭は甲高い声をあげた。

「はァ!?意味わかんないよ!なに言ってんの、モカ!?っていうか、気持ち悪いよ…」

「蘭にはわからないだろうね。けど、あたし、もう蘭の背中を追いかけるのは疲れちゃったよ…」

微笑するモカの目は、涙に濡れて見えた。

「あたしたちはみんな、生まれてこなければ幸せだったんだよ。音楽コンプレックスからはじまる。ここにいるみんなも、生まれてこなければ良かったって思ったことが絶対あるよね!?それが正解なんだよ!もう、そんな過ちをくり返しちゃいけない。全部ここで終わらせるんだ」

その言葉に、その場の数人は沈黙した。

千聖が輪のなかに踏みだした。麻弥はハッとした。思索的で感受性の高い麻弥には、千聖モカ言葉共感したことがわかっていた。

千聖はポツリと言った。

「私の人生に、いいことはほとんどなかったわ」全員が千聖注視する。「思いだすことのできる最初記憶は、母に子役として振舞うことを無理強いされたときのものよ。私は母に褒めてもらいたくて、必死努力したわ。けど、母が私を肯定してくれることはなかった…努力過程けが残って、私は自尊心ばかり高い、空っぽ人間になった。それが向上心という形で、攻撃的にあらわれてしまうこともあったわ。パスパレのみんなと知りあって、ようやくそんな自分を変えることができた。けど、たしかに生まれてこないほうが良かったと言われれば、それを否定することはできないわ」

千聖ちゃん…」

彩が目に涙を浮かべる。

「けれど、たしかに言えるのは、自分人生が悪かったという理由で、他人生殖能力を奪うような自分は、生まれてきたことよりもなお悪いと言うことよ!」

千聖は啖呵を切った。

千聖ちゃん!」

千聖さん!」

Pastel*Palettesメンバーが抱きつく。

千聖さんの言うとおりです!モカさん、あなた大和撫子の風上にもおけません!子孫繁栄富国強兵ブシドー天誅です!」

イヴたまたま持っていた竹刀モカジークに襲いかかる。

あんたたち、こっち!」

胸が小さいほうの有咲が声をかける。門内を示され、モカジークはすばやく駆けこんだ。二人が入ると、有咲は鍵をかけた。

「何やってんだ、お前ーッ!」

胸が大きいほうの有咲が怒鳴る。しかし、有咲は鍵を握りしめて離さなかった。

「ごめんね。でも、私、どうしても生まれてきたほうが良かったと思えない…!」

有咲はその場に座りこんだ。膝に顔をうずめ、しばらくすると嗚咽が聞こえてきた。

「有咲…」

暗いほうの香澄が呟く。有咲の苦しみを知っている香澄は、その言葉を軽々に否定できなかった。

そのとき、いくつかの弦の音が聞こえた。

「生まれ場所から、すこし、はなーれてー」

うるさいほうの香澄ランダムスターを手に、歌を口ずさんでいた。

有咲が顔をあげる。香澄の歌は次第に勢いを強めていった。『Returns』。はじめに合唱に加わったのは、もう一人の香澄だった。有咲、二人のたえと、次々と合唱に加わった。

「あったかもしれない未来のことー、なかったかもしれない過去のことォー!自分の姿を鏡に映し、キミは誰なのと、問いかけてみたァー!」

やがて、Poppin’Partyの全員が合唱した。有咲は涙を拭い、門の鍵を開けた。

門内に突入し、モカジークを囲む。

「《チッ、使えないヤツだ…》」

ジークマーレ語で毒づいた。

「俺の《安楽死計画》はまだ生まれてこない子供対象にしたものだ。いま生きているもの犠牲にすることは避けたかったが、仕方ない…始末させてもらう!」

ジーク自分の腕を噛み千切った。一瞬であたり一面が蒸気と熱気に包まれた。

「おいおい。人間が増えたり減ったりする怪奇現象が起きてるって言うから取材に来てみりゃよォ…またこの姿になるとはな」

有咲は怖々と目を開いた。触手で全身が構成された巨人が有咲たち全員を蒸気と熱気から守っていた。

気付くと、ラフ服装女性と、テレビカメラハンチング帽の男性が傍らにいた。

女性挨拶する。

「私は映像制作会社ADをしている市川と言います。こっちはカメラマンの田代です。えーと、あと、あの大きいのがディレクター工藤です」

「おう!撮影許可も貰っとけよ!」

市川は苦々しそうな表情をした。

巨大化した工藤は、類人猿のように見える巨人をとり押さえていた。

「俺も業界にいて長いからよォ。てめェみたいなツラのヤツはよく知ってるぜ。おめェらみてェなヤツはよ、いろいろもっともらしい理屈を捏ねるけど、要は部屋に引きこもって一人で◯◯◯◯してるのがお似合いなんだよ!」

「う…」

巨大化したジークは呻いた。だが、それは哄笑の前触れだった。

ハハハハ!わかっていないようだな。格闘戦で俺に勝とうが、なんの意味もないということが。俺は《始祖の巨人》の力を手にした。それは、この世界のすべての生物操作できるということだ!はじめからお前らに勝目はないんだよ!もうお前らの体を直接、操作して全員、絶滅させてやる!」

その場の全員が硬直した。

「もし、いまの俺を倒せるとしたら、直接、因果律に介入できるヤツだけだ!ハハハハ!」

「呼んだか?」

空中に亀裂が走った。裂開したなかから、冴えない中年男性が出てきた。背中制服姿の少女を乗せている。

「よッ、白石君。助けに来たで。おっと。いけない、田代君やったな」

「助太刀にきたでござる。ニンニン」

「りみ!」

背中にいる少女を見て、暗いほうの香澄が声をあげた。

冴えない中年男性は巨大化したジークに言った。

「知っとるか?高圧鍋や圧力釜なんかは、威力の高い爆弾材料になるんやで。つまり炊飯器はえ爆弾材料になるんや。ゆうても、炊飯器がなんなのかわからんやろうけどな」

まさかうちの炊飯器をこんなことに使うとは思わんかったわ。まあええわ。みんなを助けられるんならな。御免」

もう一人のりみは炊飯器を巨大化したジークの延髄部に放った。

「《や、やめろおおおお!》」

ジークマーレ語で絶叫したが、その言葉理解できるものはいなかった。

爆音とともに、巨大化したジークの延髄部が爆散した。

全身に火傷を負い、四肢の断裂したジーク中年男性は担ぎあげた。

「お前はアッチの世界に連れていくわ。案外、お前みたいなヤツにはアッチの世界のほうが居心地がええかもな」

ふたたび、りみと裂開のなかに飛びこむ。その間際に言った。「もろもろの因果律も俺が修復しとくから、まあ安心しといてな。じゃ、またな、白石君」

「江野さん…」

田代呆然と呟く。しかし、その声を聞くものはもういなかった。

モカ…」

蘭は涙を流して放心するモカの肩を抱いた。しかし、モカがその声に応えることはなかった。

リサやはぐみは、つかの間の兄弟姉妹と別れを告げた。千聖生理が復活して沈鬱な表情をしていた。

二人の有咲が対面する。胸の小さいほうの有咲が言った。

「いろいろ、迷惑をかけて悪かったな」

別にいいって。あたしのしたことだしな」

有咲たちは同時に笑った。

「いろいろあったけどさ、あたしはちがう可能性のあたしを見て、なんだかんだ、いまの自分が好きなんだってわかったよ。…ありがとな」

「お前はもう一人のあたしだ。すこしでも運命歯車がズレてたら、あたしもお前みたいになっていたかもしんねー。いまのあたしのことも、すべて受けいれられるわけじゃねーし。だから、お前を助けられたなら良かったよ」

ちがう世界の有咲はこの世界香澄に言った。

「お前も…サンキュ」

「うー。有咲がいなくなって寂しくなるよ」

「お前にはあたしがいるだろうが!」

この世界の有咲が叫ぶ。

「えッ、有咲…?」

「うるせー!いまのはなし!」

「有咲ー!」

香澄は有咲に抱きついた。そうしているうち、ちがう世界住民たちはいなくなっていた。

「離せ!妊娠したらどうすんだ!」

「なに変なことを言ってるの、有咲ァ」

「あれ?本当だ。どうしてそう思ったんだ?」

江野は因果律の修復である間違いを犯したようだった。

些細ないまちがいと綻びで、この世界はできている。

(終)

2018-02-25

バンドリ!ガルパのストーリーを書いているライターがすごい

バンドリ!ガールズバンドパーティというアプリゲームがある。

ジャンルとしては音ゲーなのだが、結論から言うとそのストーリーの厚みが素晴らしい。

今までも沢山の濃密で質の高い話を提供してくれてきたのだが、特に実施中のイベント、「What a Wonderful World!」における氷川日菜の描写は凄まじい。

日菜はいわゆる「天才キャラ」で、大抵のことはすぐに習得できてしまう。

そして努力しても上手くいかない人間に対して「なぜ出来ないのか理解できない」と一切の嫌味なく言ってしまえる「人でなし」だ。

この孤独怪物が、Pastel*Palletsというバンドメンバーとして他人との交流を深める中でどうなるか。

普通漫画/アニメ的な展開ならば、メンバーとの絆を深める中で自分は一人ではないという人間情緒を知り、他人との共感を覚えて理性を獲得していくーーそんな話になるだろう。

しかしこのゲームは違う。

日菜は「他人自分とは違う、理解できない、だからめちゃくちゃ面白い」と言ってのける。

そして、同じバンドメンバーである千聖は日菜に関して「天才故に誰のことも理解できず、誰から理解されない」と認識する。

かに絆は美しかろう、理解は大切だろう、しかしそんな手垢のつきまくった、何の説得力も無い「怪物の人化物語」などではない。

天才天才として真の孤独という自由に解き放っているのだ。

日菜の思考主観客観という問いにも至る。

ストーリーテーマを完全に読み解くには恐らく哲学的教養(特にドイツ観念論)が必要になるのではないだろうか。

とにかく凄い。

オートで流せば35分程度の短さ、しかも他にも山盛りの要素を入れないといけない制約の中でこんな深い話を書けるライターが、なぜスマホゲーの仕事をしているのか…。

ぜひ名前を出して欲しい。

2007-09-07

ようこそ、℃-uteLisp の世界へ

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

はじめに

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

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

(kanna . airi)

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

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

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

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

例 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))

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

なっきーの被リンク数が極端に少ないですが、単純にデータ不足のためだと思われます。はぶら(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))))
2

僅か2件です。

良好・中立的な関係

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

愛に満ちた関係

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

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

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

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

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

3

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

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

(score-between 'kanna 'airi)

の値は

2

となります。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 ファイル上でも近接して出力されるようにすると良いでしょう。関連の強いものが画像の上でも近くに表示されるようになります。

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

 
アーカイブ ヘルプ
ログイン ユーザー登録
ようこそ ゲスト さん