「ITER」を含む日記 RSS

はてなキーワード: ITERとは

2013-12-19

http://anond.hatelabo.jp/20131219223049

別に読み間違えても恥ずかしく無いだろこんなクソコード

普通にif文とカウンタ使って

experiment1 = function(max) {

iter = 0

freq = rep(0, 6)

count = 0

while(iter < max) {

dice1 = rdice(1)

dice2 = rdice(1)

if (dice1 == 6 || dice2 == 6) {

freq[dice1] = freq[dice1] + 1

freq[dice2] = freq[dice2] + 1

iter = iter + 1

if (dice1 == 6 && dice2 == 6) count++

}

}

freq[6] = count

freq / max

}

とでも書けばいいのに。

配列インデックスダイスの値がごちゃまぜになってるだけでもクソなのに、さらに小賢しい工夫までつけて、とにかくクソ。

http://anond.hatelabo.jp/20131219204623

この試行は両方が6だった場合に限りカウントされてく(iterが増える)訳で、

まりカウントされた分はすべて両方6の場合なわけで。

これが間違い。||は論理和なので(dice1 == 6 || dice2 == 6)のどちらかが真であれば真になる。

あと実行結果はhttp://ideone.com/gIGYPsのstdoutのところを見ろ。

[1] 0.1798 0.1768 0.1912 0.1786 0.1884 0.0852

[1] 0.1712 0.1588 0.1750 0.1546 0.1656 0.1748

6個並んだ数値列が二つあるだろ。これがexperiment1とexperment2のそれぞれの実行結果。

experiment1の6番目の値だけ低いから6の目の出る確率は低い。

http://anond.hatelabo.jp/20131219201728

いや、そこは理解してるんだけど。。。

experiment1 = function(max) {

iter = 0

freq = rep(0, 6)

while(iter < max) {

dice1 = rdice(1)

dice2 = rdice(1)

if (dice1 == 6 || dice2 == 6) {

freq[dice1] = freq[dice1] + 1

freq[dice2] = freq[dice2] + 1

freq[6] = freq[6] - 1

iter = iter + 1

}

}

freq / max

}

となってますが、

