「スコアリング」を含む日記 RSS

はてなキーワード: スコアリングとは

2018-12-26

anond:20181226150422

で、件のGreen500のスコア計測方法には※施設全体の冷却効率コスト含まず みたいなレギュレーションがあるわけだ。

そこで思う訳だな。「要は石狩あたりでパソコン動かせばGreen500のスコア稼げね?」と。

一行目のレギュレーションがあるなら二行目は成り立たねーじゃん。ピュアな消費電力がスコアリングの対象だと言ってるんだから

2018-11-04

anond:20181104072955

そういやバブルの頃はアッシーメッシーだの実際に何股も交際して吟味してその中でスコアリング低いオトコを馬鹿にして

そもそも交際基準に満たないオトコは論外って感じだったのに

近年はゴミ箱からわざわざゴミを拾ってきてバカにしてるあたりバカにする対象シフトが起きてるな

2018-10-13

anond:20181012235158

もともと男女の応募数の割合と最終的な採用数の割合それぞれに環境的あるいは社の採用ポリシーによるジェンダーバイアスがあって、

予測モデルがそのとおりにスコアリングしたなら、結果的ポリコレに反していようが社の方針とは一致するんだから内部運用的に使わない理由はない。

そうじゃなくて、女性特有の特徴量が女性に対して不当に偏った低いスコアを与えるモデルができた、チューニングによる補正を試みたがそれも難しかった、

ということが分かったか運用をやめたというごシンプルな話かと。英語の元記事読んでもそこまでしか読み取れなかった。

2018-10-12

anond:20181012224310

AIによるスコアリングに偏りがあったこと、それが採用担当者による評価整合しなかった以上のことは言えないでしょ。

イデオロギー的に不都合というなら深読みしすぎかと。ブコメもそういうの多いけど。

2018-08-05

妊娠出産でも親の介護でも鬱による引きこもりでも

どんな原因だろうが離脱期間がある人が離脱期間のない人より評価引かれるのは当然だろう

離脱する理由社会的に仕方ないことだよねってのと現場での評価スコアリングは別の話だ

2018-06-24

苦労自慢を止めさせる前に限りなくパーフェクトな評価基準必要

苦労がスコアになる環境時代を生きてきてんだし

スコアリング基準を徐々に変えていくのはいいけど蓄積スコアを一夜にしてリセットというわけにもいかんしな

2018-06-07

anond:20180607124839

それこそ炎上キーワード集めておいて

SNSを横断検索かけてスコアリングするようなサービス作れば流行るかもな

2017-11-24

anond:20171124101335

Amazonの最終形態とは何か?」この問いは結構面白いなと思った。

Amazon本質とは商品評価スコアリングをする巨大なデータベースのことだ。例えば「Amazonスコア」みたいなもの絶対スコアとなり、人にも、商品にも、消費活動対象には必ず現れる絶対的権威となる。アリババ社会信用スコアを付けるようになったというニュースを聞いたが、あれはAmazonに先んじてその未来を実現してしまったのではないか、なんて考えた。

でもAmazonってAWSとかやってるよね。この場合Amazon仲介業者ではなく直接の売り手(貸し手)だ。だからAmazon業務内容を定義しようとする事に意味は無い。これから先も新しいサービスを始めるだろうし。そこで、最初の問いは「テック企業の最終形態とは何か?」という問いに改めた方が良い。すると、最初の問いは、「Appleの最終形態とは何か?」或いは「Googleの最終形態とは何か?」という問いと同じ意味になる。

では、これら企業の最終形態とは何だろうか。多分その答えは「集合知を実現するものなのだと思う。

一人一人のユーザーから少しずつ情報を受け取って、その全体像を描き出し、それを再び一人一人に還元する。これらテック企業を通じて、人は個であり全となるのだ。AmazonAppleGoogleは、そのための最も大きなハブとして今後も繁栄するだろう。これは宗教国家などに喩える事のできない、人類史上初の新しい概念だ。

2014-08-20

高校の時マネージャーやってた

そのジャンルでは割と強豪校で、某マイナー競技のマネージャーを、その部にいた友人に頼まれて、まぁ他にやりたいこともないしいいよーと引き受けた

部費獲得の折衝とか試合スケジュール、練習場所スケジュールの確保連絡、備品管理、対外交渉もろもろ

あらかじめ決められた練習メニューのチェックや成果をメモして顧問コーチ部員と共有、練習試合やらのスコアリング、ぐらいが平常時のルーティン

夏と冬に合宿やるんだけど、その時は特別予算があって、その中で予算配分顧問部長副部長相談しながら決めて

マネージャーは私一人だったから、食材購入や調理部員3人を当番制で手分けをしてやった。

何十人分ものごはんを色んなくだらないことをキャッキャと話しながら作るのは面白かったし、みんなそれぞれ色々な気持ちを持って取り組んでるのねとか

あの人とあの人はあんまり実は仲良くないのね、とか、恋バナとか、そういうのがとにかく楽しかった。