if (dice1 == 6 || dice2 == 6) {

がありますので、この試行は両方が6だった場合に限りカウントされてく(iterが増える)訳で、

まりカウントされた分はすべて両方6の場合なわけで。

おそらく貴方は、一度やった後、確率が1を超えてしまったので

freq[6] = freq[6] - 1

という意味不明処置をしているのだと思うのですが、

実際の結果がどの様な値になったか示して貰えないでしょうか?

このコード

freq[6]/max=1

freq[n]/max=1 (for n=1,2,3,4,5)

以外になり得るとは思えないのですが。

自分コード常識おかしくて、Rと言う言語自分常識外の行動をしている可能性もありますので、結果を見せてもらえれば納得出来るかもしれません。

2012-07-26

レーザー核融合が500TWを出力、という記事とNIFの話

レーザー核融合反応の実験成功クリーンエネルギー実現か=米国」という表題の記事がひどい。という話。

http://news.searchina.ne.jp/disp.cgi?y=2012&d=0720&f=it_0720_001.shtml

大元の記事だと思われるアメリカのローレンスリバモ国立研究所プレスリリースが下記。題は「National Ignition Facility makes history with record 500 terawatt shot」

https://www.llnl.gov/news/newsreleases/2012/Jul/NR-12-07-01.html

この元記事の題名を見るだけでも大まかにわかるとおり、LLNLの発表した内容は核融合反応に関するものではなく、レーザーに関わるもの。おおざっぱに言うと「安全保障(要は水爆関連)や基礎研究核融合発電などの研究に用いる大強度レーザー装置の増強、整備によってついに500TWのピークパワーを持ったレーザー発振に成功した」という内容。ちなみに「地下核実験不要にする唯一の施設」なんて書かれてたりして、実は核融合エネルギーについては大して書かれていない。

そんなわけでサーチナの記事とその元になったチャイナネットの記事はなぜかこれを「核融合成功して500TWを出力」という記事に書き換えていているという意味で間違っている。が、間違いはそれだけではない。レーザー核融合は「レーザーを燃料球に当てて爆縮し、核融合反応を起こす」ものであるにもかかわらず「「衝撃点火」方式による人類史もっとも威力のあるレーザー光線の放射」と表現していて、あたか核融合反応によってレーザー放出されたかのように書かれているので因果真逆になっている。ちなみに「衝撃点火」という言葉は元のプレスリリースには含まれておらず、チャイナネット記者勝手に付け加えたもの。衝撃点火は阪大レーザー研が概念として提案している核融合反応の点火手法の一つで、未だ実験は行われていないしLLNLは中心点火なのでこれまたおかしい。

あとついでにNIFの話

LLNLのNIFは核融合研究のための世界最大のレーザー発振施設な訳だけど、実際は水爆シミュレーション施設としての機能が強い(というか予算安全保障メイン)。NIFの実験は間接照射の中心点火といって、「金の円筒内部にレーザーを照射、発生したX線で燃料球を加熱、爆縮して核融合を起こすシステム」だが、これは水爆の「原爆の起爆によって発生したX線などによって燃料球を爆縮、起爆する」に近いプロセスで、こういう実験によって水爆関連の研究を行っていることがNIFを「地下核実験不要とする施設」だと評価する理由であり、NIFが高速点火(阪大などがより核融合発電向きであるとして提唱する点火手法)を採用しない要因になっていると考えられている。(高速点火には主加熱源よりも短パルスな加熱が必要だが、核弾頭にそんなものは組み込めない)

一方で日本阪大や光産業創成大学なんかがやっている高速点火は「発電炉」に特化した研究が行われている。たとえば「大出力・高繰り返しの半導体レーザードライバーの開発」「発電炉に必要な1秒に10回程度の核融合反応」「1秒に10個使われる燃料球をリアルタイム生産するシステムの開発」などである

阪大も光産業創成大もレーザー出力はNIFに数段、もしくは数桁劣るものの、「核融合発電」研究最先端日本であると言って過言ではない。

ちなみに、もう一つの核融合電コンセプトであるところの磁場閉じ込め核融合現在フランス国際協力下でITERと呼ばれる実験炉(発電可能レベルプラズマの数分の保持やより長時間の保持、商用発電炉で用いるコンポーネントの実証が目的)を建設中であり、未だ実験炉の設計すら始まっていないレーザー核融合に比べると数歩は先を行っているのが現状である

2010-08-15

http://anond.hatelabo.jp/20100815182830

末尾再帰だから特定の実装ではスタックオーバーフローするけど

特定の実装ではスタックを消費せずに実行可能

SICPだと反復的プロセスと呼ばれていて、それがiter意味

だから、必ずしも大きな数字を入れるとメモリ使い切るわけではない

2010-07-06

原発推進とか反対とか

下のみたいな反対の人の記事とか、それへの反応を見ていて思うこと。

リスク管理を考えれば原発には疑問 - 地下生活者の手遊び

http://d.hatena.ne.jp/tikani_nemuru_M/20100705/1278299235]

原子力という幻想 - シートン俗物

http://d.hatena.ne.jp/Dr-Seton/20100309/1268138091]

日本現在エネルギー政策はもうすでに新エネルギー源の研究開発にシフトしてる。政策決定をする人たちは原発を永劫に使うつもりなんて毛頭ない。

エネルギー政策関連の予算を見れば。高速増殖炉にはすでに1兆円以上を突っ込んでるし、核融合関連でも(科研費とかも含めれば)それくらい突っ込んでるだろう。核融合炉関連なんかはこれからもっともっと突っ込むだろう。いわゆる自然エネルギー関連にも結構突っ込んでる。

なんでそんなに突っ込むのか?石油の値段で国家レベル不況が来たり、永劫残るような廃棄物に悩まされるのには皆うんざりだから。

世界的な流れは「シートン俗物記」の人が訴えるような「今あるものを大衆に手放させる」ようなリアリティに欠けるやり方ではなくて、原子力化石燃料、水力、太陽光などを使って枯渇を先延ばしして、伸ばしている間に新エネルギーの開発をする。という現実的な方針なわけ。短期的に原発回帰する国家だって並列して新エネルギー省エネ研究を推進している。

それはITER(熱核融合実験炉)に日本アメリカロシア中国インド韓国EU、とそうそうたる各国が名を連ねている事でもわかるはず。(参加国総人口では歴史上最大のプロジェクト

一部の推進派が原子炉を永続的にを使えるかのように言っているのは知っているけど、みんながそう思ってるわけではない。なのにどうも推進派はみんなそう思っていると認識している人が居るように思えてならない。

それは違うよ。

2010-05-21

http://anond.hatelabo.jp/20100521003404

うん。できない。末尾再帰最適化ができる形式の階乗は、

n! = fact_iter(n,1)

fact_iter(0, acc) = acc
fact_iter(n, acc) = fact_iter(n-1, acc*n)

だ。

schemeで書くなら

(define (fact n)
  (define (iter n acc)
    (if (= n 0) acc (iter (- n 1) (* n acc))))
  (iter n 1))

だな。

そのへん興味あるならSICP読むといいよ。

2009-11-14

必殺☆仕分け人

大学の友人の研究室研究費が友愛されて試薬が買えないと先日聞いたが、今度はもっと大規模な事業仕分けがされたみたい。

必殺仕分け人「(コンピューター性能で)世界一を目指す理由は何か。2位ではだめなのか」

世界一を目指さないと、競争力付かないと思うんだが。米軍特殊部隊の人も「2番は負け組みの1番だ!」って、TVで言っていたよ!

http://www.jiji.com/jc/c?g=pol&rel=j7&k=2009111300376&j1

スパコン予算削減で騒いでるけど、もっと酷い事になっとる。まずSpring-8予算半減。大学研究支援、博士研究者支援、COEプログラムは言わずもかな。東京科学未来館iPS細胞衛星宇宙ステーション補給機、深海探査、ITER核融合炉、高速増殖炉

文部科学省 事業仕分け対象一覧

http://www.iza.ne.jp/news/newsarticle/politics/politicsit/322470/

■質疑応答

スーパーコンピューター→「日本で作れなくなっても、輸入すればいい」来年予算は削減か凍結

・Spring8→「民営化できないの?」

・若手研究者への支援を削減する理由

「支援人数を増やしてきた結果、本来民間で活躍できた博士研究員 (ポストドクター)が、そうした機会を逸することになっていないか」

ポスドクが多いのなら小学校理科教師にでもなれ」

\(^o^)/

2008-10-26

DRYFizzBuzz

http://anond.hatelabo.jp/20081026002746

ステートマシン大好きっ子としては書かずにいられない

もう少しがんばればforも無くせるな

fsmの中身ってDRYなの?的な話もあるだろうが,こんなもの他のプログラム自動生成すればいいんだよ!(開き直り)

#include <stdio.h>

static int process(unsigned char *str, int c) {
    if (str != NULL)
        puts(str);
    else
        printf("%d\n", c);
    return ++c % (3 * 5);
}

static int iter(int c) {
    return process(NULL, c);
}

static int fizz(int c) {
    return process("Fizz", c);
}

static int buzz(int c) {
    return process("Buzz", c);
}

static int fizzbuzz(int c) {
    return process("FizzBuzz", c);
}

static int (*fsm[])(int) = {
    fizzbuzz, iter, iter, fizz, iter,
    buzz, fizz, iter, iter, fizz,
    buzz, iter, fizz, iter, iter
};

int main(void) {
    int i, state;

    for (i = state = 1; i <= 100; i++) {
        state = (*fsm[state])(i);
    }

    return 0;
}

2008-06-13

ITER国際熱核融合実験建設計画、総工費は最大1兆円超となる見通し

http://www.technobahn.com/news/2008/200806121917.html

六ヶ所村にこんなもんが出来なくてよかったねぇ

出来たとしても、デカイ廃棄物が出来上がるだけだったし

つか、本気で六ヶ所に誘致する気あったん?

設計が那珂研用だったい言うし

2007-11-10

http://anond.hatelabo.jp/20071110221822

Objective Camlを使ってみたよ!

問3はわからなかった!

let rec map f ls =
  match ls with
  hd::tl -> f hd (map f tl)
  | [] -> 0
in
let plus x y=
  x + y
in


let rec iter f n ls=
  match ls with
  hd::tl -> (iter f (f n hd) tl)
  | _ -> n
in

let biggest ls=
  match ls with
  hd::tl -> iter (fun x y -> if x > y then x else y) hd tl
  | _ -> assert false
in

print_int(map plus [1; 4; 5]);
print_int(biggest [1; 4; 32; 523; 453; 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)のスコア概念を応用し、スコアの低いものが後に出力されるようにすることで、重力感覚に一致するような関係図を得ることができるでしょう。

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