合宿所の掃除やら生活備品やらは自分たちでやってもらってた。

テーピングとかは手が届くところはみんな自分でやってたしやりにくい場所は男同士でやってたw

やす、道具を用意する、以上の医療行為ケア行為保険校医にお願いしにいってた。

大会期間中は運営補助もやったりするので、かなり忙しかったけど、他校のマネージャーと仲良くなって

練習試合やら別の大会やらで再開した時にキャーってなったりして、そういうのもすごく楽しかった。

最初ルールもあんまりからなかったけど、色々勉強して、教えてもらってすごく面白くなった、スコア付けなきゃならないし必死

マネージャーやったきっかけで、それまで運動音痴スポーツ自分ではできそうにないと思ってたけど、色んな競技を見るのは大好きになった

それに趣味程度なら自分でもやってもいいかと思って、テニスを始めた(大学に入ってから、今でもやってる。あんまりうまくはならないけど)

あと実際に結構体力仕事なので体力がついたのは大きかった

3年のインター杯予選で負けて引退。1年生にマネージャーで入ってくれた子が居たのでその子に引き継いで

慌てて受験勉強のペースを速めて、がんばってがんばって、現役で志望大学に入れた。

色々な折衝やらなんやらで、マネージャー同士が仲良くなって、部活引退後は、サッカー部のマネ、野球部のマネとつるんで行動してた、一緒の予備校の講習に行ったり

サッカー部マネは某有名私立大学野球部マネは某有名国立大にそれぞれ合格

3人とも特に部員とのロマンスもなく、普通に大学生になり、彼氏が出来たり別れたりしながら、一人はお母さんと主婦をやっている、一人は独身でばりばり働いてる。

私もまだ働いてる、バリバリかどうかは分からないけど。仕事は、色々大変だけど納得がいく仕事にはつけている。


おにぎり握らせるなんて何の意味もない」って言いきっちゃうのが、心底理解できない。

少なくとも私は、高校生活がとっても楽しかったしマネージャーをやって後悔もしてない、失敗したとも思ったこともない、

しろ自分が今まで見てこなかった新しい世界が見られて、すごく良い経験だと思ってた。今、楽しんでいるスポーツ趣味を得られたのは高校時代マネージャー経験のおかげだってのもあるし

どんなことであれ「それを選択した結果、別の道が消失する」のなんて当たり前なのに、なんで「間違った道」だと決めつけるんだろう。

視野が狭すぎやしませんか。

2014-02-20

http://anond.hatelabo.jp/20140220180940

冬のオリンピックからフィギアスケートは既に無くなっているよ

---

http://en.wikipedia.org/wiki/Ottavio_Cinquanta

---

オッタヴィオチンクアンタ(ローマ1938年8月15日生まれ)は、国際スケート連盟会長国際オリンピック委員会メンバーです。

彼は1996年から1994年ISU位置とIOC位置を開催しています

2000年、彼は、IOC執行委員会は、彼が2008年まで開催されているという立場メンバーに選出された。

前に、ISU会長になることに、彼はISU副社長だったショートトラックスピードスケートのための技術委員会委員長の前に。

チンクアンタ氏は、陸上競技でのアイスホッケー選手として、アイススピードスケートとして実施ミラノイタリアで育った。チンクアンタは大学に出席し、彼は経営学を中心に活躍した。 ISU議長に彼の選挙の時に、 56歳の時、彼は国際的な化学会社経営者としての立場から引退した。

チンクアンタが最初にISU議長に選出されたとき、彼は最初に、ABCスポーツとの重要テレビ契約を含むいくつかの商業契約を交渉した後、ISUのイベントで賞金を導入した人プログレッシブとした。これは、ISUがそうで、トップスケーターに大規模な出演料を提供していた承認されていない作のためテレビプロスケート競技会に参加するオリンピック適格スケートを残している可能性がアスリートを保持することができました。テレビお金もISUを含む、両方のフィギュアスケートスピードスケートの分岐で開発プログラムのさまざまなを維持することができ、例えば、フィギュアスケートISUグランプリ

しかし、彼のスピードスケート背景、チンクアンタは、特にカナダ米国では、フィギュアスケートからの批判にかなりの量の対象となっている。 2002冬季オリンピックスキャンダルフィギュアスケートの間に、彼は彼の曖昧と、彼は「図がうまくスケート知っている」しなかったことを彼の入学を批判された。 [ 1 ]スポーツについての知識の彼公言不足にもかかわらず、彼は提案した[ 2 ]主な特徴、これまで個々の裁判官競争マークしたのかを知ることから誰かを妨げる秘密であるフィギュアスケートのための新しいスコアリングシステムワシントンD.C.2003年世界フィギュアスケート選手権秘密審査実施は、彼が紹介されたときはいつでも、 [ 3 ]チンクアンタと個人的に視聴者jeeredされ、そのイベントでファンの抗議をもたらすのに十分な論議をした。 [ 4 ] [ 5 ]

彼はそのイベント開会式では、滑走のローカルスケート好きなカート·ブラウニングを防止するための専門性を呼び出した後にチンクアンタは、以前大声[ 6 ] [ 7 ]と再びで、エドモントンアルバータ州にある1996年世界フィギュアスケート選手権でファンからブーイングされていたミネアポリスミネソタ州にある1998年大会は、 [ 8 ]

チンクアンタは連続してすべてのISU選挙学会でISU議長に再選されており、それは[誰によって?]と推定され、1994年に彼の最初選挙以来、約30の技術革新は、図の投与2枝に関する国際スケート連盟に導入されていることをスケートスピードスケート

---

Ottavio Cinquanta

From Wikipedia, the free encyclopedia

Jump to: navigation, search

2011 Rostelecom Cup - Ottavio Cinquanta.jpg

Ottavio Cinquanta (born 15 August 1938, in Rome), is President of the International Skating Union and a member of the International Olympic Committee.

He has held the ISU position since 1994 and the IOC position since 1996.

In 2000 he was elected member of the IOC Executive Committee, position that he has held until 2008.

Prior to becoming ISU President he was ISU Vice President and before the Chair of its Technical Committee for Short Track Speed Skating.

Cinquanta grew up in Milan, Italy, where he practiced as an ice hockey player, in athletics and as an ice speed skater. Cinquanta attended university and he was mainly active in business administration. At the time of his election to the ISU Presidency, at the age of 56, he retired from his position as a manager of an international chemical company.

When Cinquanta was first elected to the ISU Presidency, he was initially regarded as a progressive who introduced prize money at ISU Events after negotiating several commercial contracts, including an important television contract with ABC Sports. This allowed the ISU to retain athletes who might have otherwise left Olympic-eligible skating to participate in unsanctioned made-for-television professional skating competitions, which were then offering large appearance fees to top skaters. The television money also allowed the ISU to sustain a variety of development programs in both Figure Skating and Speed Skating branches, including, for example, the ISU Grand Prix of Figure Skating.

However, because of his speed skating background, Cinquanta has been the subject of a considerable amount of criticism from the figure skating community, particularly in Canada and the United States. During the 2002 Olympic Winter Games figure skating scandal, he was criticized for his evasiveness and his admission that he didn't "know figure skating so well".[1] In spite of his professed lack of knowledge about the sport, he proposed a new scoring system for figure skating[2] whose major feature is secrecy which would prevent anyone from ever knowing how an individual judge had marked the competition. The implementation of secret judging at the 2003 World Figure Skating Championships in Washington, D.C., was controversial enough to result in a fan protest at that event,[3] with Cinquanta personally being jeered by the audience whenever he was introduced.[4][5]

Cinquanta had previously been loudly booed by fans at the 1996 World Figure Skating Championships in Edmonton, Alberta, after he invoked a technicality to prevent local skating favorite Kurt Browning from skating in the opening ceremony of that event[6][7] and again at the 1998 Championships in Minneapolis, Minnesota.[8]

Cinquanta has been consecutively reelected to the ISU Presidency at all the ISU elective Congresses and it is estimated[by whom?] that since his first election in 1994, approximately thirty innovations have been introduced in the International Skating Union regarding the two branches administered of Figure Skating and Speed Skating.

---

2012-01-07

自分にとっての結婚観は、センター試験スコアリングに似ている。

主要科目の容姿収入性格親族家庭、財産の500点満点で一定スコアを上げないと、そもそも足切り食らって結婚できない。

ちなみに自分の基本点はこんな感じ。


こりゃ結婚できないだろ。それこそ聖母様のような女性でもなければ、こんなのと結婚するわけがない。恋愛資本主義でいうところの破綻した会社の株みたいなもんだな。

なので、親族家庭以外の科目を補えるように、少しでも他の得点を伸ばすことが結婚への近道だという認識。やせて、性格のゆがみを直し、収入を上げるべくキャリアアップに励み、貯金を作る。

結婚したいけど結婚できない男ってのは、結婚に興味ない男以外では、この得点を伸ばす最中か、得点を伸ばすことを諦めた男が地味に多いんじゃないかと思う。

2007-10-23

検索結果が微妙にずれる理由の一つの単純例

ネガティブスコアリング。検索ワードに対してフィルタが直接かかるなんて訳ではない。画像検索がページ検索の結果を処理する場合特に顕著になるはず。

ページ検索自体までは普通に使われる。次にページからリンクされる画像ファイルに対して「一般的な類似・関連度評価」(実際にはいろいろあるけどね)を行うんだけど、そこで一番高い評価のリンクネガティブスコアリングして、二番目のものを結果として返す。適切と思われるページの適切と思われない画像が結果としてかえることになる。画像スパムに対するフィルタでこういう動作を実装することもある。


       けどまあそんな単純な方法取ってるとも思えないんだけどね。

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)のスコア概念を応用し、スコアの低いものが後に出力されるようにすることで、重力感覚に一致するような関係図を得ることができるでしょう。

ログイン ユーザー登録
ようこそ ゲスト さん