FEED Validator

Congratulations!

This is a valid Atom 1.0 feed.

Recommendations

This feed is valid, but interoperability with the widest range of feed readers could be improved by implementing the following recommendations.

• line 1, column 118: Use of unknown namespace: http://schemas.google.com/blogger/2008 [help]

  ... r.com/styles/atom.css" type="text/css"?><feed xmlns='http://www.w3.org/2 ...
                                               ^

• line 1, column 118: Unable to validate namespace: http://schemas.google.com/g/2005. See the Google Data specification at https://developers.google.com/gdata/docs/1.0/elements [help]

  ... r.com/styles/atom.css" type="text/css"?><feed xmlns='http://www.w3.org/2 ...
                                               ^

• line 1, column 2340: Self reference doesn't match document location [help]

  ... eds/4261787448062796649/posts/default'/><link rel='alternate' type='text ...
                                               ^

• line 244, column 0: content should not contain imageanchor attribute (34 occurrences) [help]

    <tr><td style="text-align: center;"><a href=&quot ...
  

• line 1314, column 0: content should not contain script tag (8 occurrences) [help]

  <script src="https://gist.github.com/uid0130/95ac77a8427c8e6698be.js ...
  

• line 1330, column 0: style attribute contains potentially dangerous content: box-sizing (4 occurrences) [help]

   .lein/profile.clj (or project.clj)の:pluginsに<span style="b ...
  

• line 1422, column 0: Non-html tag: stdin (2 occurrences) [help]

    File "<stdin>", line 1, in <module>
  

Source: http://uid0130.blogspot.jp/feeds/posts/default

1. <?xml version='1.0' encoding='UTF-8'?><?xml-stylesheet href="http://www.blogger.com/styles/atom.css" type="text/css"?><feed xmlns='http://www.w3.org/2005/Atom' xmlns:openSearch='http://a9.com/-/spec/opensearchrss/1.0/' xmlns:blogger='http://schemas.google.com/blogger/2008' xmlns:georss='http://www.georss.org/georss' xmlns:gd="http://schemas.google.com/g/2005" xmlns:thr='http://purl.org/syndication/thread/1.0'><id>tag:blogger.com,1999:blog-4261787448062796649</id><updated>2024-03-19T18:58:12.960+09:00</updated><category term="Clojure"/><category term="Haskell"/><category term="リスト操作"/><category term="プログラム運算"/><category term="構文解析"/><category term="Emacs"/><category term="Scheme"/><category term="nQueen問題"/><category term="Lisp"/><category term="incanter"/><category term="トランポリン"/><category term="プログラム意味論"/><category term="ラムダ計算"/><category term="機械学習"/><category term="限定継続"/><category term="Common Lisp"/><category term="Hylomorphism"/><category term="Java"/><category term="Lisp-2"/><category term="shift/reset"/><category term="コンビネータ"/><category term="マクロ"/><category term="継続"/><category term="遺伝的アルゴリズム"/><category term="1行"/><category term="Clojure.core.logic"/><category term="Graphviz"/><category term="Gtk2hs"/><category term="IORef"/><category term="Karva Notation"/><category term="Leiningen"/><category term="Parsec"/><category term="Peg"/><category term="Python"/><category term="Scala"/><category term="crontab"/><category term="hylang"/><category term="notify-send"/><category term="quil"/><category term="オブジェクト指向"/><category term="クラスタリング"/><category term="シンタックスハイライト"/><category term="ダイクストラ法"/><category term="パズル"/><category term="メタ循環インタプリタ"/><category term="単純パーセプトロン"/><category term="圏論"/><category term="巡回セールスマン問題"/><category term="形態素解析"/><category term="抽象解釈"/><category term="文脈自由文法"/><category term="暗号"/><category term="正規表現"/><category term="継続渡しスタイル"/><category term="自然言語処理"/><category term="遺伝的プログラミング"/><category term="青空文庫"/><title type='text'>yuwki0131-blog</title><subtitle type='html'>プログラミング言語やコンピュータサイエンスについて勉強したことのメモなど. </subtitle><link rel='http://schemas.google.com/g/2005#feed' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/posts/default'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/'/><link rel='hub' href='http://pubsubhubbub.appspot.com/'/><link rel='next' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default?start-index=26&amp;max-results=25'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><generator version='7.00' uri='http://www.blogger.com'>Blogger</generator><openSearch:totalResults>57</openSearch:totalResults><openSearch:startIndex>1</openSearch:startIndex><openSearch:itemsPerPage>25</openSearch:itemsPerPage><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-2187054614729293930</id><published>2017-12-19T00:13:00.000+09:00</published><updated>2017-12-19T00:13:54.124+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="Scala"/><title type='text'>Binding: Implicit parameters with Clojure</title><content type='html'>この記事は、&lt;a href=&quot;https://qiita.com/advent-calendar/2017/clojure&quot;&gt;Clojureアドベントカレンダー&lt;/a&gt;の19日目の記事です。今日は、Clojureの動的スコープの話です。&lt;br /&gt;
2. <br />
3. <h4>
4.  ScalaのImplicit parameter</h4>
5. ここ最近、業務でScalaがメインなのでScalaしか書いてないのですが、たまに、仕事から帰ってきて家でClojureのコードを書いてると、ClojureにはImplicit parametersの機能が無い事に気づきます。というか、そもそもScala以外だと、Implicit parameterは、HaskellのGHC拡張くらいにしかない?(ちゃんと調べてないですが)と思われますが。。。Implicit parametersとは、関数の引数を暗黙的(implicit)に受け渡す機能です。<br />
6. <br />
7. 例えば、DBConnectionのような関数呼び出し毎に同じ変数を渡すようなシチュエーションが発生した時、Implicit parameterでは、関数間で受け渡す、共有したいパラメータ(ここだとConnectionのような変数)について、呼び出し元と呼び出し先のメソッドでそれぞれimplicitであることを宣言すると、暗黙的に変数の受け渡しをやってくれます。例えば、以下のコード。このコードではcallerという関数からcallee1を呼び出し、callee1からcallee2を呼び出しています。<br />
8. <br />
9. <pre class="prettyprint">def caller():Unit = {
10.  implicit val message = "sample message"
11.  callee1("from caller")
12. }
13.  
14. def callee1(text1: String)(implicit message: String):Unit ={
15.  println(text1)
16.  callee2(text1 + "2")
17. }
18.  
19. def callee2(text2: String)(implicit message: String):Unit ={
20.  println(text2)
21.  println(message)
22. }
23. </pre>
24. この時、callee2で使用される変数messageは暗黙的に、caller->callee1->callee2へと受け渡されていきます。明示的に引数を宣言していませんが、callee1及びcallee2の関数呼び出しは、暗黙な引数となったmessageを補完されて呼び出されています。この時、補完される値は、implicitキーワードにより定義された暗黙のパラメータであり、caller内ではimplicitキーワードにより宣言された変数(implicitキーワードのないval messageは普通の変数宣言です。)で、callee1呼び出しで不足しているパラメータを補います。さらに、callee1内では、暗黙的に渡されたパラメータがさらに暗黙的にcallee2に渡されています。<br />
25. <br />
26. implicit parameterのより正確で詳しい説明は、以下にあります。<br />
27. <br />
28. <div style="text-align: center;">
29. <a href="https://dwango.github.io/scala_text/implicit.html">Implicit · Scala研修テキスト - dwango on GitHub</a></div>
30. <br />
31. 実行時のコンテクストなど、種々のパラメータを明示的に記述しないことで、不要な(つまり、例えば、その変数に代入されたオブジェクトが直接使用されない)箇所での余計な記述が減り、その関数で記述すべきロジックが明確になるというメリットがあります。特に、関数の引数で変数引きずり回しプログラミングをやっていると、必須の機能になってくるのではないでしょうか(?)<br />
32. Implicit parameterも一長一短の機能で手放しで喜べる機能ではないですが、その機能を意識してコントロールしている限りでは、便利な機能と言えます。<br />
33. <br />
34. <h4>
35.  ClojureでImplicit parameter的なものを考える</h4>
36. そんな、機能がClojureにあったら良いなと度々思うようになりました。Clojureでは、Lexical Closureのように、環境を捕縛することは出来ても、一々引数として指定せずに別のコンテクストから、値を渡す、といったことはできません。マクロで無理矢理implicitを表す、implicit-letのような構文を作って代入する、みたいなことも出来そうではあります。例えば以下のような感じに。<br />
37. <br />
38. <pre class="prettyprint lang-clj">(implicit-let
39. [param1 (get-context1)]
40. (function4
41.    (function1 arg1 arg2)
42.    (function2 arg1 arg2) ;; 本当はfunction3に3番目のパラメータとしてparam1が入る
43.    (function3 arg1 arg2))) ;; 本当はfunction3に3番目のパラメータとしてparam1が入る
44. </pre>
45. implicit-letマクロ拡張時に、scopeにバインドされているfunction2とfunction3のスコープを調べ(調べるならdocかsourceマクロあたりでしょうか)、引数が不足していてかつ、パラメータ名(上記で言う所のparam1)が同一であれば、(function2 arg1 arg2)を(function2 arg1 arg2 aram1)に拡張するようなS式変換を行うことで、静的に暗黙のパラメータを受け渡すことが出来そうです。ここに型チェックでも入れば<a href="https://docs.scala-lang.org/tour/implicit-parameters.html">Scalaが提供しているImplicit parameter</a>とほぼ同様のものになると思われます。<br />
46. ただ、これには、マルチメソッドはどうするのか、とか、マクロ内マクロはどのような扱いにするのか、などletのbody部の各名前や構造の静的解決が簡単ではありません。<br />
47. <br />
48. <h4>
49.  Binding(Clojureの動的スコープ)</h4>
50. そんなことを考えながら仕事をしていたある日、Implicit Parametersって動的スコープとよく似ているなあ、と思いググったところ、まさにこれ、といった文献がヒットしました。<br />
51. <br />
52. <div style="text-align: center;">
53. <a href="https://dl.acm.org/citation.cfm?doid=325694.325708">Implicit Parameters: Dynamic Scoping with Static Types</a></div>
54. <br />
55. 上記の文献によると、"Implicit Parameters"とは、"Static Types"で"Dynamic Scoping"をするためのものであるようです。タイトルそのまんまですが。だとすると、ClojureでImplicit parameter使いたい問題は、Clojureで動的スコープ使いたい問題と言い換える事ができ、なんとも、都合の良いことにClojureには動的スコープを操作するためのマクロが存在します。<br />
56. ^:dynamicキーワードとbindingです。以下のように動的に値を束縛します。<br />
57. <br />
58. <pre class="prettyprint lang-clj">(def ^:dynamic x "α")
59. (def ^:dynamic y "β")
60.  
61. (println (format "point1: x = %s, y = %s" x y))
62.  
63. (defn call-xy []
64.  (println (format "in call-xy: x = %s, y = %s" x y)))
65.  
66. (binding [x "a" y "b"]
67.  (println (format "after binding: x = %s, y = %s" x y))
68.  (call-xy))
69.  
70. (println (format "point2: x = %s, y = %s" x y))
71.  
72. (call-xy)
73. </pre>
74. そして、これに対して以下のような出力結果が得られます。<br />
75. <br />
76. <pre class="prettyprint">point1: x = α, y = β
77. after binding: x = a, y = b
78. in call-xy: x = a, y = b
79. point2: x = α, y = β
80. in call-xy: x = α, y = β
81. </pre>
82. bindingにより束縛した、後と束縛中に呼び出した関数呼び出しの中のみ、束縛した値に変更されます。そして、bindingのスコープ外では束縛した値が束縛前のもとの値に戻っています。bindingは、bindingスコープの外側に出ると、もとの値、束縛前の値を再度束縛するという機能があります。これにより引数よる明示的な値渡し以外の方法で値を渡すことを実現します。bindingされた時の呼び出しから呼び出される関数内でのdynamicパラメータを持つ変数のみに動的に値が設定されます。そして、さらに都合の良いことに、スレッドセーフでもあるのです。。。このあたりが、ref(transactionalなclojureのグローバル変数)との使い分けのポイントになると思います。<br />
83. <br />
84. そして、気になる静的スコープとの競合ですが、以下のようになります。<br />
85. <br />
86. <pre class="prettyprint lang-clj">user=> (binding [x "2"] x)
87. "2"
88. user=> (binding [x "2"] (let [x "3"] x))
89. "3"
90. user=> (let [x "3"] (binding [x "2"] x))
91. "3"
92. </pre>
93. 基本的に、静的スコープにより遮蔽されるようです。しかし以下のようにvar-get関数により取得することは可能です。<br />
94. (単にletを飛び越えてトップレベルのdefで定義されたvarを取ってきているだけですが。)<br />
95. <br />
96. <pre class="prettyprint lang-clj">user=>  (let [x "3"] (binding [x "2"] (var-get #'x)))
97. "2"
98. </pre>
99. <br />
100. <h4>
101.  Binding(動的スコープ)を使う</h4>
102. 動的スコープは副作用ありきの機能というか参照透過性を破壊のような概念ではありますが、Clojureで使われているbindingによる動的スコープなら、例えば、DBコネクションを複数の関数に渡したい、とか、コードの実行コンテクストを複数の関数どうしで引き回したいとか、再帰で書く必要があるものの、一々引数指定したくない(けど、代入する必要がある)などに有用だと思われます。このような、bindingの使い方は、例えば、標準ライブラリのcl-formatや、IOのreadなどで使われています。<br />
103. <br />
104. 例えば、以下のようなコードがある時、関数f, g,でそれぞれg, hの呼び出し以外にparam1, param2が使用されない時、hの変数の値を解決しようとすると、呼び出した先の関数の先の関数で使う値を、一旦、呼び出す関数に渡し、さらにその先での呼び出しでもまた同様に値を渡す必要が出てきます。<br />
105. <br />
106. <pre class="prettyprint lang-clj">(defn h [param1 param2]
107.  param1, param2を使用)
108.  
109. (defn g [b param1 param2]
110.  ...
111.  (h param1 param2)
112.  ...)
113.  
114. (defn f [a param1 param2]
115.  ...
116.  (g abc param1 param2)
117.  ...)
118.  
119. (f param0 param1 param2)
120. </pre>
121. このようなコードだとかなり厳しさがありますが、例えば動的スコープなら、以下のように解決することが出来ます。<br />
122. <br />
123. <pre class="prettyprint lang-clj">(defn h []
124.  param1, param2を使用)
125.  
126. (defn g [b]
127.  ...
128.  (h)
129.  ...)
130.  
131. (defn f [a]
132.  ...
133.  (g abc)
134.  ...)
135.  
136. (binding [param1 .... param2 ...]
137.  (f param0))
138. </pre>
139. また、再帰呼出しを行う以下のような関数がある時、再帰呼出し中、自分自身を呼び出す時に、再帰呼出し中では値が変更されない引数を自分自身の中で共有するために再帰中に値を引き回す必要が出てきます。以下の例では、不変なリストpoints (ex. [[10 20] [30 40] ... ]のような値が入ります)に対して、find-minとweightで、不変なリストを複数の関数内で引き回して使っています。<br />
140. (ちなみに、以下のコードはの<a href="https://uid0130.blogspot.jp/2017/12/blog-post.html">前回の記事</a>から。)<br />
141. <br />
142. <pre class="prettyprint lang-clj">(defn weight [points i j]
143.  (st/euclidean-distance (points i) (points j)))
144.  
145. (defn +m [x y size]
146.  (mod (+ x y size) size))
147.  
148. (defn min-path [args]
149.   (first (sort-by second (filter not-empty args))))
150.  
151. (defn find-min [points i j]
152.  (if (<= (Math/abs (- i j)) 2)
153.    [[] 0]
154.    (let [size (count points)
155.          i+1 (+m i 1 size)
156.          j-1 (+m j -1 size)
157.          [lines w] (find-min points i+1 j)
158.          skip-i [(cons [i+1 j] lines) (+ w (weight points i+1 j))]
159.          [lines w] (find-min points i j-1)
160.          skip-j [(cons [i j-1] lines) (+ w (weight points i j-1))]]
161.      (letfn [(search-inter [k]
162.                (let [[lines1 w1] (find-min points i k)
163.                      [lines2 w2] (find-min points k j)]
164.                  [(concat [[i k] [k j]] lines1 lines2)
165.                   (+ w1 w2 (weight points i k) (weight points k j))]))]
166.        (->> (map search-inter (range (+m i 2 size) (+m j -2 size)))
167.             (cons skip-i)
168.             (cons skip-j)
169.             min-path)))))
170.  
171. (defn triangulate [points]
172.  (find-min points 0 (- (count points) 1)))
173. </pre>
174. 勿論、上記のようなコードは、一旦、Closureを作って解決するという方法も取れますが、そうなると、letfnなどを使い、関数中にさらに不変な変数を共有するためだけに、関数を再定義する必要がでてきます。このようなコードは動的スコープにより以下のように書き直せます。<br />
175. <br />
176. <pre class="prettyprint lang-clj">(def ^:dynamic points [])
177.  
178. (defn weight [i j]
179.  (st/euclidean-distance (points i) (points j)))
180.  
181. (defn +m [x y size]
182.  (mod (+ x y size) size))
183.  
184. (defn min-path [args]
185.   (first (sort-by second (filter not-empty args))))
186.  
187. (defn find-min [i j]
188.  (if (<= (Math/abs (- i j)) 2)
189.    [[] 0]
190.    (let [size (count points)
191.          i+1 (+m i 1 size)
192.          j-1 (+m j -1 size)
193.          [lines w] (find-min i+1 j)
194.          skip-i [(cons [i+1 j] lines) (+ w (weight i+1 j))]
195.          [lines w] (find-min i j-1)
196.          skip-j [(cons [i j-1] lines) (+ w (weight i j-1))]]
197.      (letfn [(search-inter [k]
198.                (let [[lines1 w1] (find-min i k)
199.                      [lines2 w2] (find-min k j)]
200.                  [(concat [[i k] [k j]] lines1 lines2)
201.                   (+ w1 w2 (weight i k)) (weight k j)]))]
202.        (->> (map search-inter (range (+m i 2 size) (+m j -2 size)))
203.             (cons skip-i)
204.             (cons skip-j)
205.             min-path)))))
206.  
207. (defn triangulate [points]
208.  (binding [points points]
209.    (find-min 0 (- (count points) 1))))
210. </pre>
211. 単にグローバル変数に変数を束縛しているだけである事との違いは、呼び出し元(この場合だとtriangulate)の関数内で、pointsの値を書き換えてる点です。これにより、(当然ですが)triangulateに違うリストを渡した場合に違う結果が返ってくることとなり、あたかも副作用のない通常の関数呼び出しを行っているかのような記述が可能になります。<br />
212. <br />
213. 動的スコープのデメリットとしては、静的にはどこの値が束縛されるのか分からないという問題も発生します。上記のような書き方だと、(トップレベルには記述があるとは言え)どうしてもどこにも所属しない自由変数が関数内に登場してしまうことにはなります。しかし、名前の解決のためだけに値を引数で引き回したり、再帰的な関数をletfnなどで再定義するよりは、シンプルなコードが実現できると思います。<br />
214. <br />
215. <h4>
216.  おわりに</h4>
217. 前述の文献のように、Implicit parametersが静的型付言語でDynamic Scopingの役割を果たすものだとするならば、その逆もまたありえる、つまり、ScalaでImplicit paramtersで記述されている箇所は、Clojureの動的スコープを使用することで値渡しが可能になるのではないでしょうか。<br />
218. <br />
219. 濫用するとコードが読みにくく扱いづらくなりますが、(これに関してはScalaのimplicit Parameterも同様です)適度に使用することで、無用な引数渡しや、煩雑なデータ渡しが簡潔に記述できて、見通しがよいコードが書けそうです。特にScalaのコードにおいてImplicit parametersで値を渡しているような箇所は、Clojureではdynamic bindingで解決するという方法が取れるのかも知れません。<br />
220. <br />
221. 言語の名前こそClojure(Closure)ですが、動的スコープもまた利用可能で、Lexical Closureのみによって束縛されない変数を含む関数を定義できます。Scalaのimplicit Parameterが良いなと思った時、Clojureではbindingを試してみるのはいかがでしょうか。<br />
222. <br />
223. <h4>
224.  参考文献</h4>
225. <ol>
226. <li><a href="https://stackoverflow.com/questions/1523240/let-vs-binding-in-clojure">Let vs. Binding in Clojure - Stack Over Flow</a></li>
227. <li>Jeffrey R. Lewis, Mark B. Shields, Erik Meijer, John Launchbury, Iplicit Parameters: Dynamic Scoping with Static Types, 2000, [<a href="http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.156.5131&rep=rep1&type=pdf">PDF</a>]</li>
228. <li><a href="https://stuartsierra.com/2013/03/29/perils-of-dynamic-scope">On the Perils of Dynamic Scope - Digital Digressions by Stuart Sierra</a></li>
229. <li><a href="http://kimutansk.hatenablog.com/entry/20130619/1371598244">Clojure勉強日記（その２１ varを使用したスレッドローカルな状態管理 - 夢とガラクタの集積場</a></li>
230. <li><a href="http://www.scala-lang.org/docu/files/LangSpec2.8-ja_JP.pdf">Scala 言語仕様 Version 2.8 DRAFT July 13, 2010</a></li>
231. </ol>
232. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/2187054614729293930/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=2187054614729293930&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2187054614729293930'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2187054614729293930'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2017/12/binding-implicit-parameters-with-clojure.html' title='Binding: Implicit parameters with Clojure'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-9152087947329505469</id><published>2017-12-11T12:02:00.000+09:00</published><updated>2017-12-11T12:02:38.512+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><title type='text'>凸多角形の最適三角形分割</title><content type='html'>はいどうも！
233. この記事は、<a href="https://qiita.com/advent-calendar/2017/math-and-computer">数学とコンピュータ・アドベントカレンダー</a>の11日目の記事です。
234. 凸多角形の最適三角形分割の話をします。
235.  
236. <br />
237. <div style="text-align: center;">
238.  <a href="https://ja.wikipedia.org/wiki/%E5%A4%9A%E8%A7%92%E5%BD%A2%E3%81%AE%E4%B8%89%E8%A7%92%E5%BD%A2%E5%88%86%E5%89%B2">多角形の三角形分割 - Wikipedia</a></div>
239. <br />
240. 凸多角形の定義とは、文献１によれば、「多角形の内部のどの2点を結んでも、その2点を両端点とする線分がその多角形の内部に含まれるとき、その多角形は凸である」ということだそうです。「多角形Pが凸多角形であるための必要十分条件は、Pの全ての対角線がPの内部にあるときである」と言い換えられます。
241. <br />
242. <br />
243. <table align="center" cellpadding="0" cellspacing="0" class="tr-caption-container" style="margin-left: auto; margin-right: auto; text-align: center;"><tbody>
244.  <tr><td style="text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhM82uX7KRj6iV0XsxvxAmVctMwKrRHmy0HqmDMWR4inDfI44LrtAteENtbAG5CCpeHmwh6x4TomSVoXBWodwMdy9RsbyU8fWPnheNOmMYoylaNxY8xQMnebKO5wD6zeBmF3PBmYLmH8Pc/s1600/sample1.png" imageanchor="1" style="margin-left: auto; margin-right: auto;"><img border="0" height="256" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhM82uX7KRj6iV0XsxvxAmVctMwKrRHmy0HqmDMWR4inDfI44LrtAteENtbAG5CCpeHmwh6x4TomSVoXBWodwMdy9RsbyU8fWPnheNOmMYoylaNxY8xQMnebKO5wD6zeBmF3PBmYLmH8Pc/s320/sample1.png" width="320" /></a></td></tr>
245.  <tr><td class="tr-caption" style="text-align: center;">こんな感じに三角分割する</td></tr>
246. </tbody></table>
247. <h4>
248.  凸多角形を分割する</h4>
249. 凸多角形(単調な多角形)を任意の三角形で分割するだけなら、特別なアルゴリズムを考える必要もなさそうです。凸多角形の定義から、多角形の点を一つ選び、その線から多角形の他の点に対して線を引いていくだけでも凸多角形の三角形分割は可能です。というわけで、単に凸多角形を三角形に分解するだけなら簡単なので、凸多角形を三角形分割した時に、分割に使った対角線の総和が最小となるような分割を求めてみます。
250. <br /><br />
251. この問題を分割統治法で解きます(後述しますが、この方法は、動的計画法によって解くのが一般的です)。
252. <br /><br />
253. 凸多角形を対角線で分割するため、解は必ず多角形の頂点のペアの列として表せます。つまり、頂点のペアの列を求めるわけですが、より正確には、合計の長さが最小となる対角線を表す頂点のインデックスのリストつまり、i番目とj番目の頂点のペアのリストが求めたい解となります。
254. <br /><br />
255. 凸多角形がどんな形で分割されたとしても、必ず、四角形以上であれば、必ず対角線が一本引かれます。つまり、$n$個の頂点を持つ多角形の対角線のうち、最初の1つの対角線を一本、どこかに引く必要があります。<br />
256. そのような直線が一本決まると、残った部分の多角形の三角分割は、元の多角形の部分多角形の三角分割の問題となります。(三角分割なので、当然、対角線どうしが交差することはない為、決まった対角線によって分割された2部分多角形の三角分割の問題になります。)
257. <br /><br />
258. まず始めに、凸多角形の全体を考えるのではなく、凸多角形の部分多角形の分割について考えてみたいと思います。話を簡単にするために、頂点を$v_i$(凸多角形の$i$番目の頂点)の$i$番目〜$j$番目間の分割を表す関数を$L[i, j]$とします。$L[i, j] (|i - j| < 2)$となる場合については、分割出来ないため、分割なし、分割を表す対角線の長さは0とします。また、インデックスですが、頂点$n$の多角形に対し$i+1$や$j-1$などは$\pmod{n}$で循環するものとします。
259. <br />
260. <br />
261. <table align="center" cellpadding="0" cellspacing="0" class="tr-caption-container" style="margin-left: auto; margin-right: auto; text-align: center;"><tbody>
262.  <tr><td style="text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhIrPCR9xswFpE4e_yPg5BMd8ZCkjym0BQYil1FJJrNtH8eBLg2-fbYYWWN4taZfn2EN7a5cSMb1-LImrDELC6qKyDBgeQ-ZLmv3L6u9jxwVEO-e3NY_qJrPI6g2TI18CWmhV7-vD24I-o/s1600/split.png" imageanchor="1" style="margin-left: auto; margin-right: auto;"><img border="0" height="185" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhIrPCR9xswFpE4e_yPg5BMd8ZCkjym0BQYil1FJJrNtH8eBLg2-fbYYWWN4taZfn2EN7a5cSMb1-LImrDELC6qKyDBgeQ-ZLmv3L6u9jxwVEO-e3NY_qJrPI6g2TI18CWmhV7-vD24I-o/s200/split.png" width="200" /></a></td></tr>
263.  <tr><td class="tr-caption" style="text-align: center;">こんな風に分割</td></tr>
264. </tbody></table>
265. <br />
266. 部分多角形の分割を表す$L[i, j]$に対して、部分多角形内の頂点$v_i, v_j$を含むような三角形を考えます。今求めようとしている部分多角形の性質上、頂点$v_i$と$v_j$間が別の対角線によって遮られる事はあり得ません。したがって、$v_i$, $v_j$をともうひとつの頂点から成る三角形によって分割される筈です。そのような三角形の頂点は、$v_i+1 $cdots v_j-1$の中から必ず1つ選ばれる事になります。(選ばれなかった場合、三角分割として成り立たないため)<br />
267. このような三角形の選び方は3通りあります。<br />
268. <br />
269. <ol>
270.  <li>$(v_i, v_j, v_{j-1})$で三角形が構成されるパターン</li>
271.  <li>$(v_i, v_{i+1}, v_j)$で三角形が構成されるパターン</li>
272.  <li>$(v_i, v_k, v_j)$で三角形が構成されるパターン(ただし、$i+1 < k < j-1$)</li>
273. </ol>
274. <br />
275. <table align="center" cellpadding="0" cellspacing="0" class="tr-caption-container" style="margin-left: auto; margin-right: auto; text-align: center;"><tbody>
276.  <tr><td style="text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg2FrPC9WyvoWpTMyh8rQamAOGHwoiFKaA7Kd-cnSxNXAe2C3sjmfrZ3sKfuymmBofkiumMms3uzSPvgX-fQw1e_eoB0wxEn7yvTybQ9IVK-QJwlWlzOLK-srtv2CeRK1UpKqCD-9Hzt2A/s1600/patterns.png" imageanchor="1" style="margin-left: auto; margin-right: auto;"><img border="0" height="232" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg2FrPC9WyvoWpTMyh8rQamAOGHwoiFKaA7Kd-cnSxNXAe2C3sjmfrZ3sKfuymmBofkiumMms3uzSPvgX-fQw1e_eoB0wxEn7yvTybQ9IVK-QJwlWlzOLK-srtv2CeRK1UpKqCD-9Hzt2A/s640/patterns.png" width="640" /></a></td></tr>
277.  <tr><td class="tr-caption" style="text-align: center;">3通りの分割</td></tr>
278. </tbody></table>
279. <br />
280. 1, 2, 3は3の形式でひとまとめに出来そうですが、1, 2は、引かれる対角線が1つであるのに対して、3では2つ対角線が引かれるという点が異なります。そして、それぞれ、以下のように3通りの部分多角形の三角分割を行った結果と足し合わせる形で表せます。
281. <br />
282. <br />
283. <ol>
284.  <li>$L[i, j] = (i, j-1)$ 及び $L[i, j-1]$</li>
285.  <li>$L[i, j] = (i+1, j)$ 及び $L[i+1, j]$</li>
286.  <li>$L[i, j] = (i, k), (k, j)$ 及び $L[i, k]$ と $L[k, j]$</li>
287. </ol>
288. <br />
289. 上記の条件をまとめると、三角分割した部分多角形$L[i, j]$の対角線の長さ$L'[i,j]$は、
290. <br /><br />
291. $L'[i,j] = 0 (|i - j| < 2)$<br />
292. $L'[i,j] = min \bigl\{$<br />
293.     $L'[i + 1, j] + w[i + 1, j],$<br />
294.     $L'[i, j - 1] + w[i, j - 1],$<br />
295.     $\displaystyle \min_{k = (i+2) \dots (j-2)} \{ L'[i, k] + L'[k, j] + w[k, j] + w[k, j] \bigr\} \}$<br />
296. <br />
297. であると言えます。$w[i, j]$は、頂点$v_i$, $v_j$間の重さ、$min { 〜 }$は、与えられた集合の中で最も小さい物を還す関数。添字の$k$も頂点を表すインデックスです。これにより、再帰的な関数によって線分$L'[i, j]$の長さが定義出来ることになりました。
298. <br /><br />
299. ここでもう一度、元の問題、$n$個の頂点を持つ凸多角形の線分の長さが最小となる三角分割ですが、上記の部分多角形の三角分割$L[i, j]$の$L[0, n-1]$のケースであると見なせます。$L[0, n-1]$を解くことで、$n$個の頂点を持つ凸多角形の三角分割が可能になるのです。
300. <br />
301. ちなみに上記の$L'$ですが、コードに落とす時は、重さだけでなく、$L[i, j]$の要素のリストについても考慮する必要があります。
302. <br /><br />
303. <h4>
304.  実装</h4>
305. というわけでClojureのコードです。<br />
306. (実行結果を可視化するのが一番簡単だったため、Clojureと<a href="https://github.com/incanter/incanter">Incanter</a>を使いました。)<br />
307. <pre class="prettyprint lang-clj">(def weight st/euclidean-distance)
308.  
309. (defn +m [x y size]
310.  (mod (+ x y size) size))
311.  
312. (defn min-path [args]
313.   (first (sort-by second (filter not-empty args))))
314.  
315. (defn find-min [points i j]
316.  (if (<= (Math/abs (- i j)) 2)
317.    [[] 0]
318.    (let [size (count points)
319.          i+1 (+m i 1 size)
320.          j-1 (+m j -1 size)
321.          [lines w] (find-min points i+1 j)
322.          skip-i [(cons [i+1 j] lines) (+ w (weight (points i+1) (points j)))]
323.          [lines w] (find-min points i j-1)
324.          skip-j [(cons [i j-1] lines) (+ w (weight (points i) (points j-1)))]]
325.      (letfn [(search-inter [k]
326.                (let [[lines1 w1] (find-min points i k)
327.                      [lines2 w2] (find-min points k j)]
328.                  [(concat [[i k] [k j]] lines1 lines2)
329.                   (+ w1 w2
330.                      (weight (points i) (points k))
331.                      (weight (points k) (points j)))]))]
332.        (->> (map search-inter (range (+m i 2 size) (+m j -2 size)))
333.             (cons skip-i)
334.             (cons skip-j)
335.             min-path)))))
336.  
337. (defn triangulate [points]
338.  (find-min points 0 (- (count points) 1)))</pre>
339. weightは、重さ(長さ)を表す関数(incanterの関数)、前述の$w[i, j]$に相当するものです、+mは$\pmod{n}$を計算する関数、find-minが$L[i, j]$、triangulateは、$L[0, n-1]$を呼び出すだけの関数です。
340. <br /><br />
341. find-minは、頂点のリストを引数に受け取り、頂点列のインデックスと対角線の長さの合計のペア[[$(i, j) \cdots$] $'L[i, j]$]を返します。skip-iとskip-jがそれぞれパターン1, 2の箇所で、(map search-inter 〜)で書かれている所がパターン3になります。最後にmin-pathで最も小さい対角線を求めています。ちなみに、紛らわしいかもしれませんが、スペースが入っていないi+1とj-1は変数です。
342. <br /><br />
343. <h4>
344.  実行結果</h4>
345. <div>
346.  こんな感じになります。一番上の画像と同じですが。</div>
347. <div>
348.  <div style="text-align: center;">
349.    <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEig0YGbJZNVhhJKlFppKRj2lbJyvt7k8WXPdq4l63oPq1H-wqTt5IgedRzpJ376xO94DLS6dIh6-9AesSQHdc6dHHCg2J4xa-JMORthv1dUWsLcTeXVWs3MXcqqMxa_ZniQfQ3uUFxzT5s/s1600/sample5.png" imageanchor="1"><img border="0" height="256" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEig0YGbJZNVhhJKlFppKRj2lbJyvt7k8WXPdq4l63oPq1H-wqTt5IgedRzpJ376xO94DLS6dIh6-9AesSQHdc6dHHCg2J4xa-JMORthv1dUWsLcTeXVWs3MXcqqMxa_ZniQfQ3uUFxzT5s/s320/sample5.png" width="320" /></a><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgzvvT7O0UoA12Q4ebBmqHWPjJspdtUe2-usGRu2KVm43DqL6ycVx3RTFVpKcpkk49fYJ-pSYt8Y3q02RzvzCStioqc79MfzJ4xz2pUFQR2xv_UKBVzdgex55c6EacyPNJfdoIiqn96Hpo/s1600/sample4.png" imageanchor="1"><img border="0" height="256" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgzvvT7O0UoA12Q4ebBmqHWPjJspdtUe2-usGRu2KVm43DqL6ycVx3RTFVpKcpkk49fYJ-pSYt8Y3q02RzvzCStioqc79MfzJ4xz2pUFQR2xv_UKBVzdgex55c6EacyPNJfdoIiqn96Hpo/s320/sample4.png" width="320" /></a><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgFAL04t7GqsRCZy9hE3K4_WbRfO9paKBpWHmkgBQYL_fI_-bers7wEnaHBeN_HiClobeEoEgJuWh-DJ6XuUe2pk0utdq9hCTpcbpL_rI0IM7UvorkQ-yZOkqgkD1mh-DU8giDHu4T3_RQ/s1600/sample2.png" imageanchor="1"><img border="0" height="256" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgFAL04t7GqsRCZy9hE3K4_WbRfO9paKBpWHmkgBQYL_fI_-bers7wEnaHBeN_HiClobeEoEgJuWh-DJ6XuUe2pk0utdq9hCTpcbpL_rI0IM7UvorkQ-yZOkqgkD1mh-DU8giDHu4T3_RQ/s320/sample2.png" width="320" /></a></div>
350. </div>
351. <h4>
352.  おわりに</h4>
353. さて、出来上がった関数ですが、計算の重複が多く、見事にメモ化再帰の実装対象になっています。文献１によれば、動的計画法でメモ化しながら、分割統治法的に問題を解くようです。(多角形の頂点の数を増やしていくと、めっちゃ重くなる。。。)つまり、メモ化再帰をテストするためのサンプルに使用できるということであります。メモ化再帰の実装サンプルに、凸多角形の最適三角分割を使用してみてはいかがでしょうか。<br />
354. それでは！
355. <br /><br />
356. <h4>
357.  全ソースコード</h4>
358.  
359. <pre class="prettyprint lang-clj">(require '[incanter.core :as in]
360.         '[incanter.stats :as st]
361.         '[incanter.charts :as ch])
362.  
363. ;; ---- generate polygon: Jarvis's March to find convex hull
364.  
365. (defn left-most-point [[x1 y1 :as p1] [x2 y2 :as p2]]
366.  (if (< x1 x2) p1 p2))
367.  
368. (defn ex-product
369.  "exterior product"
370.  [[x1 y1 :as p1] [x2 y2 :as p2]]
371.  (- (* x1 y2) (* x2 y1)))
372.  
373. (defn -vec [[x1 y1 :as p1] [x2 y2 :as p2]]
374.  [(- x1 x2) (- y2 y1)])
375.  
376. (defn min-angle [current-p point-b point-c]
377.  (let [v (ex-product (-vec current-p point-b) (-vec current-p point-c))]
378.    (if-not (or (= point-b current-p)
379.                (< 0 v)
380.                (and (< -0.001 v 0.001)
381.                     (< (st/euclidean-distance current-p point-b)
382.                        (st/euclidean-distance current-p point-c))))
383.      point-b point-c)))
384.  
385. (defn jarvis-march
386.  "find convex hull, points = [[x1, y1], ...]"
387.  [points]
388.  (let [start-p (reduce left-most-point points)]
389.    (loop [current-p start-p hull-ps [start-p]]
390.      (let [next-p (reduce (partial min-angle current-p) points)]
391.        (if (and (= next-p start-p))
392.          hull-ps
393.          (recur next-p (cons next-p hull-ps)))))))
394.  
395. (defn generate-sample-set []
396.  (letfn [(generate-by [m]
397.            (st/sample-normal
398.             (+ 100 (rand-int 100)) :mean m :sd (+ 0.15 (rand 0.1))))]
399.    (map list (generate-by (dec (rand 2))) (generate-by (dec (rand 2))))))
400.  
401. (defn generate-sample []
402.  (let [ps (generate-sample-set)
403.        result (jarvis-march ps)]
404.    (vec (map (fn [[x y]] [(int (* x 100)) (int (* y 100))]) result))))
405.  
406. ;; --- triangulation -----------------------
407. (def weight st/euclidean-distance)
408.  
409. (defn +m [x y size]
410.  (mod (+ x y size) size))
411.  
412. (defn min-path [args]
413.   (first (sort-by second (filter not-empty args))))
414.  
415. (defn find-min [points i j]
416.  (if (<= (Math/abs (- i j)) 2)
417.    [[] 0]
418.    (let [size (count points)
419.          i+1 (+m i 1 size)
420.          j-1 (+m j -1 size)
421.          [lines w] (find-min points i+1 j)
422.          skip-i [(cons [i+1 j] lines) (+ w (weight (points i+1) (points j)))]
423.          [lines w] (find-min points i j-1)
424.          skip-j [(cons [i j-1] lines) (+ w (weight (points i) (points j-1)))]]
425.      (letfn [(search-inter [k]
426.                (let [[lines1 w1] (find-min points i k)
427.                      [lines2 w2] (find-min points k j)]
428.                  [(concat [[i k] [k j]] lines1 lines2)
429.                   (+ w1 w2
430.                      (weight (points i) (points k))
431.                      (weight (points k) (points j)))]))]
432.        (->> (map search-inter (range (+m i 2 size) (+m j -2 size)))
433.             (cons skip-i)
434.             (cons skip-j)
435.             min-path)))))
436.  
437. (defn triangulate [points]
438.  (find-min points 0 (- (count points) 1)))
439.  
440. ;; --- plot --------------------
441. (defn plot-triangles [points lines]
442.  (let [ys (concat points [(first points) (last points)])
443.        poly (-> (ch/scatter-plot (map first points) (map second points))
444.                 (ch/add-lines (map first ys) (map second ys) :auto-sort false))
445.        graph (reduce #(ch/add-lines %1 (map first %2) (map second %2) :auto-sort false)
446.                      poly
447.                      (partition 2 lines))]
448.    (in/view graph)))
449.  
450. (defn point-selector [points indices]
451.  (apply concat (map (fn [[start end]] [(points start) (points end)]) indices)))
452.  
453. (defn show [points]
454.  (let [[indices score] (triangulate points)
455.        xs (point-selector points indices)]
456.    (plot-triangles points xs)
457.    points))</pre>
458. <br />
459. <h4>
460.  参考文献</h4>
461. <ol>
462.  <li>浅野 哲夫, 計算幾何―理論の基礎から実装まで (アルゴリズム・サイエンスシリーズ―数理技法編), 共立出版, 2007</li>
463. </ol>
464. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/9152087947329505469/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=9152087947329505469&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/9152087947329505469'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/9152087947329505469'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2017/12/blog-post.html' title='凸多角形の最適三角形分割'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhM82uX7KRj6iV0XsxvxAmVctMwKrRHmy0HqmDMWR4inDfI44LrtAteENtbAG5CCpeHmwh6x4TomSVoXBWodwMdy9RsbyU8fWPnheNOmMYoylaNxY8xQMnebKO5wD6zeBmF3PBmYLmH8Pc/s72-c/sample1.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-1393979470158201487</id><published>2017-11-05T18:25:00.000+09:00</published><updated>2017-11-05T18:26:19.449+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Haskell"/><category scheme="http://www.blogger.com/atom/ns#" term="プログラム運算"/><title type='text'>HylomorphismとMetamorphism</title><content type='html'>はいどうも！　Recursion SchemeのHylomorphismとMetamorphismの話です。
465. 今年のアドベントカレンダーに向けたブログ投稿リハビリ用の記事になります。 
466. <br />
467. <br />
468. hylomorphismは、catamorphismとanamorphismの合成、
469. metamorphismは、hylmorphismの双対、anamorphismとcatamorphismの合成に当たる射になります。
470. <br />
471. <br />
472. catamorphismやanamorphismは、(単方向連結)Listで言う所のfoldrとunfoldに当たるものです。<br />
473. <br />
474. (以下、長いため、catamorphismをcataと書くなど、適宜morphismを省いて書きます。)<br />
475. <br />
476. hylomorphismは、cataとanaの合成射であり、<br />
477. <div style="text-align: center;">
478. hylo = cata . ana</div>
479. という合成です。 
480. <br />
481. <br />
482. プログラムにおけるhyloは、foldr/unfoldの合成、つまりデータの生成処理(unfold)と、
483. データの消費処理(foldr)が融合するような関数になります。<br />
484. <br />
485. hyloを直接再帰の形式で書くことにより、anaで生成されるデータをcataが直接消費することで、
486. anaが生成する(代数的データ型による)データを実際に生成することなくcata/anaの合成処理が記述することが可能になります。<br />
487. <br />
488. このような合成は、プログラムの融合変換に応用できます。<br />
489. 実際の所、recursion schemeは、cata、ana、hyloをプログラムで直接手で記述するというよりは、コンパイル時の中間処理として登場するイメージに近いと思います。<br />
490. <br />
491. 例えば、プログラム中に登場するmap、filter、foldr、unfoldなどをcata、ana、hyloに展開し、展開後のコードの合成部分を見て、cata/ana融合が登場すると、直接再帰の形式のhyloに書き換えるといった最適化が可能になります。 (例えば、参考文献3では、mapやsum等、リストを扱う関数をhylo形式に書き換え、hylo同士を融合するといった最適化を行っています。)<br />
492. <br />
493. この種の最適化は、実行時に生成される中間のデータの生成、消費処理を除去し、実行時のヒープ使用量を減らすなどの効果を目当てとして、行われます。<br />
494. <br />
495. 次に、metamorphismですが、これは、hyloの双対にあたり、cata(foldr)が生成した計算結果を元に、
496. ana(unfoldr)によりデータを展開するという処理の記述の一般化された形式で、 
497. <br />
498. <div style="text-align: center;">
499. meta = ana . cata</div>
500. となる合成関数です。 
501. <br />
502. <br />
503. hylo同様、metaもana/cataの融合であることから、同じように説明することが出来ます。
504. つまり、展開されているデータを畳み込み、その結果から再度、データを展開する。
505. ところで、そんな関数は、リスト操作上だとどのような関数でしょうか? 
506. <br />
507. <br />
508. その一つの答えは、リスト操作関数におけるmap関数はcataでありanaであるという事です。
509. 例えば、anaやcataにconsを生成させる関数を渡す事で、cataとana、いずれでもmapの役割を果たすことが出来ます。
510. <br />
511. <br />
512. この事は、map関数でありがちな、map f . map g = map (f . g)の融合をcata/ana融合、言い換えると
513. hyloで表現できることを意味するわけですが、それと同時に、metaでも実現出来るわけです。
514. ana/cata融合、つまりmetaもまた、map/map融合を表す射になりうるのです。<br />
515. <br />
516. つまり、
517.  
518. map f . map g = map (f . g)
519. は、hyloで表すと、<br />
520. <div style="text-align: center;">
521. (cata f') . (ana g') = hylo f' g'</div>
522. であり、
523.  
524. これと同様の意味をmetaで書くと、<br />
525. <div style="text-align: center;">
526. (ana f'') . (cata g'') = meta g'' f'' </div>
527. と書くことができます。<br />
528. f'、f''、g'、g''は、それぞれ、元のf、gをhylo/meta用に修正(wrapping)した関数になります。
529. cata/ana共に、そもそも、foldr/unfoldなので、mapしたい関数を直接渡す事はできません。。。<br />
530. <br />
531. 実際に、Haskellのコードで、リスト上のcata/anaを書くと以下のようになります。
532.  
533. まず、標準のリスト上のcataとanaです。
534. <br />
535. <pre class="prettyprint lang-hs">lcata :: (alpha -> beta -> beta) -> beta -> [alpha] -> beta
536. lcata f b []     = b
537. lcata f b (a:as) = f a (lcata f b as)
538.  
539. lana :: (beta -> Maybe(alpha, beta)) -> beta -> [alpha]
540. lana f b = case f b of
541.  Just (a, b') -> a:lana f b'
542.  Nothing      -> []
543. </pre>
544. anaでは、JustとNothingでデータを生成し続けるのか、停止するのか、切り替えています。
545. ちなみに、これは基本的にフラグなので、代わりに1, 2とそのタプルを使う文献も多いです。(下の参考文献2、3あたりを参照。というかそっちが主流かも?) 今回は、後で紹介するコードに合わせて、Maybeで書きました。
546. <br />
547. <br />
548. 次に直接再帰形式のhylo/metaです。cata/ana同様にHaskellの標準のリストを対象にしています。
549.  
550. <br />
551. <pre class="prettyprint lang-hs">lhylo :: beta -> (alpha -> Maybe(gam, alpha)) -> (gam -> beta -> beta) -> alpha -> beta
552. lhylo init f g a = case f a of
553.  Nothing     -> init
554.  Just (x, y) -> g x (lhylo init f g y)
555.  
556. lmeta :: (gam -> Maybe (beta, gam)) -> (alpha -> gam -> gam) -> gam -> [alpha] -> [beta]
557. lmeta f g c x = case f c of
558.  Just(b, c') -> b:(lmeta f g c' x)
559.  Nothing     -> case x of
560.    []   -> []
561.    a:x' -> lmeta f g (g a c) x'
562. </pre>
563. hyloの直接再帰の形式はよく見るのですが、metaについては、ネットではあまり見かけません。。。上記のmetaの形式は、参考文献1の10pの直接再帰形式のコードからHaskellのリスト向けに復元したものです。<br />
564. <br />
565. このcata/anaで書いたコードに対するmap関数は以下のようになります。元はfoldr/unfoldだけあって、mapしたい関数を直接渡す事はできません。。。<br />
566. <pre class="prettyprint lang-hs">mapC f = lcata func []
567.  where
568.    func x xs = (f x):xs
569.  
570. mapA f = lana func
571.  where
572.    func []     = Nothing
573.    func (x:xs) = Just(f x, xs)
574. </pre>
575. 次に、hylo/metaによる(map f) . (map g) = map (f . g)の合成。それぞれ、hylo版がmapH、meta版がmapEになります。
576. <br />
577. <pre class="prettyprint lang-hs">mapH f g = lcata func1 [] . lana func2
578.  where
579.    func1 x xs = (f x):xs
580.    func2 []     = Nothing
581.    func2 (x:xs) = Just(g x, xs)
582.  
583. mapE f g = lana func2 . lcata func1 []
584.  where
585.    func1 x xs = (g x):xs
586.    func2 []     = Nothing
587.    func2 (x:xs) = Just(f x, xs)
588. </pre>
589. しかし、この例はあまりに面白くありませんね。。。<br />
590. <br />
591. mapをrecursion schemeで表すなら前述したようにcataかana十分なはずで、
592. そもそもmap自体、簡単に融合出来てしまいます。 致命的なのが、metaの特徴でもある畳込み後の値が使えるという性質を上手く活かしきれていません。
593. <br />
594. <br />
595. しかし、上記の例から分かることは、foldで畳み込んだ結果をリストとすることで、metamorphismもそれなりに使いみちが出てくるかも知れません。<br />
596. <br />
597. というわけで、やってみたのが、metamorphismによるfilterとmapの融合です。<br />
598. <pre class="prettyprint lang-hs">mapfilterM f g = lana func2 . lcata func1 []
599.  where
600.    func1 x xs   = if f x then x:xs else xs
601.    func2 []     = Nothing
602.    func2 (x:xs) = Just(g x, xs)
603. </pre>
604. これを直接再帰の形式のmetaに差し替えると、こうなります。
605. <br />
606. <pre class="prettyprint lang-hs">mapfilterMF f g = lmeta func2 func1 []
607.  where
608.    func1 x xs   = if f x then x:xs else xs
609.    func2 []     = Nothing
610.    func2 (x:xs) = Just(g x, xs)
611. </pre>
612. fにfilter用の関数を渡し、gにmapに渡す関数を渡します。<br />
613. map after filter(filter関数の実結果にmap関数を実行)の融合変換は、map関数を展開があるため、metamorphismを使うことで綺麗に表現出来ています。。。(多分<br />
614. <br />
615. 以下実行結果です。
616. <br />
617. <pre class="prettyprint lang-hs">*Main> mapfilterMF (\x-> (mod x 5) == 0) (3 +) [1..20]
618. [8,13,18,23]
619. *Main> map (3 +) $ filter (\x-> (mod x 5) == 0) [1..20]
620. [8,13,18,23]
621. *Main> mapfilterM (\x-> (mod x 5) == 0) (3 +) [1..20]
622. [8,13,18,23]
623. </pre>
624. このようにして、hylomorphismやmetamorphismは融合変換に使用することができます。<br />
625. <br />
626. そして、最後に!　ググったら出てきた、面白いhylomorphism/metamorphismの例を紹介します。(参考文献1より)<br />
627. それが、hylomorphismとmetamorphismによるQuicksort & Heapsortです。
628. 例によって、in-placeではないので、それぞれ偽のQuicksort、Heapsortになります。<br />
629. <br />
630. まず、hylomorphismによるQuicksort(参考文献１からの引用)！
631. <br />
632. <pre class="prettyprint lang-hs">data Tree alpha = Node(Maybe(alpha, Tree(alpha), Tree(alpha))) deriving Show
633.  
634. foldt :: (Maybe(alpha, beta, beta) -> beta) -> Tree(alpha) -> beta
635. foldt f (Node Nothing)         = f Nothing
636. foldt f (Node (Just(a, t, u))) = f $ Just(a, foldt f t, foldt f u)
637.  
638. unfoldt :: (beta -> Maybe(alpha, beta, beta)) -> beta -> Tree(alpha)
639. unfoldt f b = case f b of
640.  Nothing         -> Node Nothing
641.  Just(a, b1, b2) -> Node(Just(a, unfoldt f b1, unfoldt f b2))
642.  
643. partition :: (Ord alpha) => [alpha] -> Maybe(alpha, [alpha], [alpha])
644. partition []          = Nothing
645. partition (a:as)      = Just(a, filter (< a) as, filter (> a) as)
646.  
647. join :: Maybe (alpha, [alpha], [alpha]) -> [alpha]
648. join Nothing          = []
649. join (Just(a, x, y))  = x ++ [a] ++ y
650.  
651. quicksort :: (Ord alpha) => [alpha] -> [alpha]
652. quicksort = foldt join . unfoldt partition
653. </pre>
654. 主に、partitionとjsonそして、unfoldt/foldtは木構造を生成して、それをリストに引き戻している処理になります。
655. Haskellのfake Quicksortのコードがjoinとpartitionの箇所にそのまま現れていることがわかります。<br />
656. <br />
657. 同様にして、metamorphismによるHeapsort(Quicksort同様、参考文献１からのほぼ引用ですが、一部修正)。<br />
658. <pre class="prettyprint lang-hs">insert :: (Ord alpha) =>  alpha -> Tree(alpha) -> Tree(alpha)
659. insert a t = merge (Node(Just(a, e, e)), t)
660.  where
661.    e = Node Nothing
662.  
663. splitMin ::  (Ord alpha) => Tree(alpha) -> Maybe(alpha, Tree(alpha))
664. splitMin (Node t) = case t of
665.  Nothing       -> Nothing
666.  Just(a, u, v) -> Just(a, merge(v, u))
667.  
668. merge :: (Ord alpha) => (Tree(alpha), Tree(alpha)) -> Tree(alpha)
669. merge(t, Node Nothing) = t
670. merge(Node Nothing, u) = u
671. merge(Node x, Node y)  = if a < b
672.  then Node(Just(a, t2, merge(t1, Node y)))
673.  else Node(Just(b, u2, merge(u1, Node x)))
674.  where
675.    Just(a, t1, t2) = x
676.    Just(b, u1, u2) = y
677.  
678. heapsort :: (Ord alpha) => [alpha] -> [alpha]
679. heapsort = lana splitMin . lcata insert (Node Nothing)
680. </pre>
681. こちらは少し特殊ですが、補助関数mergeを作っています。 mergeが別に再帰的な処理を行っていますが、これは本体の再帰とは別の処理です。<br />
682. <br />
683. まあ、ここまで来ると、素直に再帰を書けば良い気もしますが、再帰関数がこのように分離出来るのは面白いですね。<br />
684. <br />
685. Haskellのcataやana、hyloなどで書ける関数は、<a href="https://hackage.haskell.org/package/pointless-haskell">The pointless-haskell package</a>(のExample)に色々紹介してあるので、それらを使って
686. 遊んで見るのも良いかも知れません。<br />
687. <br />
688. 今回作成したコードの全体は<a href="https://gist.github.com/yuwki0131/db2dcc08d8b6b086d055182dc32c0300">ここ(Gist)</a>に置いてます。<br />
689. <br />
690. ps. 急ぎで書いてしまったので、後で修正が入るかも知れません。<br />
691. <br />
692. 参考文献<br />
693. <br />
694. <ol>
695. <li>J.Gibbsons, Metamorphisms: Streaming Representation-Changers, 2005(<a href="http://www.cs.ox.ac.uk/people/jeremy.gibbons/publications/metamorphisms-scp.pdf">PDF</a>)</li>
696. <li>F. Domínguez, Alberto Pardo, Exploiting algebra/coalgebra duality for program fusion extensions, 2011 (<a href="https://www.fing.edu.uy/inco/proyectos/fusion/papers/ldta11.pdf">PDF</a>)</li>
697. <li>Yoshiyuki Onoue, Zhenjiang Hu, Hideya Iwasaki, Masato Takeichi, A Calculational Fusion System HYLO, 1997 (<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.36.3768">PDF</a>)</li>
698. </ol>
699. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/1393979470158201487/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=1393979470158201487&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/1393979470158201487'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/1393979470158201487'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2017/11/hylomorphismmetamorphism.html' title='HylomorphismとMetamorphism'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-7590345748142148894</id><published>2017-05-14T00:22:00.000+09:00</published><updated>2017-05-14T00:22:18.994+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Emacs"/><title type='text'>Emacsのギリシャ文字/キリル文字のフォント表示</title><content type='html'>長らくブログを書いてなかったので、復帰がてらに、最近やったEmacsの設定について、メモします。&lt;br /&gt;
700. <br />
701. Emacsを使う場合、日本語の設定を
702. <br />
703. <pre class="prettyprint lang-el">;; 日本語
704. (set-fontset-font
705. 'nil 'japanese-jisx0208 (font-spec :family "Takaoゴシック" :height 90))</pre>
706. のように、何かしらフォントの設定を行うと思いますが、その時、ギリシャ文字やキリル文字のフォントも全角化されてしまいます。以下のように...<br />
707. <br />
708. <div class="separator" style="clear: both; text-align: center;">
709. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhc2aAP3zTkRj8Ak26hrtGzBO1PsNs8MmpzjP4NjS_tW62BL57nh4zRQA_k8TXdU2hYqxc_i58fPUnSkbh0KOkdL4GzYzWwQcoZ_V1X3L69nxf9dGTAkhLKMNi3TnvpLJ8JrT1WGvJxaMI/s1600/sample1.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="175" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhc2aAP3zTkRj8Ak26hrtGzBO1PsNs8MmpzjP4NjS_tW62BL57nh4zRQA_k8TXdU2hYqxc_i58fPUnSkbh0KOkdL4GzYzWwQcoZ_V1X3L69nxf9dGTAkhLKMNi3TnvpLJ8JrT1WGvJxaMI/s400/sample1.png" width="400" /></a></div>
710. <br />
711. しかし、全角のギリシャ/キリル文字は読みづらいので、できれば、別のフォントで表示させたくなります。というわけで、こんな感じで別のコードポイントを割り当てます。<br />
712. <pre class="prettyprint lang-el">;; ギリシャ文字
713. (set-fontset-font
714. 'nil '(#x0370 . #x03FF) (font-spec :family "Ubuntu Mono" :height 100))
715.  
716. ;; キリル文字
717. (set-fontset-font
718. 'nil '(#x0400 . #x04FF) (font-spec :family "Ubuntu Mono" :height 100))</pre>
719. <br />
720. ギリシャ文字のコードポイントは、#x0370〜#x03FF、キリル文字のコードポイントは、#x0400〜#x04FFなので、上記のように設定します。<br />
721. そして、再表示した結果が以下。<br />
722. <div class="separator" style="clear: both; text-align: center;">
723. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiN81H1u5O9c8H71l7h8IUEvGuf8b6ZeYX9VxumT7M1FtTirVdPSnk9TIevmupE51km2UR91ZktsRp8KSXHV2Sxi5QgqgKYYoJqqngJeKei6Q8lpeoAkclI0yhWo2WFWV3op1gsHEwPi_g/s1600/sample2.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="148" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiN81H1u5O9c8H71l7h8IUEvGuf8b6ZeYX9VxumT7M1FtTirVdPSnk9TIevmupE51km2UR91ZktsRp8KSXHV2Sxi5QgqgKYYoJqqngJeKei6Q8lpeoAkclI0yhWo2WFWV3op1gsHEwPi_g/s400/sample2.png" width="400" /></a></div>
724. <br />
725. しっかり、半角化されて、綺麗な表示になりました。<br />
726. <br />
727. ちなみに、私はこんなフォント設定をしています。<br />
728. <pre class="prettyprint lang-el">(defvar default-font-family "Ubuntu Mono")
729. (defvar default-font-family-jp "Takaoゴシック")
730.  
731. ;; デフォルトフォント設定
732. (set-face-attribute
733. 'default nil :family default-font-family :height 100)
734.  
735. ;; 日本語のフォントセット : あいうえお ... 日本語
736. (set-fontset-font
737. 'nil 'japanese-jisx0208 (font-spec :family default-font-family-jp :height 90))
738.  
739. ;; ギリシャ文字のフォントセット : αβγκλ ... ΛΩ
740. (set-fontset-font
741. 'nil '(#x0370 . #x03FF) (font-spec :family default-font-family :height 100))
742.  
743. ;; キリル文字のフォントセット : Эта статья ... Русский
744. (set-fontset-font
745. 'nil '(#x0400 . #x04FF) (font-spec :family default-font-family :height 100))</pre>
746. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/7590345748142148894/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=7590345748142148894&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7590345748142148894'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7590345748142148894'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2017/05/emacs.html' title='Emacsのギリシャ文字/キリル文字のフォント表示'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhc2aAP3zTkRj8Ak26hrtGzBO1PsNs8MmpzjP4NjS_tW62BL57nh4zRQA_k8TXdU2hYqxc_i58fPUnSkbh0KOkdL4GzYzWwQcoZ_V1X3L69nxf9dGTAkhLKMNi3TnvpLJ8JrT1WGvJxaMI/s72-c/sample1.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-6382524072936536670</id><published>2016-03-02T20:18:00.000+09:00</published><updated>2016-03-13T00:11:05.228+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="incanter"/><title type='text'>Incanterのグラフのフォントが文字化けする問題(Clojure)</title><content type='html'>ClojureのIncanter, 便利なライブラリですが, 日本語などを使った場合, 表示されるフォントが文字化けするという問題があります.&lt;br /&gt;
747. <br />
748. ちなみに, こんな感じ.<br />
749. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEito230Yy-qiV4nyiaNcsN-S8n0TKC0gk4aezexwW3vJyaYA-8uwFHXPonI01sfEqZ2VKA0v_j6W1XEA2niwRuBK2WYbygH6E_aYs8ChRGwjYYbh-eE5vh2fjqnJ9JQXZlK8TvxDRpQzaA/s1600/family-names.png" imageanchor="1"><img border="0" height="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEito230Yy-qiV4nyiaNcsN-S8n0TKC0gk4aezexwW3vJyaYA-8uwFHXPonI01sfEqZ2VKA0v_j6W1XEA2niwRuBK2WYbygH6E_aYs8ChRGwjYYbh-eE5vh2fjqnJ9JQXZlK8TvxDRpQzaA/s400/family-names.png" width="400" /></a><br />
750. 元は, 次のようなデータ.<br />
751. <pre class="prettyprint lang-clj">(def top-family-names
752.  [["佐藤" 313079]
753.   ["鈴木" 268103]
754.   ["高橋" 226090]
755.   ["田中" 205560]
756.   ["伊藤" 171104]
757.   ["山本" 167767]
758.   ["渡辺" 166831]
759.   ["中村" 163789]
760.   ["小林" 162481]
761.   ["加藤" 133341]])</pre>
762. <span style="font-size: x-small;">※データは, <a href="http://namaeranking.com/?search=%E3%83%A9%E3%83%B3%E3%82%AD%E3%83%B3%E3%82%B0&tdfk=%E5%85%A8%E5%9B%BD&namae=%E5%90%8D%E5%AD%97">同姓同名探しと名前ランキング</a>より.</span><br />
763. <br />
764. 勿論, 日本語を使わないとか, ローマ字表記にするいう選択肢もありますが, 日本語の処理を行う場合, 各軸の値が日本語の場合は避けて通れません.<br />
765. <br />
766. 上記の場合, 日本の苗字トップ10を表示させたつもりなのですが, 凡例は勿論, 各データの内容もわからなくなってしまいます. 唯一正しく表示されているのは, 数値のみです.<br />
767. <br />
768. 調べると, Google Groupsに解決策がありました.<br />
769. <a href="https://groups.google.com/forum/#!topic/incanter/s_5OR-OP9gw">https://groups.google.com/forum/#!topic/incanter/s_5OR-OP9gw</a><br />
770. <br />
771. Fontを変えれば良いようです. というわけでMSゴシックへフォントを変更しました.<br />
772. <pre class="prettyprint lang-clj">(use '(incanter core charts))
773. (import 'java.awt.Font)
774.  
775. (defn view-incanter [xy-values]
776.  (let [xs (map first xy-values)
777.        ys (map second xy-values)
778.        chart (bar-chart xs ys :vertical false
779.                         :x-label "family names" :y-label "number of people")
780.        _ (-> chart .getCategoryPlot .getDomainAxis
781.              (.setTickLabelFont (new Font "MS ゴシック" Font/BOLD 10)))]
782.    (save chart "family-names.png")))
783.  
784. (view-incanter top-family-names)</pre>
785. という形です.
786. <br />
787. <br />
788. これを描写すると,<br />
789. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEifLwzqMXcOKpYbvVC1hs3xTGQix_t2I_k9wpwZj__3HIeKfWRS6Yi3cOW6-UPk9L0523uy-hZeMskW0Ls5KNwKyg2gIJwpxeL9nw-fj_-3A4PJF_01_9fPXEeSStldXfl2x5zhdHPO-T8/s1600/family-names.png" imageanchor="1"><img border="0" height="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEifLwzqMXcOKpYbvVC1hs3xTGQix_t2I_k9wpwZj__3HIeKfWRS6Yi3cOW6-UPk9L0523uy-hZeMskW0Ls5KNwKyg2gIJwpxeL9nw-fj_-3A4PJF_01_9fPXEeSStldXfl2x5zhdHPO-T8/s400/family-names.png" width="400" /></a><br />
790. こんな感じで, 軸ラベルは変更できませんが, 縦軸の値は日本語化できました.
791. <br />
792. <pre class="prettyprint lang-clj">(-> chart .getCategoryPlot .getDomainAxis
793.    (.setTickLabelFont (new Font "MS ゴシック" Font/BOLD 10)))</pre>
794. の部分で縦軸のフォントを変えることができます. 横軸を変える場合は, .getDomainAxis→.getRangeAxisで変えられると思われます.<br />
795. <br />
796. しかし, ここまで来ると, 軸ラベルもすべて一括して日本語で表示できるようにしたくなります. そして, 調べていて分かったのですが, Incanterのプロットは, JavaのJFreeChartを使ってプロットしているようです. そして, JFreeChartには, グラフが文字化けした場合のおまじないがありました.<br />
797. <br />
798. <a href="http://tk-factory.net/wordpress/?p=1497">JFreeChart – グラフ中の日本語が文字化けしないようにするには - TK FACTORY</a><br />
799. <br />
800. そしてそれは,
801. <br />
802. <pre class="prettyprint lang-java">ChartFactory.setChartTheme(StandardChartTheme.createLegacyTheme());</pre>
803. だそうです. というわけで,
804. <br />
805. <pre class="prettyprint lang-clj">(import 'org.jfree.chart.ChartFactory)
806. (import 'org.jfree.chart.StandardChartTheme)
807. (ChartFactory/setChartTheme (StandardChartTheme/createLegacyTheme))</pre>
808. を描画前に入れると, 文字化けが修正されます(ただし, メソッド名にあるように, テーマも変更されてしまいますが).
809. <br />
810. これは, 次のようにプロットされます.
811. <br />
812. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiNpTI2M_hsmwiT-UwwUU1um5-YC2KUzlbm2WQigmZTJzwswFUwMecrRtmJmQrhwval8v2k0luzapgzWQe_mBtakoI7dhA5A7x37wobLVk30vS51iXGa_ROTQK1CUmDvJgPPANRBa9hj_A/s1600/top-family-names.png" imageanchor="1"><img border="0" height="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiNpTI2M_hsmwiT-UwwUU1um5-YC2KUzlbm2WQigmZTJzwswFUwMecrRtmJmQrhwval8v2k0luzapgzWQe_mBtakoI7dhA5A7x37wobLVk30vS51iXGa_ROTQK1CUmDvJgPPANRBa9hj_A/s400/top-family-names.png" width="400" /></a><br />
813. 見た目を気にしないなら,　とりあえず, これでOKですね.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/6382524072936536670/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=6382524072936536670&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/6382524072936536670'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/6382524072936536670'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2016/03/incanterclojure.html' title='Incanterのグラフのフォントが文字化けする問題(Clojure)'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEito230Yy-qiV4nyiaNcsN-S8n0TKC0gk4aezexwW3vJyaYA-8uwFHXPonI01sfEqZ2VKA0v_j6W1XEA2niwRuBK2WYbygH6E_aYs8ChRGwjYYbh-eE5vh2fjqnJ9JQXZlK8TvxDRpQzaA/s72-c/family-names.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-1442807435280853943</id><published>2015-08-11T13:11:00.003+09:00</published><updated>2015-08-11T13:11:41.057+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><title type='text'>Convex Hull(凸包)を求める(Jarvis&#39;s March, Quickhull, Clojure)</title><content type='html'>&amp;nbsp;凸包を求めるアルゴリズムを2つ(Jarvis&#39;s MarchとQuickhull)調べたので, そのメモ.&lt;br /&gt;
814. <br />
815.  どちらもアルゴリズム的には, シンプルですが, Quickhullの方は, 理解するのに少し時間がかかりました. Jarvis's Marchは, ギフト包装法という呼び方の方が一般的なようです. どちらも基本的には幾何学の問題で, 高校数学の基礎的な内容と外積を駆使します.<br />
816. <br />
817.  画像としては以下のような感じ. 点の集合を囲む凹みの無いつつみが凸包です. 凸包は, 一部の線形計画法の問題などで使われますが, <a href="https://ja.wikipedia.org/wiki/%E6%8A%BD%E8%B1%A1%E8%A7%A3%E9%87%88">抽象解釈</a>などにも凸多面体などとして, 応用されているという点が面白いですね.<br />
818. <div class="separator" style="clear: both; text-align: center;">
819. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEggH1JrUMegRioHBEk2vqsqIgPbSknVj83pTZ5dRG6ql7GhBlvLlAY9sCwyNrAfEBansMrgH7I97ARVgnKvd3fmHvzYwdQVJgmDBXpzsPaJXjb1dpgOgL4gZ83Iu1cmJH9Sj_GZkXqSlJY/s1600/convexhullex.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="257" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEggH1JrUMegRioHBEk2vqsqIgPbSknVj83pTZ5dRG6ql7GhBlvLlAY9sCwyNrAfEBansMrgH7I97ARVgnKvd3fmHvzYwdQVJgmDBXpzsPaJXjb1dpgOgL4gZ83Iu1cmJH9Sj_GZkXqSlJY/s320/convexhullex.png" width="320" /></a></div>
820. <br />
821. 以下では, 2次元について考えます.<br />
822.  Jarvis's Marchから.<br />
823. <div style="text-align: center;">
824. <a href="https://ja.wikipedia.org/wiki/%E3%82%AE%E3%83%95%E3%83%88%E5%8C%85%E8%A3%85%E6%B3%95">ギフト包装法 - Wikipedia</a></div>
825. <br />
826.  求めるのは, 凸包を構成する点列です. そしてその点列に含まれるのが自明な点は, 最左, 最右と, 最上, 最下の点でしょう. Jarvis's Marchのアルゴリズムは, この４つのどの点でもいいのですが, とりあえずとっかかりとして, 最左の点(x座標が一番小さい点)から始めます.<br />
827. <br />
828. 1. 現在の点から他の全ての点へのベクトルの角度を求め, 角度が最小の点を凸包の点列に追加し, これを次の点とする.<br />
829. 2. 始めた点へ戻ってくるまで1を続ける.<br />
830. <br />
831.  というのがアルゴリズムで, 非常に簡単でした. 1で角度が同じ場合は, 現在の点から距離が近い方を選びます. 角度を求める手法は何でも良いらしいですが, Wikipediaに従い, 外積を用いることにしました. (外積の意味については, 参考 : <a href="http://marupeke296.com/COL_Basic_No1_InnerAndOuterProduct.html">基礎の基礎その1 内積と外積の使い方 - ○×つくろーどっとコム</a>)<br />
832. <br />
833. Wikipediaの擬似コードを無理やり関数型言語へ押し込むと以下のようになりました. 多分, 手続き型言語よりも整理出来ていると思います. (incanterを使っています.)<br />
834. <pre class="prettyprint lang-clj">(require '[incanter.core :as in]
835.         '[incanter.stats :as st]
836.         '[incanter.charts :as ch])
837.  
838. ;; -- Jarvis's March to find convex hull
839.  
840. (defn left-most-point [[x1 y1 :as p1] [x2 y2 :as p2]]
841.  (if (< x1 x2) p1 p2))
842.  
843. (defn ex-product
844.  "exterior product"
845.  [[x1 y1 :as p1] [x2 y2 :as p2]]
846.  (- (* x1 y2) (* x2 y1)))
847.  
848. (defn -vec [[x1 y1 :as p1] [x2 y2 :as p2]]
849.  [(- x1 x2) (- y2 y1)])
850.  
851. (defn min-angle [current-p point-b point-c]
852.  (let [v (ex-product (-vec current-p point-b) (-vec current-p point-c))]
853.    (if-not (or (= point-b current-p)
854.                (< 0 v)
855.                (and (< -0.001 v 0.001)
856.                     (< (st/euclidean-distance current-p point-b)
857.                        (st/euclidean-distance current-p point-c))))
858.      point-b point-c)))
859.  
860. (defn jarvis-march
861.  "find convex hull, points = [[x1, y1], ...]"
862.  [points]
863.  (let [start-p (reduce left-most-point points)]
864.    (loop [current-p start-p hull-ps [start-p]]
865.      (let [next-p (reduce (partial min-angle current-p) points)]
866.        (if (and (= next-p start-p))
867.          hull-ps
868.          (recur next-p (cons next-p hull-ps)))))))
869.  
870. ;; --- visualization --- (use incanter)
871. (defn plot-convex-hull [points hull-ps]
872.  (let [hull-ps (cons (last hull-ps) hull-ps)]
873.    (ch/add-lines
874.     (ch/scatter-plot (map first points) (map second points))
875.     (map first hull-ps)
876.     (map second hull-ps)
877.     :auto-sort false)))
878.  
879. ;; --- test ---
880. (defn generate-sample-set []
881.  (letfn [(generate-by [m]
882.            (st/sample-normal
883.             (+ 100 (rand-int 100)) :mean m :sd (+ 0.15 (rand 0.1))))]
884.    (map list
885.         (generate-by (dec (rand 2)))
886.         (generate-by (dec (rand 2))))))
887.  
888. (defn trial []
889.  (let [ps (generate-sample-set)
890.        result (jarvis-march ps)]
891.    (in/view (plot-convex-hull ps result))))</pre>
892.  このアルゴリズムは, 計算量が大きそうですが, 自明な凸包の輪郭とならない点を削ることで, 計算量を減らすことは可能なようです. 例えば, 前述の上下左右4点の内側の点は全て凸包の輪郭には含まれないのでこれらの点は無視できますね.<br />
893. <br />
894.  意外に気づかずにハマったのは, incanterのchart/add-linesが引数として渡されたxy各座標のリストを勝手にソートしてくれることです. :auto-sortをfalseに設定しています.<br />
895. <br />
896. 次に, Quickhullのアルゴリズム. これは, Quicksort風の分割統治法によるアルゴリズムで, やはり, このアルゴリズムも自明な点から始めます.<br />
897. <br />
898. <div style="text-align: center;">
899. <a href="https://en.wikipedia.org/wiki/Quickhull">Quickhull - Wikipedia</a></div>
900. <br />
901.  最左と最右の点を初期値にします. 上記のWikipediaの記事とは書き方が少し異なりますが, 内容としては同じ(はず)です.<br />
902. <br />
903. 1. 最左/最右の点を求める.<br />
904. 2. 前述の二点(p-left-most, p-right-most)から線分を求め, これで点の集合を二分し, 上半分についてのみ考え, 3.に上記二点(p-left-most, p-right-most)と上半分の集合を渡す.<br />
905. <br />
906. 3. (関数. 引数は 二点(p1, p2)と点の集合)<br />
907. 3-1. 線分から最も遠い点fpを求める<br />
908. 3-2. これを凸包の点の一つとし, 線分とfpからなる三角形の内側の点を除外.<br />
909. 3-3. 三角形の外側に残る点のうち, fpより左側の点の集合と, fpより右側の点の集合に分ける.<br />
910. 3-4. 3.へp1, fpと左半分を渡し, p1〜pf間の凸包の部分列(輪郭の点列)を求める.<br />
911. 3-5. 3.へfp, p2と右半分を渡し, pf〜p2間の凸包の部分列を求める.<br />
912. 3-6. 3-4, pf, 3-5の結果を合わせて, p1〜p2間の凸包の部分列として返す.<br />
913. <br />
914. 4. 下半分も3.へ渡す.<br />
915. 5. 上半分, 下半分について求めた結果と, 最左最右の点を纏める => 凸包を構成する点列.<br />
916. <br />
917.  Jarvis's Marchと比較して, 少し手間がかかりますが, こんなイメージ.<br />
918. <div class="separator" style="clear: both; text-align: center;">
919. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgYKm0Wmz-aWmnLyEQob3k4e8a9lsOjpjQd2iL9Y0LFcUvwKMsjlh2ZKbhq4ZBn6nbOAdY9aAb7TEKCxY9CUo_ckg-ph0WatZ6Rs5xCJtftkqNXzRDUbFhRqGpiqrbH0D1jLjicgwRTQY8/s1600/quickhull.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="257" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgYKm0Wmz-aWmnLyEQob3k4e8a9lsOjpjQd2iL9Y0LFcUvwKMsjlh2ZKbhq4ZBn6nbOAdY9aAb7TEKCxY9CUo_ckg-ph0WatZ6Rs5xCJtftkqNXzRDUbFhRqGpiqrbH0D1jLjicgwRTQY8/s320/quickhull.png" width="320" /></a></div>
920. <br />
921.  全体として分割統治法で, 再帰的に求めていくと, 答えが求まるという流れになります. 線分からの距離は, y=ax+b(直線)からの距離を求めればOK. 三角形に含まれるかどうかも, 外積から求まります.<br />
922. <pre class="prettyprint lang-clj">(require '[incanter.core :as in]
923.         '[incanter.stats :as st]
924.         '[incanter.charts :as ch])
925.  
926. (defn get-ab
927.  "calc a,b for y = ax + b from p1, p2"
928.  [[x1 y1] [x2 y2]]
929.  (let [a (/ (- y1 y2) (- x1 x2))]
930.    [a (- y2 (* a x2))]))
931.  
932. (defn ex-product
933.  "exterior product"
934.  [[x1 y1 :as p1] [x2 y2 :as p2]]
935.  (- (* x1 y2) (* x2 y1)))
936.  
937. (defn -vec
938.  "p1 - p2 (p1 & p2 is vector)"
939.  [[x1 y1 :as p1] [x2 y2 :as p2]]
940.  [(- x1 x2) (- y2 y1)])
941.  
942. (defn in-triangle?
943.  [[x1 y1 :as p1] [x2 y2 :as p2] [x3 y3 :as p3] [tx ty :as tp]]
944.  (let [from-a (ex-product (-vec p3 p1) (-vec p1 tp))
945.        from-b (ex-product (-vec p1 p2) (-vec p2 tp))
946.        from-c (ex-product (-vec p2 p3) (-vec p3 tp))
947.        abc [from-a from-b from-c]]
948.    (or (reduce #(and %1 %2) (map pos? abc))
949.        (reduce #(and %1 %2) (map neg? abc)))))
950.  
951. (defn furthest-point [[x1 y1 :as xy1] [x2 y2 :as xy2] points]
952.  (let [[a b] (get-ab xy1 xy2)
953.        sqa2b2 (. Math sqrt (+ (. Math pow a 2) (. Math pow b 2)))]
954.    (letfn [(get-dist [[x0 y0]] (/ (. Math abs (+ (* a x0) (* -1 y0) b)) sqa2b2))]
955.      (reduce #(if (< (get-dist %1) (get-dist %2)) %2 %1) points))))
956.  
957. (defn find-points [p1 p2 points] ;; find points between p1 & p2
958.  (if (empty? points)
959.    []
960.    (let [[xf yf :as pf] (furthest-point p1 p2 points) ;; furthest point
961.          rest-points (remove #(or (in-triangle? p1 p2 pf %) (= pf %)) points)]
962.      (concat (find-points p1 pf (filter #(< (first %) xf) rest-points))
963.              [pf]
964.              (find-points pf p2 (filter #(<= xf (first %)) rest-points))))))
965.  
966. (defn quick-hull [points]
967.  (let [p-left-most (reduce #(if (< (first %1) (first %2)) %1 %2) points)
968.        p-right-most (reduce #(if (< (first %1) (first %2)) %2 %1) points)
969.        [a b] (get-ab p-left-most p-right-most)]
970.    (letfn [(upper? [[x y]] (< (+ (* a x) b) y))]
971.      (concat [p-left-most]
972.              (find-points p-left-most p-right-most (filter upper? points))
973.              [p-right-most]
974.              (->> (filter #(not (upper? %)) points)
975.                   (find-points p-left-most p-right-most)
976.                   reverse)))))
977.  
978. ;; --- visualization --- (use incanter)
979. (defn plot-convex-hull [points hull-ps]
980.  (let [hull-ps (cons (last hull-ps) hull-ps)]
981.    (ch/add-lines
982.     (ch/scatter-plot (map first points) (map second points))
983.     (map first hull-ps)
984.     (map second hull-ps)
985.     :auto-sort false)))
986.  
987. ;; --- test ---
988. (defn generate-sample-set []
989.  (letfn [(generate-by [m]
990.            (st/sample-normal
991.             (+ 1000 (rand-int 500)) :mean m :sd (+ 0.15 (rand 0.1))))]
992.    (map list
993.         (generate-by (dec (rand 2)))
994.         (generate-by (dec (rand 2))))))
995.  
996. (defn trial []
997.  (let [ps (generate-sample-set)
998.        result (quick-hull ps)]
999.    (in/view (plot-convex-hull ps result))))</pre>
1000. filterやconcatの使い方が, Haskell系の偽Quicksortにそっくりですね.<br />
1001. <br />
1002. <b>参考文献</b><br />
1003. &lt;a href=&quot;http://asura.iaigiri.com/OpenGL/gl50.html&quot;&gt;Quickhullアルゴリズム Project ASURA&lt;/a&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/1442807435280853943/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=1442807435280853943&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/1442807435280853943'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/1442807435280853943'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/08/convex-hulljarviss-march-quickhull.html' title='Convex Hull(凸包)を求める(Jarvis&#39;s March, Quickhull, Clojure)'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEggH1JrUMegRioHBEk2vqsqIgPbSknVj83pTZ5dRG6ql7GhBlvLlAY9sCwyNrAfEBansMrgH7I97ARVgnKvd3fmHvzYwdQVJgmDBXpzsPaJXjb1dpgOgL4gZ83Iu1cmJH9Sj_GZkXqSlJY/s72-c/convexhullex.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-2813794708439363509</id><published>2015-07-28T02:50:00.001+09:00</published><updated>2015-07-28T03:04:31.675+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="トランポリン"/><title type='text'>loop/recurで相互再帰(Clojure)</title><content type='html'>&amp;nbsp;Clojureのtrampolineを使った相互再帰の例として, even/odd関数が有りますが, しかし, &amp;nbsp;簡単な相互再帰なら, trampolineよりloop-recur内に自分でディスパッチさせる処理を書いたほうがわかりやすいような気がします.&lt;br /&gt;
1004. <br />
1005.  例えば, even/oddならこんな感じ.<br />
1006. <pre class="prettyprint lang-clj">(defn even-odd? [even-or-odd n]
1007.  (loop [status even-or-odd n n]
1008.    (cond
1009.     (= status :even)
1010.     (if (= n 0)
1011.       true
1012.       (recur :odd (dec n)))
1013.     (= status :odd)
1014.     (if (= n 0)
1015.       false
1016.       (recur :even (dec n))))))</pre>
1017. こう書いておいて,
1018. <pre class="prettyprint lang-clj">user> (even-odd? :odd 9)</pre>と呼び出すとか.
1019. cond節が冗長になりますが, declare, defnと書いて, 無名関数で囲って, trampolineで待ち受けさせるのと大差ないかなと....思ったのですが, 比べてみると, やっぱり読みにくい. trampoline版のほうがシンプルですね.
1020. <pre class="prettyprint lang-clj">(declare my-odd?)
1021.  
1022. (defn my-even? [n]
1023.  (if (= n 0)
1024.    true
1025.    #(my-odd? (dec n))))
1026.  
1027. (defn my-odd? [n]
1028.  (if (= n 0)
1029.    false
1030.    #(my-even? (dec n))))</pre>
1031. 適当に測ってみると少し早くなった程度.
1032. <pre class="prettyprint lang-clj">user> (time (trampoline my-even? 10000000))
1033. "Elapsed time: 2127.23756 msecs"
1034. true
1035. user> (time (even-odd? :even 10000000))
1036. "Elapsed time: 1781.678006 msecs"
1037. true&lt;/pre&gt; しかし, 相互再帰を書く時の選択肢としてはありかなと思ったりしてます.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/2813794708439363509/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=2813794708439363509&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2813794708439363509'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2813794708439363509'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/07/evenoddclojure.html' title='loop/recurで相互再帰(Clojure)'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-5108668716430270601</id><published>2015-07-15T20:27:00.000+09:00</published><updated>2017-11-13T21:30:20.215+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="Graphviz"/><category scheme="http://www.blogger.com/atom/ns#" term="構文解析"/><title type='text'>dorothy(Graphviz)で木構造(構文解析木)を可視化</title><content type='html'>&amp;nbsp;&lt;a href=&quot;https://github.com/daveray/dorothy/&quot;&gt;dorothy&lt;/a&gt;は, &lt;a href=&quot;http://www.graphviz.org/&quot;&gt;Graphviz&lt;/a&gt;&lt;span id=&quot;goog_874427814&quot;&gt;&lt;/span&gt;&lt;span id=&quot;goog_874427815&quot;&gt;&lt;/span&gt;&lt;a href=&quot;https://www.blogger.com/&quot;&gt;&lt;/a&gt;のClojure向けのラッパーです. シーケンスによる(Graphvizの)DOT言語を用いて, グラフ構造を記述すると, そこから, そのグラフを可視化します.&lt;br /&gt;
1038.  dorothyの基本的な使い方については, dorothyの<a href="https://github.com/daveray/dorothy/">README</a>か, 以下のページの説明が詳しいです.<br />
1039. <br />
1040. <div style="text-align: center;">
1041. <a href="http://qiita.com/kurogelee/items/aa5bb531ff87de0fe99e">dorothyの魔法でクラス図を描く - Qiita</a></div>
1042. <br />
1043.  木構造もグラフの一種なので, パーサ(opennlp)によって生成された構文解析木を表示させてみることにします. Clojureのopennlpについては, <a href="http://uid0130.blogspot.jp/2014/11/clojureopennpl.html">前</a>にも触れましたが, 今回は, これにdorothyを合わせて使ってみます. 長文を構文解析し, dorothyで可視化すると, 以下のようになります.<br />
1044. <div class="separator" style="clear: both; text-align: center;">
1045. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjemN6kl6f_jRWQ_GTvK5nEx4FcgLuWBnbJ9gxPKJpf67fPhyc10gEGI8l_sQE3ProkL3HFR5WbtHTY7GfZNHal8Gs9suSjecdYJdRGh9TzgVnc-icpAE9YIsyO8BV8m5Pk1NauAa2aaQk/s1600/out.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="162" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjemN6kl6f_jRWQ_GTvK5nEx4FcgLuWBnbJ9gxPKJpf67fPhyc10gEGI8l_sQE3ProkL3HFR5WbtHTY7GfZNHal8Gs9suSjecdYJdRGh9TzgVnc-icpAE9YIsyO8BV8m5Pk1NauAa2aaQk/s320/out.png" width="320" /></a></div>
1046. <br />
1047.  opennlpからdorothyへの変換は, 基本的に, 木構造のリンク関係を[src dst]のリストへ変換すればOKで, 書いてみると, こんな感じになります.
1048. <br />
1049. <pre class="prettyprint lang-clj">(require '[dorothy.core :refer :all];; [dorothy "0.0.6"]
1050.         '[opennlp.treebank :refer :all]) ;; [clojure-opennlp "0.3.2"]
1051.  
1052. (def treebank-parser
1053.  (make-treebank-parser "en-parser-chunking.bin"))
1054.  
1055. (defn gensym- [tag]
1056.  (keyword (gensym (str (name tag) "-"))))
1057.  
1058. (defn ungensym- [tag]
1059.  (first (clojure.string/split (name tag) #"-")))
1060.  
1061. (defn tree->links [tree]
1062.  (if (string? tree)
1063.    [(gensym- tree)]
1064.    (let [{tag :tag chunk :chunk} tree
1065.          children (map tree->links chunk)
1066.          top (keyword (gensym- tag))]
1067.      (concat [top]
1068.              (map (fn [x] [top (first x)]) children)
1069.              (apply concat (map rest children))))))
1070.  
1071. (defn treeviz [en-text]
1072.  (letfn [(remove-sym [node]
1073.            (subgraph [[:node {:label (ungensym- node)}] node]))]
1074.    (let [link-pairs
1075.          (->> (treebank-parser [en-text]) first make-tree tree->links)
1076.          subnodes
1077.          (->> link-pairs flatten distinct (map remove-sym))
1078.          params
1079.          [(graph-attrs {:size "5, 5"}) (node-attrs {:fontsize 10})]]
1080.      (->> link-pairs (concat params subnodes) digraph dot show!))))</pre>
1081.  Graphviz側では, 親ノードから, 子ノードへのリンクの表現のリストで, 木構造を表すわけですが, ノードを表す識別子(POS(品詞)や名詞)が重複する可能性があるのでgensymなどを使ってノードのアイデンティティを確立します. 再帰的にリンクを表すペアのリストを作って上に投げるという処理を繰り返すだけで生成できるdorothyの記法は, かなりお手軽です.<br />
1082.  dorothyには, 以下のような[srs dst]で表されるペアのリストを渡します.
1083. <br />
1084. <pre class="prettyprint lang-clj">([:TOP-2782 :S-2783] [:S-2783 :NP-2784] [:S-2783 :VP-2791] [:S-2783 :.-2801] [:NP-2784 :DT-2785] [:NP-2784 :NN-2787] [:NP-2784 :NN-2789] [:DT-2785 :This-2786] [:NN-2787 :parse-2788] [:NN-2789 :tree-2790] [:VP-2791 :VBZ-2792] [:VP-2791 :NP-2794] [:VBZ-2792 :visualizes-2793] [:NP-2794 :DT-2795] [:NP-2794 :NN-2797] [:NP-2794 :NN-2799] [:DT-2795 :a-2796] [:NN-2797 :parse-2798] [:NN-2799 :tree-2800] [:.-2801 :.-2802])</pre>
1085.  これだけでも, 木構造は可視化できますが, これだと, シノニム部分がくっついて見づらいため, 各ノードのラベルは数値の部分を抜いた名前で表すことにします. 各ノードにラベル(ノードとして表示される名前)をつけるには, subgraphを使います. その他, 表示用のオプションがいくつか設定できますが, 今回は, フォントサイズと, 表示される画像のサイズを設定しました.
1086. <br />
1087. <pre class="prettyprint lang-clj">user> (treeviz "This tree visualizes a parse tree .")</pre>
1088. こんな感じで実行するとして,
1089. <br />
1090. <div class="separator" style="clear: both; text-align: center;">
1091. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEizp8C17GtT1l2g6n4Ec8tKxPuPYBN2135Zr07yRKOw2lAvVDBDC6ebyL3Zhttyp6QaElnlAKVlh4X1lv2RHgVOvmjle92gSs2n_nua2YQIArxDpWcSZDnx5XmKQrLADIu-kQ6y5MdlV9w/s1600/vizualized.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEizp8C17GtT1l2g6n4Ec8tKxPuPYBN2135Zr07yRKOw2lAvVDBDC6ebyL3Zhttyp6QaElnlAKVlh4X1lv2RHgVOvmjle92gSs2n_nua2YQIArxDpWcSZDnx5XmKQrLADIu-kQ6y5MdlV9w/s1600/vizualized.png" /></a></div>
1092.  上図の木構造が出てきます. 自然<strike>変換</strike>言語処理の教科書に乗ってそうな図ですね.<br />
1093.  TOPの下のSは, Statement(文)のSです. SubjectのSではないです. 主語は, NPで表されている左側の部分木です.<br />
1094. <br />
1095. &amp;nbsp;ちなみに, 要素の順番は重要で, 上記の例だと, 綺麗に元の文の単語列が左から順に表示されていますが, リストの順序が異なれば, 可視化の結果も異なり, 木構造としては成立していても変な形で表示されたりもします.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/5108668716430270601/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=5108668716430270601&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/5108668716430270601'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/5108668716430270601'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/07/dorothygraphviz.html' title='dorothy(Graphviz)で木構造(構文解析木)を可視化'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjemN6kl6f_jRWQ_GTvK5nEx4FcgLuWBnbJ9gxPKJpf67fPhyc10gEGI8l_sQE3ProkL3HFR5WbtHTY7GfZNHal8Gs9suSjecdYJdRGh9TzgVnc-icpAE9YIsyO8BV8m5Pk1NauAa2aaQk/s72-c/out.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-8832832504925058437</id><published>2015-07-11T11:56:00.000+09:00</published><updated>2016-05-18T23:55:37.987+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Haskell"/><category scheme="http://www.blogger.com/atom/ns#" term="圏論"/><title type='text'>関手, 自然変換とHaskell</title><content type='html'>$\require{AMScd}$ 最近, Mathjaxで遊んでいるので, それを使って, 関手と自然変換について調べたことのメモ.&lt;br /&gt;
1096. <br />
1097. <h4>
1098. 関手とHaskellのFunctor</h4>
1099. <br />
1100.  関手$F$は圏$X$から$Y$へ対応を表し, 圏$X$の各関数$f : A \rightarrow B$を $F(f) : F(A) \rightarrow F(B)$ として移すものです. 関手は元の圏の関数について合成則を保存し, $f : A \rightarrow B, g : B \rightarrow C$,を関手$F$によって移すと, $F(f) \circ F(g) = F(f \circ g)$という性質を持ちます. また, 元の圏の各対象Xについて, 移した先の関手$F(id_X)$の射もその先の対象の$id$射となります.<br />
1101. <br />
1102.  Haskellにおける関手$F$は, 名前も性質もmap関数に似ています.<br />
1103. <br />
1104. class Functor a where<br />
1105.   mapf : (a -> b) -> f a -> f b<br />
1106. <br />
1107.  mapfの実装として, リスト上のmap関数を考えると, 関手の合成則の保存が成立し, (map f) . (map g) = map (f . g)という規則が成立するはずですが, これは, プログラムの融合変換では一般にmap分配則と呼ばれるもので, 一般に成立します.<br />
1108. <br />
1109.  つまり, ある型からなる圏〜リストへの関手とは, ただのリストのmap関数だということになります. 上記の定義では, 対象についての対応関係を考えていないように見えますが, 射$F(f)$が定義されれば, 自動的に対象同士の対応関係も定義されるということでしょう. というわけで, <b>任意の型Aのリスト/Map関数は, AからAのリストへの関手</b>だということになります(太字部分, 2016/05/02追記修正).<br />
1110. <br />
1111.  一般にmap関数は, リストだけのものでなく, 木構造へ応用できます. 例えば, 2分木について, 木構造の各要素に関数fを適用するmap関数は容易に想像できます.<br />
1112. <br />
1113. data BTree a = Leaf a | Fork (BTree a) (BTree a) deriving Show<br />
1114. <br />
1115. を考えることにして,<br />
1116. <br />
1117. instance Functor BTree where<br />
1118.   fmap f (Leaf a) = Leaf (f a)<br />
1119.   fmap f (Fork a b) = Fork (fmap f a) (fmap f b)<br />
1120. <br />
1121.  タプルのリストで, 二番目の要素のみへの関数適用を考えるなら,<br />
1122. <br />
1123. data TList a b = Nil | Cons a b (TList a b)<br />
1124. <br />
1125. instance Functor (TList a) where<br />
1126.   fmap f Nil = Nil<br />
1127.   fmap f (Cons a b rest) = Cons a (f b) (fmap f rest)<br />
1128. <br />
1129. とすれば, Functorのインスタンスとして具体的な関数が実装でき, 関手が定義できる流れになります. 代数的データ型なら, (fmap f) $= F(f)$の対応について, 自由に考えることが可能です. 関手というと身構えてしまいますが, 関数型言語上では, 単なる高階関数として表されることがわかります.<br />
1130. <br />
1131. <h4>
1132. 自然変換とHaskell上の関数</h4>
1133. <br />
1134.  関手$F, G$における自然変換$\mu$は, 関手$F, G : X \rightarrow Y$について, $\mu \circ F(f) = G(f) \circ \mu$を成り立たせるもの. というわけで, 可換図式を考えると,<br />
1135. $$\begin{CD}
1136. F(A) @>{F(f)}>> F(B)\\
1137. @V{\mu_A}VV @V{\mu_B}VV \\
1138. G(A) @>{G(f)}>> G(B) \end{CD}$$<br />
1139.  となります(上図 : 2016/05/18修正). 前述の条件を満たしていることがわかります. 自然変換の概念は, 2つの関手$F, G : X \rightarrow Y$の移した先の対応$\mu : F \dot{\rightarrow} G$を定義するものですが, $\mu \circ F(f)$のルートと, $G(f) \circ \mu$のルートの結果(計算)を同一にするものと考えると, わかりやすいですね. ちなみに, 上記の可換図式の個々の$\mu_A , \mu_B$は, 別の射(関数)である場合もあり, 個々の射は, 自然変換のコンポーネントと呼ばれるそうです.<br />
1140. <br />
1141.  問題は, この自然変換を表すプログラム上の関数とは何かということです. 調べたら, 以下に例がありました.<br />
1142. <br />
1143.  <a href="https://wiki.haskell.org/Category_theory/Natural_transformation">Category theory/Natural transformation - Haskell Wiki</a><br />
1144. <br />
1145.  前述のデータ型BTreeとリスト([])で書くとすれば, 自然変換 $\mu :$ (BTree a) $\rightarrow$ [a]の自然変換とは, 例えば,<br />
1146. <br />
1147. flatten2List :: (BTree a) -> [a]<br />
1148. flatten2List (Leaf a) = [a]<br />
1149. flatten2List (Fork a b) = (flatten2List a) ++ (flatten2List b)<br />
1150. <div>
1151. <br /></div>
1152.  になりそうです.<br />
1153.  可換図式の主張する合成規則$\mu \circ F(f) = G(f) \circ \mu$は,<br />
1154. <br />
1155. ((flatten2List . fmap f) = (map f . flatten2List)<br />
1156. <br />
1157.  が成立するはず. あまりにシンプルですね. ただのキャストに相当する(?)何かになりました.<br />
1158. <br />
1159.  さらに自然変換$\mu$には, 別の自然変換$\eta$との垂直合成$\eta \circ \mu$を考えることも可能です. 前述の可換図式に下にもうひとつ自然変換をくっつけた形で, 以下のようになります.<br />
1160. $$\begin{CD} F(A) @>{F(f)}>> F(B)\\ @V{\mu_A}VV @V{\mu_B}VV \\ G(A) @>{G(f)}>> G(B) \\ @V{\eta_A}VV @V{\eta_B}VV \\ H(A) @>{H(f)}>> H(B) \end{CD} $$<br />
1161. <br />
1162.  関手fmapの実装として, Maybeについて考えると,<br />
1163. <br />
1164. data Maybe x = Nothing | Just x deriving Show<br />
1165. <br />
1166. instance Functor Maybe where<br />
1167.   fmap f Nothing = Nothing<br />
1168.   fmap f (Just x) = Just (f x)<br />
1169. <br />
1170. と定義することができて, この時の自然変換$\eta : $[a]$ \rightarrow$ (Maybe a)を考えれば,<br />
1171. <br />
1172. list2Maybe :: [a] -> (Maybe a)<br />
1173. list2Maybe [] = Nothing<br />
1174. list2Maybe (x:xs) = (Just x)<br />
1175. <br />
1176. となると思います. この時の, $\eta \circ \mu$による自然変換の垂直合成は,<br />
1177. <br />
1178. (list2Maybe . flatten2List)<br />
1179. <br />
1180. となり, 可換図式を満たすなら,<br />
1181. <br />
1182. ((list2Maybe . flatten2List . fmap f)<br />
1183. = (list2Maybe . map f . flatten2List)<br />
1184. <div>
1185. = (fmap f . list2Maybe . flatten2List)</div>
1186. <div>
1187. <br /></div>
1188. <div>
1189. となるはずです.</div>
1190. <br />
1191. <b>参考文献</b><br />
1192. <ul>
1193. <li>ループ書いたら負けかなと思っている : <a href="https://www.yumpu.com/ro/document/view/11416939/-/37">https://www.yumpu.com/ro/document/view/11416939/-/37</a></li>
1194. <li>S. マクレーン, 圏論の基礎, 三好 博之 (翻訳), 高木 理 (翻訳),  丸善 </li>
1195. </ul>
1196. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/8832832504925058437/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=8832832504925058437&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8832832504925058437'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8832832504925058437'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/07/haskell.html' title='関手, 自然変換とHaskell'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-8283018249226062562</id><published>2015-05-29T18:03:00.000+09:00</published><updated>2015-05-30T21:23:23.883+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Lisp"/><title type='text'>Lispの新しい方言をいくつか</title><content type='html'>&lt;div style=&quot;text-align: left;&quot;&gt;
1197.  Lispといえば方言ですが, 新しい(2000年以降に登場した)方言がたくさんあって, 覚えきれないのでメモ.</div>
1198. <div style="text-align: left;">
1199. <br /></div>
1200. <div style="text-align: center;">
1201. <a href="http://qiita.com/na7vasconcelos/items/b540035a87f2068432c0">LEF(Lisp Flavored Erlang)ハジメマシタ #0 - Hello World - Qiita</a></div>
1202. <br />
1203.  によれば, ErlangVM上で動くLisp, <a href="http://lfe.io/">LFE</a>という方言があるそうです. 最初に登場したのは, 2008年なのだそうで, 2007年に登場したClojureとは一年違いです.<br />
1204. <br />
1205.  英語版のWikipediaのLispの記事を見ると,<br />
1206. <blockquote class="tr_bq">
1207. <span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">There are several new dialects of Lisp: </span><a class="mw-redirect" href="http://en.wikipedia.org/wiki/Arc_(programming_language)" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Arc (programming language)">Arc</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">, </span><a href="http://en.wikipedia.org/wiki/Hy" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Hy">Hy</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">, </span><a href="http://en.wikipedia.org/wiki/Nu_(programming_language)" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Nu (programming language)">Nu</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">, </span><a href="http://en.wikipedia.org/wiki/Clojure" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Clojure">Clojure</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">, </span><a class="new" href="http://en.wikipedia.org/w/index.php?title=Liskell&action=edit&redlink=1" style="background: none rgb(255, 255, 255); color: #a55858; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Liskell (page does not exist)">Liskell</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">, </span><a href="http://en.wikipedia.org/wiki/LFE_(programming_language)" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="LFE (programming language)">LFE</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;"> (Lisp Flavored Erlang) and </span><a href="http://en.wikipedia.org/wiki/Racket_(programming_language)" style="background: none rgb(255, 255, 255); color: #0b0080; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px; text-decoration: none;" title="Racket (programming language)">Racket</a><span style="background-color: white; color: #252525; font-family: sans-serif; font-size: 14px; line-height: 22.3999996185303px;">.</span></blockquote>
1208. とあり,  Common Lisp, Emacs Lisp, Scheme, Clojure以外にも様々な方言が存在しています.<br />
1209. <br />
1210.  Arcは, 特徴はいまいちよくわかりませんが, <a href="http://ja.wikipedia.org/wiki/%E3%83%9D%E3%83%BC%E3%83%AB%E3%83%BB%E3%82%B0%E3%83%AC%E3%82%A2%E3%83%A0">Paul Graham</a>による方言とその実装. Hyは, PythonVM上で動作するLispで前に<a href="http://uid0130.blogspot.jp/2015/01/hylang-lisppython.html">記事</a>を書きました. Nuは, Objective-Cで書かれていて, MacOSXのアプリケーション向けのスクリプト言語で, Semantics的にはLispよりもRubyに近いそう. Liskellは, 名前からなんとなく想像がつきますが, HaskellのSyntaxをLisp風にしたものです. <strike>しかし, 実装は見当たらず, ネット上には論文しか落ちていません.</strike> (追記 : Rudolph Miller さんに<a href="https://github.com/haskell-lisp/liskell">GitHub</a>に実装があると教えていただきました.) Racketは, もともとSchemeの処理系の一種でしたが, RnRS(Schemeの仕様書)から独立してRacketという言語になったものです.<br />
1211. <br />
1212.  他にも調べると色々出てきました. どうやら, VM+Lispという組み合わせ(Clojure, Hy, LFE)が多いようなので, Luaで調べてみると, <a href="http://leafo.net/moonlisp/">Moonlisp</a>というのがでてきましたが, これは, Luaのコード(VMのバイトコードなどではなく, 言語としてのLuaのコード)へコンパイルされるもののようです. CLR(.NET)では, L#, JavaScriptでは多すぎて調べきれませんが, <a href="http://ceaude.twoticketsplease.de/js-lisps.html">ここ(JavaScript Lisp Implementations)</a>に, そのリストがあります.<br />
1213. <br />
1214. &amp;nbsp;また,&amp;nbsp;&lt;a href=&quot;http://www.egison.org/&quot;&gt;Egison&lt;/a&gt;というパターンマッチに重点をおいた方言がありますが. このあたりは, &lt;a href=&quot;http://www.geidai.ac.jp/~marui/clojure/rationale/&quot;&gt;パターンマッチに否定的な&lt;/a&gt;Clojureとは対照的かもしれません.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/8283018249226062562/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=8283018249226062562&amp;isPopup=true' title='2 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8283018249226062562'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8283018249226062562'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/05/lisp.html' title='Lispの新しい方言をいくつか'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>2</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-2448772388678997024</id><published>2015-05-27T23:42:00.000+09:00</published><updated>2015-05-28T23:28:13.186+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="Clojure.core.logic"/><category scheme="http://www.blogger.com/atom/ns#" term="パズル"/><title type='text'>Clojure.core.logicでレイトン教授の問題を解く</title><content type='html'>&amp;nbsp;&lt;a href=&quot;http://alloy.mit.edu/alloy/&quot;&gt;Alloy Analyzer&lt;/a&gt;について教えてもらった時, Alloyなら, なぞなぞを解けるという話になって, でもそれってPrologでもほとんど同じことができるんじゃないかと思ったのですが, とりあえず, 以下のページにAlloyのなぞなぞSolverの実装があります.&lt;br /&gt;
1215. <br />
1216. <div style="text-align: center;">
1217. <a href="http://d.hatena.ne.jp/osiire/20110829">レイトン教授で始める Alloy Analyzer入門 - まあ、そんなもんでしょう</a>。</div>
1218. <br />
1219.  Prologで同じ問題を解いてみようと思ったのですが, ほとんど書いたことのないPrologで一からやるより, 身近なClojureでやってみたほうが簡単だろうと思って, Clojure.core.logicを使って, 上記のページの問題を1問解いてみました.<br />
1220. <br />
1221. <div style="text-align: center;">
1222. <a href="https://github.com/clojure/core.logic">clojure.core.logic - GitHub</a></div>
1223. <br />
1224.  Clojure.core.logicは, Clojureの論理プログラミング用のライブラリで, 主な使い方は, 以下のページに載っています.<br />
1225. <br />
1226. <div style="text-align: center;">
1227. <a href="http://qiita.com/nobkz/items/5ded7fa9333abdc7ddb7">core logicで論理プログラミングとかやってみた。 - Qiita</a></div>
1228. <br />
1229.  解いたのは, レイトン教授のNo.50の問題で,<br />
1230. <br />
1231.  牛が5頭(それぞれa～eとする)いて, うち, 3頭は, ウソしか言わない種であり, 残りの2頭は, ホントのことしか言わない種であるそうです. このとき, 各牛は, 次のように発言しています.<br />
1232. <br />
1233. a : dはウソをついている.<br />
1234. b : cはウソをついている.<br />
1235. c : aはウソをついていない.<br />
1236. d : eはウソをついている.<br />
1237. e : bはウソをついている.<br />
1238. <br />
1239.  さて, このとき, 嘘をついているのは誰でしょうという問題.<br />
1240. <br />
1241.  というわけで, 小学生の頃よくやった推理算ですが, 元の記事では, この問題をAlloyを使ってコンピュータに考えさせようという話でした.<br />
1242. <br />
1243.  core.logicで書くとAlloyで書いた場合よりも少し冗長になっている気がしました(マクロを駆使すれば解決できるのでしょうが/また, 書きなれていないことも原因かもしれません).<br />
1244. <br />
1245.  core.logicのオペレータは非常にシンプルで, ==, conde, fresh, consoが主でした. それぞれ, 同値であるという述語, 条件分岐, 変数の束縛, リストの構築を表す述語(?)です.run*でUnificationを実行し, 各変数のmost general unifier(最も一般化された単一子, 要するに述語を満たすような最も抽象的な値)を求めます. 結果は, 束縛した変数に対応する値のリストとして返されます. 答えの候補が複数ある場合は, 一つの変数に対して, リストが返ってきます. run*の次のシンボルのベクタが, 求めたい変数のリストで, その後ろのS式が, 制約条件となります.<br />
1246. <br />
1247.  問題の発言を述語にするのは, 簡単で, 「aがdはウソをついている」 という発言は, 「a = "正直"かつb = "嘘つき"」または, 「a = "嘘つき"かつb = "正直"」といった感じで, 発言者について場合分けすれば, きれいに分解できます. もっともAlloyのコードでは, 逆のパターンの記述はする必要がないようですが.<br />
1248. <br />
1249.  5頭のうち, 2頭が正直であるという条件の制約の定義は手間取りました. もう少し, 上手い書き方があるような気がするのですが... 以下のソースコードのhonest-cows-inという関数がそれに相当します. しかし, このような書き方が適切なのかよくわかっていません.<br />
1250. <br />
1251. 以下がソースコード.<br />
1252. <pre class="prettyprint lang-clj">(use 'clojure.core.logic)
1253.  
1254. (defn honest-cows-in [ls n]
1255.  (fresh [xs]
1256.    (conde
1257.     [(== ls []) (== n 0)]
1258.     [(conso 'honest xs ls)
1259.      (honest-cows-in xs (dec n))]
1260.     [(conso 'liar xs ls)
1261.      (honest-cows-in xs n)])))
1262.  
1263. (defn layton50 []
1264.  (run* [a b c d e]
1265.     (fresh [ls]
1266.       (conso a [b c d e] ls)
1267.       (honest-cows-in ls 2))
1268.     ;; A said D is a liar. (A is honest and D is liar) or (A is liar and D is honest).
1269.     (conde [(== a 'honest) (== d 'liar)]  [(== a 'liar) (== d 'honest)])
1270.     ;; B said C is a liar.
1271.     (conde [(== b 'honest) (== c 'liar)]  [(== b 'liar) (== c 'honest)])
1272.     ;; C said A is honest.
1273.     (conde [(== c 'honest) (== a 'honest)]  [(== c 'liar) (== a 'liar)])
1274.     ;; D said E is a liar.
1275.     (conde [(== d 'honest) (== e 'liar)]  [(== d 'liar) (== e 'honest)])
1276.     ;; E said B is a liar.
1277.     (conde [(== e 'honest) (== b 'liar)]  [(== e 'liar) (== b 'honest)])))</pre>
1278. 実行してみると,
1279. <br />
1280. <pre class="prettyprint lang-clj">user> (layton50)
1281. ([liar honest liar honest liar])</pre>
1282. &amp;nbsp;それぞれ, run*で束縛した[a b c d e]という各牛のパラメータで, aとc, eが嘘つきだということが判明しました. というわけで, 答えは出ましたが, 正解かどうかは知りません. 少なくとも, clojure.core.logicでなぞなぞSolverは記述できるようです.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/2448772388678997024/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=2448772388678997024&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2448772388678997024'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/2448772388678997024'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/05/clojurecorelogic.html' title='Clojure.core.logicでレイトン教授の問題を解く'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-4157442573098786903</id><published>2015-04-20T15:15:00.000+09:00</published><updated>2015-11-20T08:02:15.517+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="単純パーセプトロン"/><category scheme="http://www.blogger.com/atom/ns#" term="機械学習"/><title type='text'>Clojureで単純パーセプトロンを書いてみた.</title><content type='html'>&amp;nbsp;機械学習を学習しているので, とりあえず, 単純パーセプトロンを書いてみました. 理論と比べると, 実装は非常に簡単(というかシンプル)でした.&lt;br /&gt;
1283. <br />
1284.  機械学習系のアルゴリズムは, immutableなClojure向きではないような気もしますが, 単純パーセプトロンなら, 大量の配列のupdateの作業がないので, 大丈夫でした.<br />
1285. <br />
1286.  参考文献は, 以下のブログ中のスライド.<br />
1287. <br />
1288. <a href="http://tjo.hatenablog.com/entry/2013/05/01/190247">単純パーセプトロンをPythonで組んでみる - 銀座で働くデータサイエンティストのブログ</a><br />
1289. <br />
1290.  単純パーセプトロンは, 線形分離可能な分類問題において, 識別関数を求めるアルゴリズムです.<br />
1291. <br />
1292.  求める分離関数を g(<b>x</b>) = <b>w</b> . <b>x </b>+ bとすると, アルゴリズムとしては(参考文献のスライドにもありますが),<br />
1293. R = max<sub>i</sub>(||<b>x</b><sub>i</sub>||)<br />
1294. repeat<br />
1295.   modified? ← false  for i = 0 to (サンプルの総数) - 1 do<br />
1296. <div>
1297.     if (label<sub>i</sub> * (<b>w</b> . <b>x</b><sub>i</sub>) + b < 0) then<br />
1298.       modified? ← true<br />
1299.       <b>w</b> ← <b>w</b> + ((学習係数) * label<sub>i</sub>) <b>x</b><sub>i</sub><br />
1300.       b ← b + (学習係数) * label<sub>i</sub> * R<br />
1301.     end if<br />
1302.   end for<br />
1303. until (<b>not</b> modified? or ループ上限に達する.)<br />
1304. <br />
1305. <b>x</b><sub>i</sub> : i番目のサンプル(教師データ)を表すベクトル(2次元なら(x, y)など)<br />
1306. label<sub>i</sub> : i番目のサンプルのラベル(どちらのクラスタに属するか, -1 or 1)<br />
1307. (学習係数) : 1未満の値<br />
1308. <br />
1309.  で良いようです.<br />
1310. (2014/11/20 : modified?と終了判定が間違っていたので修正)<br />
1311. <div>
1312. <br /></div>
1313.  ソースコードは以下のようになりました.(incanterを使ってます.)
1314. <script src="https://gist.github.com/uid0130/95ac77a8427c8e6698be.js"></script>
1315.  というわけで, 実行してみると, 以下のようになりました.</div>
1316. <br />
1317. <div class="separator" style="clear: both; text-align: center;">
1318. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhNakN5kFgcHrA507t2RbVUaXPtGCC8cY143OEN8dhLdF2cuxTsox9fMMNaDVDnI4IRFcil0VjRKyz1aBk_w6sRUQUzYjrEZ5Omzkpfja_-a2o0P7XfdNw2K4LrrtHh5Acd0HDqKQ4YjDM/s1600/Screenshot_from_2015-04-20+14:21:56.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="254" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhNakN5kFgcHrA507t2RbVUaXPtGCC8cY143OEN8dhLdF2cuxTsox9fMMNaDVDnI4IRFcil0VjRKyz1aBk_w6sRUQUzYjrEZ5Omzkpfja_-a2o0P7XfdNw2K4LrrtHh5Acd0HDqKQ4YjDM/s1600/Screenshot_from_2015-04-20+14:21:56.png" width="320" /></a></div>
1319. &lt;br /&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/4157442573098786903/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=4157442573098786903&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4157442573098786903'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4157442573098786903'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/04/clojure.html' title='Clojureで単純パーセプトロンを書いてみた.'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhNakN5kFgcHrA507t2RbVUaXPtGCC8cY143OEN8dhLdF2cuxTsox9fMMNaDVDnI4IRFcil0VjRKyz1aBk_w6sRUQUzYjrEZ5Omzkpfja_-a2o0P7XfdNw2K4LrrtHh5Acd0HDqKQ4YjDM/s72-c/Screenshot_from_2015-04-20+14:21:56.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-592165994390386349</id><published>2015-03-24T14:49:00.000+09:00</published><updated>2015-03-24T14:49:03.221+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><title type='text'>Clojureのdefun, パターンマッチ付きの関数定義</title><content type='html'>&amp;nbsp;defunというと, Common LispやEmacs Lispの関数定義を連想しますが, Clojureでもdefunを使って関数定義ができるようです. さっき, 偶然発見したのですが.&lt;br /&gt;
1320. <div style="text-align: center;">
1321. <a href="https://github.com/killme2008/defun">killme2008/defun - GitHub</a></div>
1322. <br />
1323.  このdefun, Clojureの普通の関数定義であるdefnとの違いは, パターンマッチ付きの関数定義ができることです. GitHub中の説明には,<br />
1324. <blockquote class="tr_bq">
1325. A macro to define clojure functions with parameter pattern matching just like erlang or elixir.</blockquote>
1326.  とあります.<br />
1327. <br />
1328.  Clojureのパターンマッチングといえば, <a href="https://github.com/clojure/core.match">core.match</a>かdefmulti/defmethodのマルチディスパッチですが, 関数の引数に対して, そのままパターンを記述できるので, defn+matchの組み合わせよりもシンプルになります.<br />
1329. <br />
1330.  .lein/profile.clj (or project.clj)の:pluginsに<span style="background-color: #f7f7f7; color: #333333; font-family: Consolas, 'Liberation Mono', Menlo, Courier, monospace; font-size: 13.6000003814697px; line-height: 1.45;">[</span><span class="pl-k" style="box-sizing: border-box; color: #a71d5d; font-family: Consolas, 'Liberation Mono', Menlo, Courier, monospace; font-size: 13.6000003814697px; line-height: 1.45;">defun</span><span style="background-color: #f7f7f7; color: #333333; font-family: Consolas, 'Liberation Mono', Menlo, Courier, monospace; font-size: 13.6000003814697px; line-height: 1.45;"> </span><span class="pl-s" style="box-sizing: border-box; color: #183691; font-family: Consolas, 'Liberation Mono', Menlo, Courier, monospace; font-size: 13.6000003814697px; line-height: 1.45;"><span class="pl-pds" style="box-sizing: border-box;">"</span>0.2.0-RC<span class="pl-pds" style="box-sizing: border-box;">"</span></span><span style="background-color: #f7f7f7; color: #333333; font-family: Consolas, 'Liberation Mono', Menlo, Courier, monospace; font-size: 13.6000003814697px; line-height: 1.45;">]</span>を追加してとりあえず, quicksortもどきを書いてみると,<br />
1331.  core.match版<br />
1332. <pre class="prettyprint lang-clj">(use '[clojure.core.match :refer [match]])
1333.  
1334. (defn quicksort1 [ls]
1335.  (match ls
1336.   ([] :seq) []
1337.   ([x & xs] :seq)
1338.   (concat (quicksort1 (filter #(< % x) xs))
1339.           [x] (quicksort1 (filter #(>= % x) xs)))))</pre>
1340.  と, defun版<br />
1341. <pre class="prettyprint lang-clj">(use '[defun :only [defun]])
1342.  
1343. (defun quicksort2
1344.  ([([] :seq)] [])
1345.  ([([x & xs] :seq)]
1346.   (concat (quicksort2 (filter #(< % x) xs))
1347.           [x] (quicksort2 (filter #(>= % x) xs)))))</pre>
1348.  余分なシンボルが減り, 括弧だけになってすっきりした印象になりました. matchの一旦変数を定義して, それをそのままmatchマクロに渡すという処理がなくなり1行分減り, 変数名が一つ減っています. しかし, 括弧は, 条件一つにつき, 2ペア増えてしまいました. どうやら, この括弧は(大括弧, 小括弧ともに)外せないようです.
1349. <br />
1350. <pre class="prettyprint lang-clj">(defun sum
1351.  ([0 m] m)
1352.  ([n m] (recur (dec n) (+ n m))))</pre>
1353. こんな感じで, recurが内臓させることも可能なようで, loop-recurの省略にも使えます.<br />
1354. <br />
1355. &amp;nbsp;パターンやガードの記述は, core.matchと同じ(というかcore.matchそのもの)なので, core.matchを使う要領で定義できます.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/592165994390386349/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=592165994390386349&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/592165994390386349'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/592165994390386349'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/03/clojuredefun.html' title='Clojureのdefun, パターンマッチ付きの関数定義'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-7288371216265654865</id><published>2015-03-05T18:38:00.000+09:00</published><updated>2015-03-05T18:38:58.909+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="リスト操作"/><title type='text'>doallで遅くなる(Clojure)</title><content type='html'>&amp;nbsp;mapなどリスト処理の間に, doallを間に挟むと, その分遅くなっているような気がしたので, 調べてみると, 確かにdoallを挟むことで実行時間が伸びています.&lt;br /&gt;
1356. <br />
1357.  副作用を考えない場合, 意味的にはidentityと同じなので, 忘れがちですが, しっかり計算コストとメモリ確保のためのコストがかかっているようです.<br />
1358. <br />
1359.  以下がその証拠. (Linux Mint 17 Cinnamon 64-bit, Intel Core i7-4790, メモリ : 31.4GB)<br />
1360. <pre class="prettyprint lang-clj">user> (defn dub [n] (* n 2))
1361. #'user/dub
1362. user> (time (reduce + (map inc (map dub (range 10000000)))))
1363. "Elapsed time: 1661.92639 msecs"
1364. 100000000000000
1365. user> (time (reduce + (map (comp inc dub) (range 10000000))))
1366. "Elapsed time: 1388.861015 msecs"
1367. 100000000000000
1368. user> (time (reduce + (map inc (doall (map dub (range 10000000))))))
1369. "Elapsed time: 1892.659523 msecs"
1370. 100000000000000
1371. user> (time (reduce + (map inc (map dub (range 1000000000)))))
1372. user> (time (reduce + (map inc (map dub (range 100000000)))))
1373. "Elapsed time: 15394.220163 msecs"
1374. 10000000000000000
1375. user> (time (reduce + (map (comp inc dub) (range 100000000))))
1376. "Elapsed time: 13912.628054 msecs"
1377. 10000000000000000
1378. user> (time (reduce + (map inc (doall (map dub (range 100000000))))))
1379. "Elapsed time: 54838.803745 msecs"
1380. 10000000000000000</pre>
1381.  一回目のトライは, 普通にmapを２回リストに適用した場合で1.6秒程度.<br />
1382. <br />
1383.  次にmap分配則を用いて2回分のmapを1回に縮めてみた場合. 若干, 早くなりました. Haskellだとこの最適化は, 効果的なのですが, Clojureではおそらくリストの実装上の違いによりあまり効果がないようです.<br />
1384. <br />
1385.  三行目が, 問題のdoallを挟んだリスト処理です. 通常のリスト操作と比べて0.2秒ほど, 遅くなっています. 遅くはなっていますが, 1.1倍程度です.<br />
1386. <br />
1387.  下三行の入力は, リストのサイズを大きくした(1ケタ上げた)場合. map分配則による変換の効果の割合はリストサイズが10分の1以下の時と変わらないようです.<br />
1388. <br />
1389.  一方で, doallを挟んだ場合は, 3倍以上の時間がかかっています. 与えられたリストのサイズに対して実行時間が線形に増加していないのは, メモリ確保に時間がかかっていることが原因だと思われます.<br />
1390. <br />
1391. &amp;nbsp;ちなみに, 上記のreplのプロセスが終了すると約5.5GiBのメモリ領域が開放されました. というわけで, メモリサイズがシビアなノートPCとかだと, (GCなどに)よりその影響が顕著に出てくるかもしれません.</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/7288371216265654865/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=7288371216265654865&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7288371216265654865'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7288371216265654865'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/03/doallclojure.html' title='doallで遅くなる(Clojure)'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-4249011095549604567</id><published>2015-02-18T04:46:00.000+09:00</published><updated>2015-02-18T04:46:41.762+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Python"/><category scheme="http://www.blogger.com/atom/ns#" term="オブジェクト指向"/><title type='text'>継承は必ずしもis-a関係ではない(OOP) - Inheritance is not subtyping問題</title><content type='html'>「&lt;a href=&quot;http://dl.acm.org/citation.cfm?id=96721&amp;amp;dl=ACM&amp;amp;coll=DL&amp;amp;CFID=479218329&amp;amp;CFTOKEN=51151198&quot;&gt;Inheritance is not subtyping&lt;/a&gt;」は, Cookらによる1989年の論文で, そのままですが, オブジェクト指向における継承≠派生型(is-aの関係)ということのようです.&lt;br /&gt;
1392. <br />
1393.  派生型(Subtyping)については, <a href="http://ja.wikipedia.org/wiki/Is-a">is-a - Wikipedia</a>にその説明が載っていますが, 確かにここでも, 継承が必ずis-a関係を構築するとは書かれてはいません.<br />
1394. <br />
1395.  <a href="http://itpro.nikkeibp.co.jp/article/COLUMN/20061107/252787/">数理科学的バグ撲滅方法論のすすめ - 第4回　関数型言語とオブジェクト指向，およびOCamlの"O"について - ITpro</a> に, その反例を示したソースコードがありますが, OCamlなのであまり実感わきません. オブジェクト指向言語は, JavaかPythonくらいしか使ったことがないので, Pythonでとりあえず書き直してみました.<br />
1396. <br />
1397.  Pointクラスを継承したColoredPointクラス.<br />
1398. <pre class="prettyprint lang-py">class Point:
1399.    def __init__(self, x, y):
1400.        self.x = x
1401.        self.y = y
1402.    def equals(self, another):
1403.        return self.x == another.x and self.y == another.y
1404.  
1405. class ColoredPoint(Point):
1406.    def __init__(self, x, y, c):
1407.        self.x = x
1408.        self.y = y
1409.        self.c = c
1410.    def equals(self, another):
1411.        xeq = self.x == another.x
1412.        yeq = self.y == another.y
1413.        ceq = self.c == another.c
1414.        return xeq and yeq and ceq</pre>
1415.  この例では, 確かにPointクラスが継承されていますが, equalsがオーバーライドされています. 一方で, Pointクラス間ではequals関数で比較できるように実装されています.<br />
1416. <br />
1417.  PointクラスとColoredPointクラスのインスタンスがis-a関係ならば, 当然, Pointクラスのインスタンス⇔ColoredPointクラスのインスタンス間で, インスタンスのequalityの比較が可能なはずです.<br />
1418. <pre class="prettyprint lang-py">>>> ColoredPoint(1,2,3).equals(ColoredPoint(1,2,3))
1419. True
1420. >>> ColoredPoint(1,2,3).equals(Point(1,2))
1421. Traceback (most recent call last):
1422.  File "<stdin>", line 1, in <module>
1423.  File "notisa.py", line 16, in equals
1424.    ceq = self.c == another.c
1425. AttributeError: Point instance has no attribute 'c'
1426. </module></stdin></pre>
1427.  で, 比較してみると, エラーが発生する. という現象が反例としてあげられるため, 継承≠is-aということのようです.<br />
1428. <br />
1429.  面白いのは, 継承しなくても, is-aの関係が成立してしまうケースが存在することで, 次のFruitとOarngeクラスの例が考えられます.<br />
1430. <pre class="prettyprint lang-py">class Fruit:
1431.    def __init__(self, price):
1432.        self.price = price
1433.    def equals(self, another):
1434.        return self.price == another.price
1435.  
1436. class Orange:
1437.    def __init__(self, price):
1438.        self.price = price
1439.    def equals(self, another):
1440.        return self.price == another.price</pre>
1441. 厳密な意味(?)でis-a関係が成立しているわけではないですが, equalsによる比較ができてしまい, 一種の部分型(is-a関係)のような振る舞いが可能になります. OCamlなどでは, この辺を型推論により自動的に型付けしてくれるようで, このような型を構造的部分型(structual subtyping)と呼ぶようです(&lt;a href=&quot;http://itpro.nikkeibp.co.jp/article/COLUMN/20061107/252787/&quot;&gt;前述のITProの記事より&lt;/a&gt;).</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/4249011095549604567/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=4249011095549604567&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4249011095549604567'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4249011095549604567'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/02/is-aoop-inheritance-is-not-subtyping.html' title='継承は必ずしもis-a関係ではない(OOP) - Inheritance is not subtyping問題'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-131972025238215770</id><published>2015-02-14T06:39:00.000+09:00</published><updated>2015-02-15T05:28:00.015+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="quil"/><title type='text'>quilを使って巡回セールスマン問題の解の経路を表示する(Clojure) + 矢印の表示</title><content type='html'>&lt;div style=&quot;text-align: center;&quot;&gt;&lt;a href=&quot;https://github.com/quil/quil&quot;&gt;quil (Git Hub)&lt;/a&gt;&lt;/div&gt;&lt;div style=&quot;text-align: center;&quot;&gt;&lt;br /&gt;
1442. </div> は, ProcessingのClojureラッパーです. グラフィック系のライブラリで, Clojureから, ProcessingのAPI(メソッド等)を簡単に触ることができます. もともと, Processing自体が非プログラマを対象としたヴィジュアルアート向きの, Javaベースのプログラミング言語なので, その機能をClojureで使えるようにしてくれます. Clojure/Swingでやるには少し煩雑なグラフィック処理を, Processing風の書き方で書くことができます. マウスやキーボードの情報の取得も可能なので, ゲームも作れそうです.  以下がAPI(関数)の一覧.<br />
1443. <div style="text-align: center;"><br />
1444. </div><div style="text-align: center;"><a href="http://quil.info/api">http://quil.info/api</a></div><br />
1445.  少し前に, 巡回セールスマン問題を遺伝的アルゴリズムを使って解いたのですが, その時の解(となる経路)の可視化がいまいちだったので, quilを使ってやり直してみました. もともとは, Processing同様, quilも 次の<a href="http://quil.info/" style="text-align: center;">quil.info</a>にあるようなヴィジュアルアートを作成することを目的としているようですが, 容易に絵が描かけるという点には変わりありません.<br />
1446. <br />
1447.  ちなみに, quilのコードを記述する部分はほぼ100%(?)手続き型言語風の書き方になります. map等でループを書くことはできますが.<br />
1448. <br />
1449.  他のClojureのプラグイン同様, プロジェクトを作成しているなら, project.cljの :dependenciesに[quil "2.2.5"]を追加(quilでは試していないため保証はできませんが, 一応これ) でOKのはずです.<br />
1450.  lein repl 単体ならば, "~/.lein/profiles.clj" (または, それに相当するファイル)の:pluginsに対応するリストへ  [quil "2.2.5"] を加えれば利用できるようになります.<br />
1451. <br />
1452.  実際にプロットさせると次のようになりました. (ソースコードは一番下)<br />
1453. <div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhjU15QYcvqGs_8rcj09CD1h5o_8_JHD2URct8VegHrhPIZ5-TqAKUaTf92XbQszbL0Gh044Gu4fRGRV1Tpx6MAutitWqiGQOUnrT_70Oj3LgdJ-TG9gBW0N2Sx0-Hvs4BHGHhbUXf8kM0/s1600/routes.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhjU15QYcvqGs_8rcj09CD1h5o_8_JHD2URct8VegHrhPIZ5-TqAKUaTf92XbQszbL0Gh044Gu4fRGRV1Tpx6MAutitWqiGQOUnrT_70Oj3LgdJ-TG9gBW0N2Sx0-Hvs4BHGHhbUXf8kM0/s1600/routes.png" height="320" width="305" /></a></div><br />
1454.  上記の表示は,<br />
1455. <pre class="prettyprint lang-clj">(def sample-points
1456.  {:a [20 70] :b [30 20] :c [50 50] :d [60 55] :e [40 30]
1457.   :f [20 50] :g [80 60] :h [10 30] :i [65 10] :j [40 80]})</pre>のようなXY上に点がばらついているときに, 次のような解が生成された時に, 表示されるルートです.<br />
1458. <pre class="prettyprint lang-clj">(def route [:a :f :j :d :g :i :c :e :b :h])</pre> 単に線を引いて, 丸を描いて, 文字を打ち込んでいるだけです. なので非常に簡単でした. しかし, Swingではなく, quil独特(Processing特有?)の関数名がいくつかあり, 目的の関数を探すのに時間がかかりました.<br />
1459. <br />
1460.  API一覧はあるのですが, 例えば, 丸を描く関数名がellipseだったり(SwingだとfillOvalとかですが), その丸を描く関数を使うときに円の内側の色を指定する関数名が, fillだったりします. 線の太さは, stroke-weightで設定します.<br />
1461. <br />
1462.  一方で, Processingのラッパーだけあっって, ネット上にあるProcessingのサンプルをClojure/quilに読み替えれば, 様々なことができるので, その点は非常に良い点です. quilのAPI一覧を見てよくわからない場合は, ProcessingのAPIやサンプルを見れば良いわけですから.<br />
1463. <br />
1464.  ウィンドウのみを表示させたければ, 次のように書けます.<br />
1465. <pre class="prettyprint lang-clj">user> (require '[quil.core :as q])
1466. nil
1467. user> (q/defsketch skt2)
1468. #'user/skt2</pre>という形で表示できます. このdefsketch関数のオプションで, 描画の設定等を行います.<br />
1469. <pre class="prettyprint lang-clj">(defn plot-route []
1470.  (q/defsketch skt1
1471.    :title "routes"
1472.    :setup (fn [] (q/smooth)) ;; anti-aliased
1473.    :draw (draw-route sample-points route)
1474.    :size [400 400]))</pre>のようにdefsketchを定義します. タイトル等はオプションです. :setupは, ウィンドウ生成時に, 実行される関数, :drawは, 定期的に実行される関数ということでしょう. smooth関数でアンチエイリアスが指定できます. 上記の例を見ればわかるかとは思いますが, 滑らかな表示に切り替わります. :sizeのパラメータは, ウィンドウのサイズ.<br />
1475. <br />
1476.  こういう経路情報の表示で意外と面倒なのが, 矢印の表示です 点(x<sub>1</sub>, y<sub>1</sub>)と点(x<sub>2</sub>, y<sub>2</sub>)間に線を引いた時, 頂点の片方に矢印の三角形を付け加えて矢印にする作業です. そして, quilにも多分矢印を表示する関数は無かったと思います.<br />
1477. <br />
1478.  仮想的なXY空間を用意し, そこに矢印の先となる三角形を想定した3つの点をおいて, 回転行列/アフィン変換等で適当な角度に回転させます. 次にその3つの点に必要なdrawPolygonメソッド等で描画するというステップが必要になります.<br />
1479. <br />
1480.  色々ググって調べてみたのですが, Swing/Awtでは, やはり上記の手法が一般的なようでした. 回転の処理を直接書くのは面倒なのですが, Processingには, matrix stackというオブジェクトがあり, これを使うことで簡単に三角形のオブジェクトを回転させることができることができるそうです.<br />
1481. <br />
1482.  これで回転の処理の問題が解決したので, あとは与えられた座標から矢印の先端を表す三角形を回転させる角度がほしいのですが, これはatan(アークタンジェント)で解決します. しかし, ゼロ除算の問題でatanをそのまま使うよりも, atan2という(x, y)の値を渡すとその角度(単位はラジアン)を返してくれる関数の方が有用です. 知らなかったのですが, atan2は, Mayaの<a href="http://nomoreretake.blogspot.jp/2013/10/arctan22.html">MEL</a>や<a href="http://excel.ara3.net/func/atan2.htm">エクセル</a>とか, <a href="http://d.hatena.ne.jp/n-trino/20040827">C++</a>にも標準でついてくるような一般的な関数のようです.<br />
1483. <pre class="prettyprint lang-clj">(defn draw-arrow-head [xy1 xy2 top-mergin bot-mergin]
1484.      (let [x1 (first xy1) x2 (first xy2)
1485.            y1 (second xy1) y2 (second xy2)
1486.            size (+ 25 (- bot-mergin))]
1487.        (set-white)
1488.        (q/push-matrix)
1489.        (q/translate x1 y1)
1490.        (q/rotate (+ (q/radians 270) (q/atan2 (- y2 y1) (- x2 x1))))
1491.        (q/triangle 0 (+ top-mergin 0) 5 size -5 size)
1492.        (q/pop-matrix)))</pre>上記のような実装で, 矢印の頭の部分が書けます. 矢印の本体の線は, line関数で書けばよいので, 特に問題はないかと思います.<br />
1493. <br />
1494.  rotateは, 時計回りにオブジェクトを回転させるようです. GUIプログラミングではお馴染みですが, Y軸が反転しているので, その反転分の270度を足すことで, 全体として, 適切に傾いた矢印が描けます. 以下の図が参考.<br />
1495. <div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiKyCv1caWweG-6LOLY_p9ibiZF8tH6GC8Tn-Sa5ayJ-S3a5auHf09cynMOpFnYVdVbSFIy3sxSGGQBguzNGUUZZ8dKYhYn-Y3UVzAi9Y1autVlJwk9tcpOyvP9WmxYAZu5KFRG6wkMbB0/s1600/moveon.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiKyCv1caWweG-6LOLY_p9ibiZF8tH6GC8Tn-Sa5ayJ-S3a5auHf09cynMOpFnYVdVbSFIy3sxSGGQBguzNGUUZZ8dKYhYn-Y3UVzAi9Y1autVlJwk9tcpOyvP9WmxYAZu5KFRG6wkMbB0/s1600/moveon.PNG" height="196" width="320" /></a></div> atan2は, x軸に対する(x, y)座標の角度<i>θ</i>を返します. translateには, オブジェクトの原点に相当する点の位置を与えます. 矢印の三角形を原点から少し離しているのは, 原点のまわりに各点を表すノードを表す円(ellipse)を表示させるためです. こんな感じで, ノード間の矢印を表しました.<br />
1496. <br />
1497.  quilを使っていて少し困ったのは, エラーメッセージがreplに出力されないことです, 一度defsketchでオブジェクトを生成されてしまうと, :setup/:drawに指定した関数内で実行時エラーが発生した場合, エラーメッセージが出力されず, エラーが発生しているのかすら, 分かりませんでした. これはおそらく, defsketchを実行した時点で別プロセス(スレッド)でその処理が実行されるため, replのあるスレッド上ではエラーが発生していないことに由来するようですが, デバッグが大変なので, 対策を考える必要がありそうです.<br />
1498. <br />
1499.  全ソースコードは以下から.<br />
1500. <a href="https://gist.github.com/uid0130/c22aa4b422bf59973eb8">uid0130 / plot-graph.clj - Gist</a><br />
1501. <br />
1502. <b>参考文献</b><br />
1503. <ul><li><a href="https://processing.org/discourse/beta/num_1219607845.html">https://processing.org/discourse/beta/num_1219607845.html</a></li>
1504. <ul><li>Processingで矢印を描く.</li>
1505. &lt;/ul&gt;&lt;/ul&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/131972025238215770/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=131972025238215770&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/131972025238215770'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/131972025238215770'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/02/quilclojure.html' title='quilを使って巡回セールスマン問題の解の経路を表示する(Clojure) + 矢印の表示'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhjU15QYcvqGs_8rcj09CD1h5o_8_JHD2URct8VegHrhPIZ5-TqAKUaTf92XbQszbL0Gh044Gu4fRGRV1Tpx6MAutitWqiGQOUnrT_70Oj3LgdJ-TG9gBW0N2Sx0-Hvs4BHGHhbUXf8kM0/s72-c/routes.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-4597523461185830340</id><published>2015-02-10T20:13:00.000+09:00</published><updated>2015-02-10T20:13:42.914+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="Hylomorphism"/><category scheme="http://www.blogger.com/atom/ns#" term="nQueen問題"/><category scheme="http://www.blogger.com/atom/ns#" term="プログラム運算"/><category scheme="http://www.blogger.com/atom/ns#" term="リスト操作"/><title type='text'>ClojureでリストのHylomorphismの変換マクロ</title><content type='html'>&amp;nbsp;&lt;a href=&quot;http://uid0130.blogspot.jp/2014/12/clojureunfoldhylomorphism.html&quot;&gt;前に書いた記事(Clojureでunfoldとhylomorphism)&lt;/a&gt;&amp;nbsp;の続き.&lt;br /&gt;
1506. <div>
1507. <br /></div>
1508. <div>
1509.  上の記事では, ClojureにおいてList版のHylomorphismを中間のデータ構造を生成しない純粋な再帰呼び出しで書きなおすことで高速化しました. しかし, 可読性が最悪で, はっきりいって読めない...</div>
1510. <pre class="prettyprint lang-clj">(defn correct-answer? [arrangement]
1511.  (reduce andf
1512.    (map not-conflict?
1513.      (take-while first (iterate rest arrangement)))))
1514.  
1515. (defn correct-answer?-v2 [arrangement]
1516.  (hylol andf true #(not (first %)) not-conflict? rest arrangement))
1517. </pre>
1518.  上の関数が, リストを生成しながら計算するHylomorphism(に相当するもの), 下の関数が, リスト(中間のデータ構造)なしで同じ計算をするものです. (iterateで)リストを生成せずにプログラムが実行される分, 下の関数の方が高速であるという結果になったという話でした.<br />
1519. <br />
1520.  hylolとはどいういった関数かというと, 次のような関数です.<br />
1521. <pre class="prettyprint lang-clj">(defn hylol
1522.  [f e p g h b]
1523.  (if (p b)
1524.    e
1525.    (f (g b) (hylol2 f e p g h (h b)))))</pre>
1526.  ピカソの絵画ような抽象的な定義ですが, しかし抽象的であるがために, ある程度普遍性があります(様々なプログラムに出現する可能性が高いという意味です).<br />
1527. <br />
1528.  できれば可読性を維持したまま(つまり, reduceとかmapとかが書かれた状態のまま) Hylomorphismに相当するプログラムを純粋な再帰に変換したいですね. というわけで, 関数でhylolを実装するのではなく, マクロで実装すれば良いのでは? という結論に至りました.<br />
1529. <pre class="prettyprint lang-clj">(hylol-expand
1530.  (reduce + 0
1531.       (take-while (partial not= 0)
1532.                    (map dec (iterate dec 100)))))</pre>
1533. とか<br />
1534. <pre class="prettyprint lang-clj">(hylol-expand
1535. (->> (iterate dec 100)
1536.      (take-while (partial not= 0))
1537.      (reduce + 0)))</pre>
1538. みたいな書き方なら, 可読性に関しては問題ありません.<br />
1539. <br />
1540.  というわけで上記のような書き方を維持したまま, Hylomorphismを再帰呼び出しに書き戻すマクロを作ってみました. 以下がそのマクロの実装. hylol-formで展開後の構造を定義し, hylol-expandで記法のパターンマッチを行い, それに対応するマクロフォームに展開します. 素朴な実装なので, 特に柔軟性などはありません.<br />
1541. <pre class="prettyprint lang-clj">(use '[clojure.core.match :only (match)])
1542.  
1543. (defn hylol-form
1544.  "returns quoted hylol form"
1545.  ([f-in-reduce init-in-reduce pred use-map-option f-in-map
1546.   f-in-iterate init-in-iterate]
1547.     `(letfn [(~'f [~'b]
1548.                (if (~pred ~'b)
1549.                  (~f-in-reduce
1550.                   ~(if use-map-option (list f-in-map 'b) 'b)
1551.                   (~'f (~f-in-iterate ~'b)))
1552.                  ~init-in-reduce))]
1553.        (~'f ~init-in-iterate))))
1554.  
1555. (defmacro hylol-expand
1556.  "hylomorphism of lists without generating list"
1557.  [hylol-exp]
1558.  (match [hylol-exp]
1559.    [(['reduce f-in-reduce init-in-reduce ;; no map & natural
1560.       (['map f-in-map
1561.         (['take-while pred
1562.           (['iterate f-in-iterate init-in-iterate] :seq)]
1563.            :seq)] :seq)] :seq)]
1564.    (hylol-form f-in-reduce init-in-reduce pred true f-in-map
1565.                f-in-iterate init-in-iterate)
1566.    [(['reduce f-in-reduce init-in-reduce ;; no map & natural
1567.       (['take-while pred
1568.         (['iterate f-in-iterate init-in-iterate] :seq)]
1569.            :seq)] :seq)]
1570.    (hylol-form f-in-reduce init-in-reduce pred false nil
1571.                f-in-iterate init-in-iterate)
1572.    [(['->> (['iterate f-in-iterate init-in-iterate] :seq) ;; map & thread
1573.       (['take-while pred] :seq)
1574.       (['map f-in-map] :seq)
1575.       (['reduce f-in-reduce init-in-reduce] :seq)] :seq)]
1576.    (hylol-form f-in-reduce init-in-reduce pred true f-in-map
1577.                f-in-iterate init-in-iterate)
1578.    [(['->> (['iterate f-in-iterate init-in-iterate] :seq) ;; no map & thread
1579.       (['take-while pred] :seq)
1580.       (['reduce f-in-reduce init-in-reduce] :seq)] :seq)]
1581.    (hylol-form f-in-reduce init-in-reduce pred false nil
1582.                f-in-iterate init-in-iterate)
1583.     [the-other-cases]
1584.     (throw (Exception. (str "malformed hylol : " the-other-cases)))))</pre>
1585.  上記のようなマクロ定義で, 次のような4通りの記述が可能になります.<br />
1586. <pre class="prettyprint lang-clj">(println (hylol-expand
1587.          (reduce + 0
1588.                  (map dec
1589.                       (take-while (partial not= 0)
1590.                                   (iterate dec 100))))))
1591.  
1592. (println (hylol-expand
1593.          (reduce + 0
1594.                  (take-while (partial not= 0) (iterate dec 100)))))
1595.  
1596. (println (hylol-expand
1597.          (->> (iterate dec 100)
1598.               (take-while (partial not= 0))
1599.               (map inc)
1600.               (reduce + 0))))
1601.  
1602. (println (hylol-expand
1603.          (->> (iterate dec 100)
1604.               (take-while (partial not= 0))
1605.               (reduce + 0))))</pre>
1606.  reduce, map,  take-while, iterateの位置は固定で, これ以外の書き方はできません. 引数となる｢関数/(繰り返しの)初期値｣のみが変更可能です. 上の二例は, 引数渡しで普通に書けるケース, 下の二例は, スレッディングマクロで書かれたものを再帰に書きなおすものです.<br />
1607. <br />
1608.  簡単なベンチマークテストのため, <a href="http://uid0130.blogspot.jp/2014/12/clojureunfoldhylomorphism.html">前の記事</a>で作成した8queen問題でテストしてみました. 前回書いたのは, 次のような書き方(関数コール)でした.<br />
1609. <pre class="prettyprint lang-clj">(defn correct-answer?-v2 [arrangement]
1610.  (hylol andf true #(not (first %)) not-conflict? rest arrangement))
1611. </pre>
1612.  hylolの変換マクロの場合, 同じ意味のプログラムが,<br />
1613. <pre class="prettyprint lang-clj">(defn correct-answer?-mbt [arrangement]
1614.  (hylol-expand ;; = identify
1615.   (->> (iterate rest arrangement)
1616.        (take-while first)
1617.        (map not-conflict?)
1618.        (reduce andf true))))</pre>
1619. で書けます. 見た目は, 大分改善されました.<br />
1620. <br />
1621.  以下が簡単なベンチマーク結果. correct-answers-with-hylol-macroがhylolの変換のマクロ実装, correct-answers-with-hylol-functionは, <a href="http://uid0130.blogspot.jp/2014/12/clojureunfoldhylomorphism.html">前に書いた記事</a>のcorrect-answers-v2, correct-answersは, ナイーブな(hylolの変換が入らない)実装でこれも前回書いた記事と同じ.<br />
1622. <pre class="prettyprint lang-clj">user> (time (count correct-answers-with-hylol-macro))
1623. "Elapsed time: 590.56785 msecs"
1624. 92
1625. user> (time (count correct-answers-with-hylol-function))
1626. "Elapsed time: 594.688247 msecs"
1627. 92
1628. user> (time (count correct-answers))
1629. "Elapsed time: 739.69738 msecs"
1630. 92</pre>
1631.  これで, 可読性を維持したまま, Hylomorphismのマクロ展開により高速化が可能になりました.<br />
1632. &lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/4597523461185830340/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=4597523461185830340&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4597523461185830340'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4597523461185830340'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/02/clojurehylomorphism.html' title='ClojureでリストのHylomorphismの変換マクロ'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-3761512025192616673</id><published>2015-02-07T18:39:00.000+09:00</published><updated>2015-02-09T00:12:58.668+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="incanter"/><category scheme="http://www.blogger.com/atom/ns#" term="クラスタリング"/><category scheme="http://www.blogger.com/atom/ns#" term="機械学習"/><title type='text'>Clojure, incanterを使ってクラスタリング, Single Linkage(単連結法) / Complete Linkage(完全連結法)</title><content type='html'>&amp;nbsp;Clojureのincanter(統計解析用のライブラリ)が使えるようになったので, とりあえず, クラスタリングをやってみました. Single Linkage (単連結法)および, Complete Linkage(完全連結法)は, 階層的クラスタリングの手法の一種で, 距離空間に散らばった多数の点をその位置からそれぞれグループ(クラスタ)ごとに分類する手法です.&lt;br /&gt;
1633. <br />
1634.  例えば, 下の図は, 5つのガウス分布に従ってプロットされた二次元上の点です (各ガウス分布ごとに色で分類されています).<br />
1635. <div class="separator" style="clear: both; text-align: center;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZgg8JusI931-C2f4SM0fnWegHSPLMl89iR2Q9xa3jOw04VXCKDfOK9BpWs1haWSSo9U-s7EdxQL7PAEPyjgzPo5LS1V0xxHJDOFxeaGb2yS5xUKG5PkqBds6QpZ2Ew9bunFCm6JCQaI4/s1600/gauss1.PNG" height="258" style="color: #0000ee; text-align: center;" width="320" /></div><br />
1636.  これをComplete Linkageによって, 5つのクラスタへ分類すると, 次のようになります.<br />
1637. <div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiYwzhPCNj8zX21Z8OFXsPaCrAcD9VNsQBF58XdQ23KxtACtFXsUgLMJP2xs8zmROJLsCBfmARXuhuxdwMP6P-TOM5cIrpfFFyFxkNA31ajCsWCkry06CWN4Yqok4fFVvb48DFnnuNbmHE/s1600/comp-link1.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiYwzhPCNj8zX21Z8OFXsPaCrAcD9VNsQBF58XdQ23KxtACtFXsUgLMJP2xs8zmROJLsCBfmARXuhuxdwMP6P-TOM5cIrpfFFyFxkNA31ajCsWCkry06CWN4Yqok4fFVvb48DFnnuNbmHE/s1600/comp-link1.PNG" height="257" width="320" /></a></div> 元のガウス分布にいくらか従いながら, 近い(近そうな)点どうしが, それぞれのクラスタとして, ひとまとめにされていることが観察できると思います.<br />
1638. <br />
1639.  クラスタリングでは, 空間上の点の位置を元にして同じようなどうしを一つにまとめ, 元の分布を予測したり, グループごとに分類します.<br />
1640. <br />
1641. <h3>データクラスタの可視化</h3> incanterでは, 二次元空間上のグラフのプロットや行列の処理が簡単に使えるので, このようなクラスタリングが, 簡単に実装できます.<br />
1642. <br />
1643. <pre class="prettyprint lang-clj">(require '[incanter.core :as core]
1644.         '[incanter.stats :as st]
1645.         '[incanter.charts :as ch]
1646.         '[clojure.math.numeric-tower :as tower])
1647.  
1648. ;; ------------------------- ------------------------- -------------------------
1649. ;; show clusters
1650. ;; ------------------------- ------------------------- -------------------------
1651.  
1652. (defn plot-with-clusters [clusters] ;; clusters = [[[x1 y1] [x2 y2] ...] ...]
1653.  (let [head (first clusters)
1654.        init-plot (ch/scatter-plot (map first head) (map second head))]
1655.    (reduce #(ch/add-points %1 (map first %2) (map second %2))
1656.            init-plot (rest clusters))))</pre> 名前の衝突を避けるためにrequireでincanterをロードします. incanterではscatter-plotで点を二次元座標上にプロットできます(一番目のクラスタをscatter-plotでプロット). add-pointsでchartオブジェクトに点を付加, reduceで各クラスタを一つにまとめます.<br />
1657. <br />
1658. <h3>サンプルとなるデータ点のリスト</h3> これに, ランダムなパラメータを持つ複数のガウス分布に従うデータセットを作ります.<br />
1659. <pre class="prettyprint lang-clj">(defn generate-random-parameter []
1660.  {:sd (+ 0.15 (rand 0.1)) :x (dec (rand 2)) :y (dec (rand 2))
1661.   :size (+ 20 (rand-int 10))})
1662.  
1663. (defn generate-sample-set [parts]
1664.  (let [generate-by #(st/sample-normal (:size %1) :mean (%2 %1) :sd (:sd %1))]
1665.    (map (fn [p] (map list (generate-by p :x) (generate-by p :y)))
1666.         (take parts (repeatedly generate-random-parameter)))))</pre> sample-normalは, ガウス分布に従うサンプルデータを生成します. 標準偏差等のパラメータの範囲は適当です. generate-sample-setでサンプルのデータ点(x, y)のリストを生成します.<br />
1667. <br />
1668.  データ的には, [ [[0.1 0.2] [-0.3 0.1] ......] [[0.3 -0.02] ......] ......]のように, 各クラスタごとに(x, y)座標がひとつのリストに.<br />
1669. <br />
1670.  (coreの)view関数で, (scatter)プロットされたオブジェクトを表示できます.<br />
1671. <pre class="prettyprint lang-clj">user> (core/view (plot-with-clusters (generate-sample-set 3)))</pre><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjIdNFnkGP2eXJ5p4-oFM3U1GlexksUSfAbOF60zamSkDiLE1K_ZuQKeXIrtLCDUOQy4btdBdvG0FuoUq9OC2rMxXWoHlWiU2vyvXyLWa1uIXY-k4q_LY8CeMJ9kbvmZNNjn6PqoFp1SOE/s1600/gauss2.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjIdNFnkGP2eXJ5p4-oFM3U1GlexksUSfAbOF60zamSkDiLE1K_ZuQKeXIrtLCDUOQy4btdBdvG0FuoUq9OC2rMxXWoHlWiU2vyvXyLWa1uIXY-k4q_LY8CeMJ9kbvmZNNjn6PqoFp1SOE/s1600/gauss2.PNG" height="256" width="320" /></a></div> このリストを(apply concat ls)で, 結合してサンプルのデータ点のリストを作ります. 何か面白いデータがあれば, それでクラスタリングができるのですが...... このデータ列が本来クラスタリングにより分析されるデータになります.<br />
1672. <h3>距離</h3> 距離空間には, マンハッタン距離やマハラノビス距離などありますが, 今回は典型的なユークリッド距離を使います. 簡単にいえば, 視覚的な距離がそのまま, データ間の距離になります.<br />
1673. <pre class="prettyprint lang-clj">(defn distance [x1 y1 x2 y2]
1674.  (double (tower/sqrt (+ (core/sq (- x1 x2)) (core/sq (- y1 y2))))))
1675.  
1676. (defn compare-pairs [xy1 xy2]
1677.  (distance (first xy1) (second xy1) (first xy2) (second xy2)))</pre><h3>Single Linkage, Complete Linkageと階層的クラスタリング</h3> Single/Complete Linkageは, 階層的クラスタリングの一種です. 階層的クラスタリングとは, クラスタ群の中から2つクラスタを選びその2つを結合していき, 目標となるクラスタ数に達するまで結合を続けます. クラスタ群の初期状態では, データ点一つに対し, 一つクラスタを定義します. 階層的クラスタリングの欠点の一つは, 最終的なクラスタ数を指示する必要があることです. 最終的なクラスタ数の適切な値がわからない時にはこの設定が問題となります. しかし, 裏を返せば, 好きなようにクラスタ数を決められるということでもあります.<br />
1678. <br />
1679.  Single LinkageとComplete Linkageの違いは, クラスタ間の距離の定義です. Single Linkageでは, 2つのクラスタ間どうしで最も近い要素間の距離がそのクラスタ間の距離になります. 一方, Complete Linkageは, 最も遠い要素間の距離がクラスタ間の距離とします.<br />
1680. <pre class="prettyprint lang-clj">(defn single-linkage "cluster a & cluster b -> distance" [a b]
1681.  (reduce min (map #(reduce min (map (partial compare-pairs %) b)) a)))
1682.  
1683. (defn complete-linkage "cluster a & cluster b -> distance" [a b]
1684.  (reduce max (map #(reduce max (map (partial compare-pairs %) b)) a)))</pre> プログラム上の違いはmin/maxだけですが, Single Linkageの考え方としては, 2つのクラスタが同じクラスタなら要素間に繋がりがあるはずだということで, Complete Linkageの方は, 同じクラスタに含まれるということは要素がそれなりに凝集しているはずだ, ということでしょう.<br />
1685. <h3>IncanterのMatricesと距離行列</h3> incanterを使っていて, せっかくなので距離行列(クラスタ間の距離のデータを保存している行列)もincanterの行列を使いました.<br />
1686. <br />
1687.  Clojureのシーケンス(リスト)から, matrixオブジェクトを生成できます. 同じクラスタ群の距離を保存するための行列なので, 対象行列になり, 対格要素は0になります. ここでの計算において, 対格要素は使いませんが, わかりにくいので対格要素は無限大としました.<br />
1688.  こんな感じ.<br />
1689. <pre class="prettyprint lang-clj">user> (generate-init-matrix (map (fn [x] [x]) (apply concat (generate-sample-set 5))))
1690. A 118x118 matrix
1691. -----------------
1692. Infinity  1.79e-01  3.13e-01  .  1.96e+00  2.09e+00  2.26e+00
1693. 1.79e-01  Infinity  1.78e-01  .  1.85e+00  1.99e+00  2.14e+00
1694. 3.13e-01  1.78e-01  Infinity  .  1.93e+00  2.08e+00  2.21e+00
1695. ...
1696. 1.96e+00  1.85e+00  1.93e+00  .  Infinity  2.07e-01  3.39e-01
1697. 2.09e+00  1.99e+00  2.08e+00  .  2.07e-01  Infinity  3.69e-01
1698. 2.26e+00  2.14e+00  2.21e+00  .  3.39e-01  3.69e-01  Infinity</pre> matrixオブジェクトは, デフォルトでtoStringメソッドが実装されているため, replでは, 間を省略した行列が表示されます. 上の例は, 対格要素をPOSITIVE_INFINITYにした118×118の行列. 巨大な行列でも間引かれているので表示されるときはコンパクトになります.<br />
1699. <br />
1700. <pre class="prettyprint lang-clj">(def inf Double/POSITIVE_INFINITY)
1701.  
1702. (defn distances-xy-xys [xy xys]
1703.  (cons inf (map (fn [xy1] (compare-pairs (first xy) (first xy1))) (rest xys))))
1704.  
1705. (defn generate-init-matrix [xys]
1706.  (let [dist-vec (map distances-xy-xys (drop-last xys) (iterate rest xys))]
1707.    (core/symmetric-matrix
1708.     (apply concat (concat dist-vec [[inf]])) :lower false)))
1709.  
1710. (defn find-conj-pair [dist-matrix width]
1711.  (loop [x (dec width) y (dec width) conj-pair [width width] min-value inf]
1712.    (cond
1713.     (< y 0) conj-pair
1714.     (< x 0) (recur y (dec y) conj-pair min-value)
1715.     :else (let [value (core/sel dist-matrix :cols x :rows y)]
1716.             (if (< value min-value)
1717.               (recur (dec x) y [x y] value) ;; update pair
1718.               (recur (dec x) y conj-pair min-value)))))) ;; not update pair
1719.  
1720. (defn update-dists
1721.  "updates distance matrix
1722.   dist-matrix : distance matrix
1723.   i, j : delete target
1724.   new-column : newly generated distances from i,j"
1725.  [dist-matrix i j new-column]
1726.  (->> (core/sel dist-matrix :except-rows [i j] :except-cols [i j])
1727.       (core/bind-rows new-column)
1728.       (core/bind-columns (cons inf new-column))))</pre> 上2つの関数は, 初期状態の距離行列を作るためのものです. find-conj-pairで距離行列から結合する2つのクラスタのペアをインデックスで返します. update-distsで距離行列を更新します. 新しく生成されたクラスタと他のクラスタ間の距離を行列の上の行(と左側の列)に付け加えて更新します.<br />
1729. <h3>階層的クラスタリング</h3> クラスタ群は, 簡単のため, i,jのインデックスで扱います.<br />
1730. <pre class="prettyprint lang-clj">(defn remove-clusters [i j clusters]
1731.  (let [;; supposed to be c_0 c_1 ... c_n ... c_m ... c_max
1732.        n (min i j) m (max i j)
1733.        ;; [[c_0  ... c_n ... c_m-1] [c_m ... c_max]]
1734.        first-m-last (split-at m clusters)
1735.        ;; [[c_0 ... c_n-1] [c_n ... c_m-1]]
1736.        first-n-m (split-at n (first first-m-last))]
1737.    ;; (concat [c_0 ... c_n-1] [c_n+1 ... c_m-1] [c_m+1 ... c_max])
1738.    (concat (first first-n-m) (rest (second first-n-m)) (rest (second first-m-last)))))</pre> remove-clustersでクラスタ群のi,j番目のクラスタを除去します.<br />
1739. <br />
1740.  以下は, クラスタリングのループです. 一番近いクラスタを探し出し, 結合して更新という処理を指定されたクラスタ数になるまで続けます.<br />
1741. <pre class="prettyprint lang-clj">(defn clustering [calc-dists xys target-size]
1742.  (loop [clusters (map (fn [x] [x]) xys)
1743.         dist-matrix (generate-init-matrix clusters)
1744.         cluster-size (count xys)]
1745.    (if (<= cluster-size target-size)
1746.      clusters
1747.      (let [conj-pair (find-conj-pair dist-matrix cluster-size)
1748.            i (first conj-pair) j (second conj-pair)
1749.            new-cluster (concat (nth clusters i) (nth clusters j))
1750.            other-clusters (remove-clusters i j clusters)]
1751.       (recur (cons new-cluster other-clusters)
1752.              (update-dists dist-matrix i j (calc-dists new-cluster other-clusters))
1753.              (dec cluster-size))))))
1754.  
1755. (defn link-with [dist-f new-cluster other-clusters]
1756.  (map (fn [cluster] (dist-f new-cluster cluster)) other-clusters))
1757.  
1758. (defn clustering-with-single-linkage [xys number-of-clusters]
1759.  (clustering (partial link-with single-linkage) xys number-of-clusters))
1760.  
1761. (defn clustering-with-complete-linkage [xys number-of-clusters]
1762.  (clustering (partial link-with complete-linkage) xys number-of-clusters))</pre><h3>実行結果</h3>こんな感じでサンプルのデータ点を生成して,<br />
1763. <pre class="prettyprint lang-clj">user> (def A (generate-sample-set 5))
1764. user> (core/view (plot-with-clusters A))</pre><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiT-Gp5qF_WXnJ7GHRaP8tQWL9btbtU6_4z1KpzrGAJ-GK7ApDhE_Was_9R9qqHQbnsr0vXXsSNt48Tzpw0EUus0N92YqZe8CTuLrftpeopTJ9D8gaqAu-O9-G91adKZ4j6LMGBdKdXy9w/s1600/prev-gauss.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em; text-align: center;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiT-Gp5qF_WXnJ7GHRaP8tQWL9btbtU6_4z1KpzrGAJ-GK7ApDhE_Was_9R9qqHQbnsr0vXXsSNt48Tzpw0EUus0N92YqZe8CTuLrftpeopTJ9D8gaqAu-O9-G91adKZ4j6LMGBdKdXy9w/s1600/prev-gauss.PNG" height="255" width="320" /></a></div><br />
1765. こんな感じのガウス分布になっているものに, 最終的なクラスタ数を5に設定してSingle Linkageをつかうと,<br />
1766. <pre class="prettyprint lang-clj">user> (core/view (plot-with-clusters (clustering-with-single-linkage (apply concat A) 5)))</pre><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQJH2YZtABF-BshyphenhyphenYZqX32BIZ1omVCpT-9-BxA1o5fva1UYuNgU5Q5ZKmpnb6i7zDmAPfZESpCyOW6CejKOkpLOd0df7qJ_qKLqtLmN1PpCjjgDj4IL_mlJvcmjIiyeirypG9E75-N37E/s1600/post-single-link.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em; text-align: center;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQJH2YZtABF-BshyphenhyphenYZqX32BIZ1omVCpT-9-BxA1o5fva1UYuNgU5Q5ZKmpnb6i7zDmAPfZESpCyOW6CejKOkpLOd0df7qJ_qKLqtLmN1PpCjjgDj4IL_mlJvcmjIiyeirypG9E75-N37E/s1600/post-single-link.PNG" height="256" width="320" /></a></div><br />
1767. となり, 同様に最終的なクラスタ数を5に設定したComplete Linkageでは,<br />
1768. <pre class="prettyprint lang-clj">user> (core/view (plot-with-clusters (clustering-with-complete-linkage (apply concat A) 5)))</pre><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhusAjmXdo7piIxaj_KCMkjSMMJnzV1X__wcvKNxBAG8xZ4MKl-iXho-uFob9bPucy-avBVnhrVGQ52mR_z812PWQB1_PvUOXLQGNX8wIKw3G2eAp4-dkjfHmjEWZwiUuFW0pzk4rUmYyg/s1600/post-comp-link.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhusAjmXdo7piIxaj_KCMkjSMMJnzV1X__wcvKNxBAG8xZ4MKl-iXho-uFob9bPucy-avBVnhrVGQ52mR_z812PWQB1_PvUOXLQGNX8wIKw3G2eAp4-dkjfHmjEWZwiUuFW0pzk4rUmYyg/s1600/post-comp-link.PNG" height="257" width="320" /></a></div>になります.<br />
1769. <br />
1770.  Complete Linkageの方が, うまく(?)クラスタリングされているように見えます. 元の分布を完全に予測しているわけではありませんが, 生成されたときの分布4に近いかたちで分類できています. Single Linkageは, 孤立した点が一つのクラスタに分類されてしまう傾向があるようです. 全体がほぼ2つのクラスタに分類されてしまっています.<br />
1771. <br />
1772. <b>参考文献</b>  <br />
1773. <ul><li><a href="https://github.com/incanter/incanter/wiki">Incanter Wiki - GitHub</a></li>
1774. <ul><li>Matricesとかの使い方の説明は, 左側のPagesのリンクから.</li>
1775. </ul><li><a href="http://www.kamishima.net/archive/clustering.pdf">クラスタリング Clustering 神嶌 敏弘</a></li>
1776. <li><a href="http://www.kamishima.net/jp/clustering/">クラスタリング (クラスター分析) - Toshihiro Kamishima</a></li>
1777. </ul> 全ソースコード.<br />
1778. <pre class="prettyprint lang-clj">(require '[incanter.core :as core]
1779.         '[incanter.stats :as st]
1780.         '[incanter.charts :as ch]
1781.         '[clojure.math.numeric-tower :as tower])
1782.  
1783. ;; ------------------------- ------------------------- -------------------------
1784. ;; show clusters
1785. ;; ------------------------- ------------------------- -------------------------
1786.  
1787. (defn plot-with-clusters [clusters] ;; clusters = [[[x1 y1] [x2 y2] ...] ...]
1788.  (let [head (first clusters)
1789.        init-plot (ch/scatter-plot (map first head) (map second head))]
1790.    (reduce #(ch/add-points %1 (map first %2) (map second %2))
1791.            init-plot (rest clusters))))
1792.  
1793. ;; ------------------------- ------------------------- -------------------------
1794. ;; generate data set
1795. ;; ------------------------- ------------------------- -------------------------
1796.  
1797. (defn generate-random-parameter []
1798.  {:sd (+ 0.15 (rand 0.1)) :x (dec (rand 2)) :y (dec (rand 2))
1799.   :size (+ 20 (rand-int 10))})
1800.  
1801. (defn generate-sample-set [parts]
1802.  (let [generate-by #(st/sample-normal (:size %1) :mean (%2 %1) :sd (:sd %1))]
1803.    (map (fn [p] (map list (generate-by p :x) (generate-by p :y)))
1804.         (take parts (repeatedly generate-random-parameter)))))
1805.  
1806. ;; ------------------------- ------------------------- -------------------------
1807. ;; clustering
1808. ;; ------------------------- ------------------------- -------------------------
1809.  
1810. (defn distance [x1 y1 x2 y2]
1811.  (double (tower/sqrt (+ (core/sq (- x1 x2)) (core/sq (- y1 y2))))))
1812.  
1813. (defn compare-pairs [xy1 xy2]
1814.  (distance (first xy1) (second xy1) (first xy2) (second xy2)))
1815.  
1816. (defn single-linkage "cluster a & cluster b -> distance" [a b]
1817.  (reduce min (map #(reduce min (map (partial compare-pairs %) b)) a)))
1818.  
1819. (defn complete-linkage "cluster a & cluster b -> distance" [a b]
1820.  (reduce max (map #(reduce max (map (partial compare-pairs %) b)) a)))
1821.  
1822. (def inf Double/POSITIVE_INFINITY)
1823.  
1824. (defn distances-xy-xys [xy xys]
1825.  (cons inf (map (fn [xy1] (compare-pairs (first xy) (first xy1))) (rest xys))))
1826.  
1827. (defn generate-init-matrix [xys]
1828.  (let [dist-vec (map distances-xy-xys (drop-last xys) (iterate rest xys))]
1829.    (core/symmetric-matrix
1830.     (apply concat (concat dist-vec [[inf]])) :lower false)))
1831.  
1832. (defn find-conj-pair [dist-matrix width]
1833.  (loop [x (dec width) y (dec width) conj-pair [width width] min-value inf]
1834.    (cond
1835.     (< y 0) conj-pair
1836.     (< x 0) (recur y (dec y) conj-pair min-value)
1837.     :else (let [value (core/sel dist-matrix :cols x :rows y)]
1838.             (if (< value min-value)
1839.               (recur (dec x) y [x y] value) ;; update pair
1840.               (recur (dec x) y conj-pair min-value)))))) ;; not update pair
1841.  
1842. (defn update-dists
1843.  "updates distance matrix
1844.   dist-matrix : distance matrix
1845.   i, j : delete target
1846.   new-column : newly generated distances from i,j"
1847.  [dist-matrix i j new-column]
1848.  (->> (core/sel dist-matrix :except-rows [i j] :except-cols [i j])
1849.       (core/bind-rows new-column)
1850.       (core/bind-columns (cons inf new-column))))
1851.  
1852. (defn remove-clusters [i j clusters]
1853.  (let [;; supposed to be c_0 c_1 ... c_n ... c_m ... c_max
1854.        n (min i j) m (max i j)
1855.        ;; [[c_0  ... c_n ... c_m-1] [c_m ... c_max]]
1856.        first-m-last (split-at m clusters)
1857.        ;; [[c_0 ... c_n-1] [c_n ... c_m-1]]
1858.        first-n-m (split-at n (first first-m-last))]
1859.    ;; (concat [c_0 ... c_n-1] [c_n+1 ... c_m-1] [c_m+1 ... c_max])
1860.    (concat (first first-n-m) (rest (second first-n-m)) (rest (second first-m-last)))))
1861.  
1862. (defn clustering [calc-dists xys target-size]
1863.  (loop [clusters (map (fn [x] [x]) xys)
1864.         dist-matrix (generate-init-matrix clusters)
1865.         cluster-size (count xys)]
1866.    (if (<= cluster-size target-size)
1867.      clusters
1868.      (let [conj-pair (find-conj-pair dist-matrix cluster-size)
1869.            i (first conj-pair) j (second conj-pair)
1870.            new-cluster (concat (nth clusters i) (nth clusters j))
1871.            other-clusters (remove-clusters i j clusters)]
1872.        (recur (cons new-cluster other-clusters)
1873.               (update-dists dist-matrix i j (calc-dists new-cluster other-clusters))
1874.               (dec cluster-size))))))
1875.  
1876. (defn link-with [dist-f new-cluster other-clusters]
1877.  (map (fn [cluster] (dist-f new-cluster cluster)) other-clusters))
1878.  
1879. (defn clustering-with-single-linkage [xys number-of-clusters]
1880.  (clustering (partial link-with single-linkage) xys number-of-clusters))
1881.  
1882. (defn clustering-with-complete-linkage [xys number-of-clusters]
1883.  (clustering (partial link-with complete-linkage) xys number-of-clusters))&lt;/pre&gt;&lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/3761512025192616673/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=3761512025192616673&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/3761512025192616673'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/3761512025192616673'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/02/clojure-incanter-single-linkage.html' title='Clojure, incanterを使ってクラスタリング, Single Linkage(単連結法) / Complete Linkage(完全連結法)'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZgg8JusI931-C2f4SM0fnWegHSPLMl89iR2Q9xa3jOw04VXCKDfOK9BpWs1haWSSo9U-s7EdxQL7PAEPyjgzPo5LS1V0xxHJDOFxeaGb2yS5xUKG5PkqBds6QpZ2Ew9bunFCm6JCQaI4/s72-c/gauss1.PNG" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-7435282704427740313</id><published>2015-02-03T23:13:00.000+09:00</published><updated>2015-02-05T19:28:01.677+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="incanter"/><title type='text'>incanterでhistgramをプロットする</title><content type='html'>&amp;nbsp;Clojureのincanterについては, ずいぶん前から知っていたのですが, 使う機会があまりなかった為, 特に触っていませんでした. 最近, Clojureで生成したデータからグラフをプロットするという作業が必要になったこともあって, incanterを弄っているので, メモです.&lt;br /&gt;
1884. <br />
1885. <div style="text-align: center;">
1886. <a href="http://liebke.github.io/incanter/index.html">incanterのAPIリファレンス</a><br />
1887. <br />
1888.  <a href="http://incanter.org/docs/incanter-cheat-sheet.pdf">incanterのcheetsheet</a></div>
1889. <br />
1890.  とりあえず, histgramを使うところまで.<br />
1891. <br />
1892.  以下のコマンドは, REPLに<br />
1893. <pre class="prettyprint lang-clj">user> (use '(incanter core stats charts pdf))</pre>
1894. を叩き込んだ前提で. (2015/02/05, pdf追加)<br />
1895.  名前的に他のライブラリ等の関数名と名前が重複する可能性がある(特にnumeric-towerなど, な)ので, prefixなしで直にロードするというのはあまりよくありませんが, 弄ってみるだけなら, これでも問題ない筈です.<br />
1896. <br />
1897.  公式のチュートリアル(Github)にも載っていますが, ヒストグラムの表示は,<br />
1898. <pre class="prettyprint lang-clj">user> (view (histogram (sample-normal 10000)))</pre>
1899. でいけます.<br />
1900. <div class="separator" style="clear: both; text-align: center;">
1901. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3RcGPDl4pAlvduD9U1wQtLTaw9HS1sWOw7Qbd60yqgT6yUrDuNvSDskhsbRy7zJlB1qNXCYRJ06s9Rx9kC0OfZQ9wVxceYoe80mNh7G3ZpV2XH94msGYuWEogigqTzpmBNVnwJGrY_7U/s1600/hist1.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3RcGPDl4pAlvduD9U1wQtLTaw9HS1sWOw7Qbd60yqgT6yUrDuNvSDskhsbRy7zJlB1qNXCYRJ06s9Rx9kC0OfZQ9wVxceYoe80mNh7G3ZpV2XH94msGYuWEogigqTzpmBNVnwJGrY_7U/s1600/hist1.png" height="256" width="320" /></a></div>
1902. <br />
1903.  ヒストグラムは, n個のデータサンプルをカテゴリ別に分類し, そのデータの分布を可視化するものなので, カテゴリ数を調整したくなります. カテゴリ数は, :nbinsオプションで指定できます. カテゴリ数を1000にする場合, 以下のように書きます.<br />
1904. <pre class="prettyprint lang-clj">user> (view (histogram (sample-normal 10000) :nbins 1000))</pre>
1905. これを実行すると, 次のようになります.<br />
1906. <div class="separator" style="clear: both; text-align: center;">
1907. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhojoLj1LWmw7d_DbYAQGX8YJkcSEQF7Mm6kHmnRT2PhVE-JbstASQtZ2w64tDxl6D35qQ5e93jdEq_qi5YYEkzCgpI0SXz8SqgYT6nmN0Yr6hhSGoiO7zVl3GOL07sxU6dlHMZQClD2D4/s1600/hist2.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhojoLj1LWmw7d_DbYAQGX8YJkcSEQF7Mm6kHmnRT2PhVE-JbstASQtZ2w64tDxl6D35qQ5e93jdEq_qi5YYEkzCgpI0SXz8SqgYT6nmN0Yr6hhSGoiO7zVl3GOL07sxU6dlHMZQClD2D4/s1600/hist2.png" height="254" width="320" /></a></div>
1908. <br />
1909.  (sample-normal 10000)は, 意味的には,<br />
1910. <pre class="prettyprint lang-clj">user> (import 'java.util.Random)
1911. user> (def r (Random .))
1912. user> (map (fn [x] (.nextGaussian r)) (range 10000))</pre>
1913. と一緒のようです. 平均0, 標準偏差1の正規分布に従い乱数を生成するものです.<br />
1914. <br />
1915.  sample-normalが生成するのは, 単なる数値型(double)のリストです.<br />
1916. <pre class="prettyprint lang-clj">user> (sample-normal 3)
1917. (1.2821074070154617 1.638783357428357 -0.2801943679292413)</pre>
1918.  サンプルのリストをconcatでつなげれば, 別々のサンプルを合成できます. :sdは標準偏差(Standard Deviation), :meanは平均のオプション.<br />
1919. <pre class="prettyprint lang-clj">user> (view (histogram (concat (sample-normal 10000 :mean -5 :sd 4)
1920.                               (sample-normal 10000 :mean 4)) :nbins 1000))</pre>
1921. <div class="separator" style="clear: both; text-align: center;">
1922. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjECJcmrW6YJeU6RUyk7L-2bVezrSuVul2jwB9HD8QhusRdFmI4EtnmlSqT8TOPJcQlyAnUe2MQEUaslyvMsKUOCNJZCDKVu4G4DEjAOAqT8r3iL_M2AIE7lEaxuWIPPi9AXAtocUm__9A/s1600/hist3.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjECJcmrW6YJeU6RUyk7L-2bVezrSuVul2jwB9HD8QhusRdFmI4EtnmlSqT8TOPJcQlyAnUe2MQEUaslyvMsKUOCNJZCDKVu4G4DEjAOAqT8r3iL_M2AIE7lEaxuWIPPi9AXAtocUm__9A/s1600/hist3.png" height="256" width="320" /></a></div>
1923. <br />
1924.  ヒストグラムが, 正規分布に従っているかどうかを調べるために, 正規分布の曲線を重ねるのは, histgramで生成したオブジェクトに, add-line関数で重ねます. pdf-normalは, 正規分布の関数. histgramの:densityオプションは, 密度(Density)か頻度(Frequency)のオプション.<br />
1925. <pre class="prettyprint lang-clj">user> (view (doto (histogram (sample-normal 10000) :nbins 100 :density true)
1926.                  (add-lines (range -4 4 0.01) (pdf-normal (range -4 4 0.01)))))</pre>
1927. で, これが次のようにプロットされます.<br />
1928. <div class="separator" style="clear: both; text-align: center;">
1929. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg8GJP0XoKAG7H-Xtlrhz1fA0USvQkWR3UJ9za4Sa3_311DRXkTdddhljYbw6OwQZb1STuVSh1lVlMJdTky_ic43g8mSj6sX6KyBjb-B9E8qeDIftV4vR7CbCChTPNlK8CI2pDrSa-hYL8/s1600/hist6.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg8GJP0XoKAG7H-Xtlrhz1fA0USvQkWR3UJ9za4Sa3_311DRXkTdddhljYbw6OwQZb1STuVSh1lVlMJdTky_ic43g8mSj6sX6KyBjb-B9E8qeDIftV4vR7CbCChTPNlK8CI2pDrSa-hYL8/s1600/hist6.png" height="257" width="320" /></a></div>
1930. <br />
1931. &lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/7435282704427740313/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=7435282704427740313&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7435282704427740313'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/7435282704427740313'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/02/incanterhistgram.html' title='incanterでhistgramをプロットする'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3RcGPDl4pAlvduD9U1wQtLTaw9HS1sWOw7Qbd60yqgT6yUrDuNvSDskhsbRy7zJlB1qNXCYRJ06s9Rx9kC0OfZQ9wVxceYoe80mNh7G3ZpV2XH94msGYuWEogigqTzpmBNVnwJGrY_7U/s72-c/hist1.png" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-4788145237634407596</id><published>2015-01-31T18:47:00.000+09:00</published><updated>2015-01-31T18:47:43.897+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="プログラム意味論"/><category scheme="http://www.blogger.com/atom/ns#" term="ラムダ計算"/><category scheme="http://www.blogger.com/atom/ns#" term="抽象解釈"/><title type='text'>アンダースタンディング・コンピューテーション, メモと感想</title><content type='html'>&amp;nbsp;いつの間にか, 大学の図書館に『アンダースタンディング・コンピューテーション 単純な機会から不可能なプログラムまで』(Tom Stuart(著), 笹田耕一(監訳), 笹井崇司(訳), オライリー・ジャパン)があったので, 読みながらのメモと感想.&lt;br /&gt;
1932. <br />
1933.  読んでいて面白かったのは, 2章, 7章, 8章, 9章でした.<br />
1934. <br />
1935. ※以下のメモは, 各章に関する内容を<b>まとめたものではなく</b>, 各章を読んでいて, <b>気づいたこと/思ったこと/思い出したことをメモした内容です.</b><br />
1936. <b><br /></b>
1937. <h4>
1938. 1章. Ruby</h4>
1939. <div>
1940.  触ったことなかったけど, Rubyの無名関数は,<br />
1941. <br />
1942. <div style="text-align: center;">
1943.  -><i>arguments</i> { <i>body</i> }</div>
1944. <br />
1945.  と書くらしい. 中括弧で関数本体を囲むのはともかくとして, なんで -> <i>arguments</i> なんだろう. Haskellでは, \<i>arguments</i>-><i>body</i>とかくけど関係があるのか......?<br />
1946. <br />
1947.  Rubyの*演算子はapply関数相当 ... 準クォートのような文字列の式展開.</div>
1948. <div>
1949. <br /></div>
1950. <h4>
1951. 2章. プログラムの意味</h4>
1952. <div>
1953.  あやふやになりがちな, Big Step Semantics ↔ Small Step Semantics, 操作的意味論 ↔ 表示的意味論についての説明. 操作的意味論は, インタプリタ的な解釈で, 表示的意味論はコンパイラ的な解釈という感じでしょうか.<br />
1954. <br /></div>
1955. <div>
1956. <h4>
1957. Small Step Semantics</h4>
1958. <div>
1959.  = プログラムの解釈の過程(計算過程)まで定義した反復的(iterative)な意味の定義.</div>
1960. <div>
1961.  SchemeのR6RSの意味の定義は, Small Step Semantics. Schemeでも, R5RSやR7RSの定義は, Denotational Semanticsで, R7RSになって, 元に戻された感じ(戻されたといっても内容は違いますが).</div>
1962. </div>
1963. <div>
1964. <br /></div>
1965. <h4>
1966. Big Step Semantics</h4>
1967. <div>
1968.  = プログラムの意味を一度に表すための. 再帰的な定義.</div>
1969. <div>
1970. 以下は, Big Step Semanticsを使った例. Standard MLの定義なのだそうです.</div>
1971. <div>
1972.  <a href="http://www.lfcs.inf.ed.ac.uk/reports/87/ECS-LFCS-87-36/">http://www.lfcs.inf.ed.ac.uk/reports/87/ECS-LFCS-87-36/</a></div>
1973. <div>
1974. <br /></div>
1975. <h4>
1976. 3章 & 4章, 5章. 最も単純なコンピュータ & 能力を高める, 究極の機械</h4>
1977. <div>
1978.  いわゆるオートマトン(DFA, NFA, 正規表現, PDA, 構文解析など)の章. ここ最近, 形式言語関連はうんざりする程付き合ってきたので, ほとんど読み飛ばしてしまいました. 「形式言語とオートマトン」の教科書の内容が噛み砕いて解説されている印象. 学部生の頃に出会いたかったかな. </div>
1979. <div>
1980. <br /></div>
1981. <div>
1982.  当然のように, (非)決定性オートマトン→正規表現→プッシュダウンオートマトン→構文解析→チューリングマシンという流れでした. 5章は, 究極の機械というタイトルですが, 内容はただのチューリングマシンです.</div>
1983. <div>
1984. <br /></div>
1985. <h4>
1986. 6章. 無からのプログラミング</h4>
1987. <div>
1988.  ここで遂に型なしラムダ計算が登場します. Rubyの無名関数, -><i>arguments</i> { <i>body</i> }を使って, ラムダ計算をエミュレートします. pp.188-191にかけてのFizz Buzzは圧巻です.<br />
1989. <br />
1990.  ちょっと特徴的だったのが, リストの扱いでした. ラムダ計算では, λxyf. f x yに相当する(Lispでいうところの)consは, PAIRと, car/cdrに相当する関数がLEFT/RIGHTと名付けられていました.<br />
1991. <br />
1992.  これだけだと, 単に名前を変えただけなのですが, リストとconsセルを区別するために, 独自のリスト構造を定義しています. 初めて見る定義だったのですが, UNSHIFTというオペレータでリストを構築し, FIRST/RESTで要素を取り出します.<br />
1993. <br />
1994.  UNSHIFTは, ほぼconsと機能的には同等のもので, UNSHIFTは, Rubyのunshiftメソッドに由来しているようです. Rubyのプログラムをそのままラムダ計算でエミュレートする流れであったため, リストのconsingは, UNSHIFTで行うということなのでしょう.<br />
1995. <br />
1996.  例えば, (1 2)のようなリストは素朴なconsセル(この場合PAIR)を使った場合, データ構造としては, こんな感じのはずですが,<br />
1997. <div class="separator" style="clear: both; text-align: center;">
1998. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhytNRRtH0hwTrnEM5eEsnv6wB7t-w7q_zrGfWTnsx5P8xbOLQOMphlHDi0y5ZOKner91xL6JMi5MbMDp65bfc1YwyxxeeF50NGt3R2hM7eEsQv0TaS8SL9qI5Qeqyu18zTSWK8kU0tuKc/s1600/slice1.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhytNRRtH0hwTrnEM5eEsnv6wB7t-w7q_zrGfWTnsx5P8xbOLQOMphlHDi0y5ZOKner91xL6JMi5MbMDp65bfc1YwyxxeeF50NGt3R2hM7eEsQv0TaS8SL9qI5Qeqyu18zTSWK8kU0tuKc/s1600/slice1.PNG" height="97" width="200" /></a></div>
1999. <div class="separator" style="clear: both; text-align: left;">
2000.  本書では, 同じ (1 2)のリストは, 次のような構造になります. 素朴なconsセルのケースと同様に, PAIRにより構成されますが, 少し構造が違います.</div>
2001. <br />
2002. <div class="separator" style="clear: both; text-align: center;">
2003. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjV0xW9X0Ubd8Af8-nJhDkA_cu93hSLoeAempdxa_wlDF6OE7ZjdBMDxQ2n0NeoJ6lj0783KcDVERtTaySlf4d6p9prFEdQyOHvGHkMV6Znj3FkyqHeFflKAiKVJ9jXaNqWZ6RHD1WAiXs/s1600/slice2.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjV0xW9X0Ubd8Af8-nJhDkA_cu93hSLoeAempdxa_wlDF6OE7ZjdBMDxQ2n0NeoJ6lj0783KcDVERtTaySlf4d6p9prFEdQyOHvGHkMV6Znj3FkyqHeFflKAiKVJ9jXaNqWZ6RHD1WAiXs/s1600/slice2.PNG" height="75" width="400" /></a></div>
2004.   それで, UNSHIFTというオペレータで, 次のように構築しています.<br />
2005. <div class="separator" style="clear: both; text-align: center;">
2006. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjpxJjQH3tx5VcdfJ8lBX6eKBy7AXoKKobz_tCv9WiULAXiWJ-hkEc1_Q-oVUVlT-Y2XVt0z9toQoHpQMbYmfA-Vaw0zIMqUuQscdq0DcFRu5pDEaumV56IYfhFB-EJxT_ZfCh3mG0H4vo/s1600/slice3.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjpxJjQH3tx5VcdfJ8lBX6eKBy7AXoKKobz_tCv9WiULAXiWJ-hkEc1_Q-oVUVlT-Y2XVt0z9toQoHpQMbYmfA-Vaw0zIMqUuQscdq0DcFRu5pDEaumV56IYfhFB-EJxT_ZfCh3mG0H4vo/s1600/slice3.PNG" height="182" width="400" /></a></div>
2007. <br />
2008.  リストの各要素の手前にあるtrue/falseは, リストが空かどうかを判定するために用いられていました. この辺りがちょっと独特です.<br />
2009. <br />
2010. <h4>
2011. 7章. 至るところにある万能性</h4>
2012. </div>
2013. <div>
2014.  このセクションは, チューリング完全な(計算)システムのコレクションです. 前半には, ラムダ計算, SKIコンビネータ, ι(イオタ)コンビネータ, 部分再帰関数のチューリング完全性についての説明があります.<br />
2015. <br />
2016.  ラムダ計算で, チューリングマシンのエミュレータを書いて, SKIコンビネータで, ラムダ計算をエミュレートして, SKIコンビネータをιコンビネータでエミュレートして, という作業を繰り返すと, この３つがチューリング完全だという話でした.<br />
2017. <br />
2018.  ところが, 中盤に, 普通の「形式言語」の教科書ではあまり扱われないタグシステムというのが登場します. 私にとっては, チューリングマシンやラムダ計算に比べると地味な存在でした. しかし, タグシステムに修正を加えた(同じようにチューリング完全な)循環タグシステムが, 「コンウェイのライフゲーム」や, 「ウルフラムの2, 3のチューリングマシン」がチューリング完全であることの証明に使われているという話があり, 面白いと感じました.<br />
2019. <br />
2020.  余談ですが, このセクションで挙げられたもの以外では, 「マルコフアルゴリズム」なんかもチューリング完全です.<br />
2021. <br /></div>
2022. <div>
2023. <h4>
2024. 8章. 不可能なプログラム</h4>
2025. </div>
2026. <div>
2027.  いわゆる停止性問題.</div>
2028. <div>
2029. <br /></div>
2030. <h4>
2031. 9章. おもちゃの国のプログラミング</h4>
2032. <div>
2033.  割りとふざけたタイトルに思えますが, 9章は, 抽象解釈(Abstract Interpretation)についての非形式的な説明が載っています. 「おもちゃの国」というのは, 要するに「抽象的なプログラムの世界」という意味なのでしょう.</div>
2034. <div>
2035. <br /></div>
2036. <div>
2037.  抽象解釈とは, プログラムの抽象的/近似的な実行(または解釈)のことです. あるプログラム(関数)が正しい結果を返すのかについて調べるために, そのプログラムへの入力をすべて試すというのは無理なので, よりシンプルな領域へ抽象化して, 抽象化された世界での結果を調べるという手法です.</div>
2038. <div>
2039. </div>
2040. <div>
2041. <br /></div>
2042. <div>
2043.  本書では, 掛け算における整数の符号の例の説明がありますが, 例えば, ある整数の元(z ∈ <b>Z</b>)同士の積は, 表で表すと, いわゆる無限に続く掛け算の九九のような形になります. それを正の数 : Pos, 負の数 : Neg, ゼロ : 0 からなる領域S = {0, Pos, Neg}で抽象的な表すと次のような表に収まりました. これが抽象解釈における抽象化です.</div>
2044. <br />
2045. <div class="separator" style="clear: both; text-align: center;">
2046. <a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjztz3K9hxNwS0B0WUHkGjbm8NOUCPlSfIEXVOzUnb9dWrHZLtWZrtLrsGKe7eZG-aLMJMRCZZ0niSQxkaFEC_p1HfaWmtVKBZaySTBWOQgEiwJl6m-QKTMwTVYwTg5Xri5N28mdidg9c4/s1600/absint.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjztz3K9hxNwS0B0WUHkGjbm8NOUCPlSfIEXVOzUnb9dWrHZLtWZrtLrsGKe7eZG-aLMJMRCZZ0niSQxkaFEC_p1HfaWmtVKBZaySTBWOQgEiwJl6m-QKTMwTVYwTg5Xri5N28mdidg9c4/s1600/absint.PNG" /></a></div>
2047. <div>
2048. <br /></div>
2049. <div>
2050.  で, 例えば, 1×-2 = -2のような計算が抽象化されて, Pos×Neg = Negのような計算(解釈)の世界が得られます.</div>
2051. <div>
2052. <br /></div>
2053. <div>
2054.  この時, </div>
2055. <div>
2056. <br /></div>
2057. <div style="text-align: center;">
2058. f(x, y) <b>= </b>1÷(<b>if </b>x * y < 0 <b>then </b>x <b>else </b>2)</div>
2059. <div>
2060. <br /></div>
2061. <div>
2062.  というプログラムがあった時, この関数がゼロ除算のエラーを出さないことを調べたいとします.</div>
2063. <div>
2064. <br /></div>
2065. <div>
2066.  x, yがInteger型なら, Integer型の変数のペアの範囲すべてについて網羅的に計算すれば(とりあえず)OKです. つまり, こんな簡単なプログラムに, Integer.MAX_VALUE * Integer.MAX_VALUE回も実行する必要があり, 現実的ではありません.</div>
2067. <div>
2068. <br /></div>
2069. <div>
2070.  しかし, 抽象解釈なら, 上の領域S = {0, Pos, Neg}について, 3 * 3の9通りについて調べればよく, (f(0, 0) = Posとか, f(Neg, Pos) = Negといったふうに計算します.) 上記のプログラムは, ゼロ除算が起きないことを, (抽象解釈の世界にいながらにして), 知ることができます. 同じように網羅的に調べているだけですが, 抽象化おかげで計算量が格段に減っています.</div>
2071. <div>
2072. <br /></div>
2073. <div>
2074.  もっとも, 現実の問題がここまでうまくいく筈もありませんが, 少なくともこのようなケースが存在することは, 抽象解釈のアプローチが, ある種の問題に対して, 有効であることを示唆していると思います.</div>
2075. </content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/4788145237634407596/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=4788145237634407596&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4788145237634407596'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4788145237634407596'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/01/blog-post.html' title='アンダースタンディング・コンピューテーション, メモと感想'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhytNRRtH0hwTrnEM5eEsnv6wB7t-w7q_zrGfWTnsx5P8xbOLQOMphlHDi0y5ZOKner91xL6JMi5MbMDp65bfc1YwyxxeeF50NGt3R2hM7eEsQv0TaS8SL9qI5Qeqyu18zTSWK8kU0tuKc/s72-c/slice1.PNG" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-4773478508096560714</id><published>2015-01-05T04:57:00.003+09:00</published><updated>2015-02-02T16:42:24.638+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="hylang"/><category scheme="http://www.blogger.com/atom/ns#" term="Lisp"/><category scheme="http://www.blogger.com/atom/ns#" term="nQueen問題"/><title type='text'>Hy(lang), Lisp風味のPythonを使ってみた</title><content type='html'>&amp;nbsp;hy(lang)は, Lispです.&lt;br /&gt;
2076. <div style="text-align: center;">
2077. <a href="https://github.com/hylang/hy">hylang/hy ･ GitHub</a></div>
2078. <div style="text-align: center;">
2079. <a href="https://hy.readthedocs.org/en/latest/">Welcome to Hy’s documentation!</a></div>
2080. <div style="text-align: center;">
2081. <br /></div>
2082.  公式にあるように, pipから簡単にトライできます.<br />
2083. <br />
2084. <div style="text-align: center;">
2085. <a href="https://hy.readthedocs.org/en/latest/quickstart.html">Quickstart - hy 0.10.1 documentation</a></div>
2086. <br />
2087.  以下の記事は, hyのversion 0.10.1についての内容です.<br />
2088. <br />
2089.  シンタックスは, 見た目, ほぼClojureにそっくりですが, cond, let式などをはじめとして, 微妙に異なる部分があるのと(どちらかといえばSchemeやRacketに近い), Python風の構文がいくつか含まれているなど, yet-another Clojureだと思ってプログラムを書こうとすると, 結構嵌まりました.<br />
2090. <br />
2091.  ClojureからNumpyとか使ってみたい気もしますが, ベースがPythonであることもあり, hylangは, Clojureとは別の道を歩もうとしているようです.<br />
2092. <br />
2093.  <a href="http://uid0130.blogspot.jp/search/label/nQueen%E5%95%8F%E9%A1%8C">何回も使いまわしています</a>が, 8Queen問題の解法のプログラムを, Clojureで,書くと以下のような感じになるところを, <br />
2094. <pre class="prettyprint lang-clj">;; slove the 8 queen problem
2095. (defn conflict? [x y others]
2096.  (and (not (empty? others))
2097.       (let [x1 (ffirst others) y1 (second (first others))]
2098.         (or (= x x1) (= y y1)
2099.             (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
2100.             (conflict? x y (rest others))))))
2101.  
2102. (defn put-a-queen [x y others]
2103.  (cond
2104.   (< 7 x) false
2105.   (not (conflict? x y others)) [x y]
2106.   :else (put-a-queen (inc x) y others)))
2107.  
2108. (defn solve [x1 y1 answer1]
2109.  (loop [x x1 y y1 answer answer1]
2110.    (let [rests (rest answer)]
2111.      (cond
2112.       (and (< 7 x) (= 0 y))
2113.       nil
2114.       (< 7 y)
2115.       (cons answer (solve (inc (ffirst answer)) (dec y) rests))
2116.       :else
2117.       (if-let [xy (put-a-queen x y answer)]
2118.         (recur 0 (inc y) (cons xy answer))
2119.         (recur (inc (ffirst answer)) (dec y) rests))))))
2120.  
2121. ;; make the list of solutions
2122. (def solutions (solve 0 0 []))</pre>
2123.  hyで書くと, 次のようになりました.<br />
2124. <pre class="prettyprint lang-clj">;; slove the 8 queen problem
2125. (require hy.contrib.loop)
2126. (require hy.contrib.anaphoric)
2127.  
2128. (defn conflict? [x y others]
2129.  (and (not (empty? others))
2130.       (let [[x1 (car (car others))] [y1 (car (cdr (car others)))]]
2131.          (or (= x x1) (= y y1)
2132.              (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
2133.              (conflict? x y (cdr others))))))
2134.  
2135. (defn put-a-queen [x y others]
2136.  (cond
2137.   [(< 7 x) false]
2138.   [(not (conflict? x y others)) [x y]]
2139.   [:else (put-a-queen (inc x) y others)]))
2140.  
2141. (defn solve [x1 y1 answer1]
2142.  (loop [[x x1] [y y1] [answer answer1]]
2143.    (let [[rests (cdr answer)]]
2144.      (cond
2145.        [(and (< 7 x) (= 0 y))
2146.         nil]
2147.        [(< 7 y)
2148.         (cons answer (solve (inc (car (car answer))) (dec y) rests))]
2149.        [:else
2150.         (ap-if (put-a-queen x y answer)
2151.           (recur 0 (inc y) (cons it answer))
2152.           (recur (inc (car (car answer))) (dec y) rests))]))))
2153.  
2154. ;; make the list of solutions
2155. (def solutions (solve 0 0 []))</pre>
2156.  ぱっと見は, Clojureとそっくりに書けることがわかります. もちろん, この書き方がhyの標準的なスタイルかどうかは分かりませんが. def/defnの記法は, Clojureと同じで, 大括弧([])を多様する書き方が, 全体をClojureっぽく見せているのだと思われます.<br />
2157. <br />
2158.  condとlet式の部分は, 要素を偶数個並べる書き方ではありません. condは, 条件式とそれに対応する節のペアを括弧で囲います. letも, 変数を表すシンボルと, 割り当てる値を計算する式をリストで組にしたものを並べます(この辺は, Clojure感覚で書いていると, エラーが続出して, 結構嵌まりました).<br />
2159. <strike> true/falseも, #t/#fではなく, true/falseのキーワードで表します.</strike> (Schemeと混同してました. 2015/02/02)<br />
2160. <pre class="prettyprint lang-clj">(defn put-a-queen [x y others]
2161.  (cond
2162.   [(< 7 x) false]
2163.   [(not (conflict? x y others)) [x y]]
2164.   [:else (put-a-queen (inc x) y others)]))</pre>
2165.  さらに, car/cdrが復活しています(ただし, first/restも使えます).  loop/recurスペシャルフォームが使えますが, デフォルトでは使えません. contribからロードする必要があります.<br />
2166. <pre class="prettyprint lang-clj">(require hy.contrib.loop)</pre>
2167.  こんな感じで, 割と表記上の問題は解決出来たのですが, リスト操作が不可解で, 結構難しかった印象です.<br />
2168. <br />
2169.  一つは, empty?の特殊さで, これはリストの長さを計るのですが, (= (len ls) 0)の結果を返します. リストにrestをかけるとitertools.isliceというオブジェクトが生成されますが, このitertools.isliceオブジェクト, countableではないようで, (empty? (rest [1 2]))などと書くとエラーが出ます. そもそもempty?は, リストの長さを数える必要がないのですが, この辺はまだ, 実装途中といった感じなのかもしれません.<br />
2170. <pre class="prettyprint lang-clj">=> (rest [1 2])
2171. <itertools.islice object at 0x271d208>
2172. => (empty? (rest [1 2]))
2173. Traceback (most recent call last):
2174.  File "<input>", line 1, in <module>
2175.  File "/home/uks/Dropbox/langs/lisps/hy/example/env/local/lib/python2.7/site-packages/hy/core/language.hy", line 124, in is_empty
2176.    (= 0 (len coll)))
2177. TypeError: object of type 'itertools.islice' has no len()
2178. => (cdr [1 2])
2179. [2L]</pre>
2180.  ちなみにcdrが返すのはitertools.isliceではないようです.<br />
2181. <br />
2182.  さらに, (憶測ですが)nil = Noneだったり, car ≠ first, cdr ≠ restだったり, 各関数がどのような内部クラスやオブジェクトの操作に対応しているのか知らないと, 嵌まるポイントがいくつかありました.<br />
2183. <pre class="prettyprint lang-clj">=> (first (rest (cons 1 None)))
2184. => (car (cdr (cons 1 None)))
2185. Traceback (most recent call last):
2186.  File "<input>", line 1, in <module>
2187.  File "/home/uks/Dropbox/langs/lisps/hy/example/env/local/lib/python2.7/site-packages/hy/models/list.py", line 43, in __getitem__
2188.    ret = super(HyList, self).__getitem__(item)
2189. IndexError: list index out of range</pre>
2190.  ネガティブなコメントが多くなってしまいましたが, 個人的には, Syntaxの観点から見ると, Clojureの書きにくかった部分が書きやすくなってるなーという印象です. Clojureは括弧の数を減らそうとしている箇所(cond, letなど)が多数見受けられますが, 逆にそこが仇となっている感じでしたがhylangでは元に戻っていました. リスト内包記法なんかも, Clojureのforとは比べ物にならないほど読みやすいです. リーダマクロも使い放題ですし.<br />
2191. <br />
2192.  同じ機能を持つ関数やスペシャルフォームが, 複数名前があることが多いです. 例えば, 前述したcar/firstやdefn/defun, do/prognなどがあります.<br />
2193. <br />
2194.  アナフォリックマクロが大量に定義されていて, contribをロードすると, 使えるようになります. anaphoricなのでapが頭につくみたいですね. ap-ifで, itに条件式の結果をbindします.<br />
2195. <pre class="prettyprint lang-clj">=> (require hy.contrib.anaphoric)
2196. => (ap-if true it false)
2197. True</pre>
2198. &lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/4773478508096560714/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=4773478508096560714&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4773478508096560714'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/4773478508096560714'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2015/01/hylang-lisppython.html' title='Hy(lang), Lisp風味のPythonを使ってみた'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-5979444267830605928</id><published>2014-12-31T20:07:00.001+09:00</published><updated>2015-02-10T20:17:29.427+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="Hylomorphism"/><category scheme="http://www.blogger.com/atom/ns#" term="nQueen問題"/><category scheme="http://www.blogger.com/atom/ns#" term="プログラム運算"/><category scheme="http://www.blogger.com/atom/ns#" term="リスト操作"/><title type='text'>ClojureでunfoldとHylomorphism</title><content type='html'>&lt;h3&gt;
2199. unfold</h3>
2200.  unfoldは, fold(reduce)の双対として定義される関数で, リストを生成する一種のジェネレータのような働きをするものです. 畳み込み関数に対応する, 要素を展開する関数とみなすことができます. Clojureだと<a href="http://clojuredocs.org/clojure.core/iterate">iterate</a>が一番近い関数でしょう.<br />
2201. <pre class="prettyprint lang-clj">user> (take 10 (iterate (partial + 2) 0))
2202. (0 2 4 6 8 10 12 14 16 18)</pre>
2203.  Haskellでは, foldが二種類あり, foldrとfoldlで, 右から畳み込みと左から畳み込みに対応しています. Clojureのreduceは, foldlに相当します. そして, foldr/foldlそれぞれにunfoldr/unfoldlが定義できますが, 以下の文章では, foldlを前提に話を進めます. (Haskellのfoldとunfoldrについては<a href="http://uid0130.blogspot.com/2014/07/haskell.html">ここ</a>で書いています.)<br />
2204. <br />
2205.  unfoldlをClojureで書くとしたら以下のような感じになると思います.<br />
2206. <pre class="prettyprint lang-clj">(defn unfoldl [pred g h start]
2207.   (map g (take-while #(not (pred %)) (iterate h start))))</pre>
2208.  計算を始めるオブジェクトと繰り返し適用するh, 生成したリストにmapをかけるためのgと, リストを終わらせる条件式predからなります. map gがtake-whileよりも後の処理になるのも重要な点です.<br />
2209. <br />
2210. <h3>
2211. Hylomorphism</h3>
2212.  Hylomorphismとは, <b>(代数的データ型へ)一般化された</b>foldとunfoldの合成のことで, <b>リストにおける</b>foldlとunfoldlについて,<br />
2213. <br />
2214. <div style="text-align: center;">
2215. hylol f e p g h = foldl f e . unfoldl p g h</div>
2216. <br />
2217. と書ける関数です. (太字部分 2015/01/08追記) unfoldlで生成したリストをfoldlで畳み込むような計算になります. map/reduceならぬ, generate(リスト生成)/map/reduceの処理が一つにまとまりました. Clojureだと次のようになります.<br />
2218. <pre class="prettyprint lang-clj">(defn hylol1
2219.  "hylol f e p g h = foldl f e . unfoldl p g h"
2220.  [f init pred g h start]
2221.  (reduce f init (unfoldl pred g h start)))</pre>
2222.  これだけだと, 抽象的な関数を組み合わせたまた別の抽象的なだけの関数といった印象しか残りません. しかし, Hylomorphismは, これを別のリストを使わないコードへ書き直すことができるのです.<br />
2223. <pre class="prettyprint lang-clj">(defn hylol2
2224.  [f e p g h b]
2225.  (if (p b)
2226.    e
2227.    (f (g b) (hylol2 f e p g h (h b)))))</pre>
2228.  これが, HylomorphismLの別の実装です.<br />
2229. <br />
2230.  foldlとunfoldlを組み合わせると当然, unfoldlで生成されたリストが, foldlにおいて, 畳み込まれてしまうため, 結果的に, 最終的な計算結果(戻り値)に不要なリストを計算途中で生成する必要が出てきてしまいます. しかし, 上記の2番目の実装では, リストを生成する様子がありません.<br />
2231. <br />
2232.  Hylomorphismの変換では, foldとunfoldの合成関数を, これと同等の意味を持つ｢リストを生成しないプログラム｣へ書き換えることでプログラムを高速化します. この辺はmap分配則と同じような感じですね.<br />
2233. <br />
2234.  例えば, 1〜100の和を計算するようなプログラムについて, foldl/unfoldlを使って,<br />
2235. <pre class="prettyprint lang-clj">(defn sum-from1to [n]
2236.  (reduce + 0 (unfoldl (partial = 0) identity dec n)))</pre>
2237.  と書けるわけですが, これをHylomorphismで書きなおしてみると, hylol2の実装を使って,<br />
2238. <pre class="prettyprint lang-clj">user> (hylol2 + 0 (partial = 0) identity dec 10)
2239. 55</pre>
2240. と書けます. これをhylol2の実装へ展開すると,<br />
2241. <pre class="prettyprint lang-clj">(defn hylol2-sum
2242.  [b]
2243.  (if ((partial = 0) b)
2244.    0
2245.    (+ (identity b) (hylol2-sum (dec b)))))</pre>
2246.  のように書きなおすことができて, foldl/unfoldlを使った場合に比べて素直な書き方になっていることがわかるかと思います.<br />
2247. <br />
2248.  ある意味では, Hylomorphismの変換とは, リストを使って抽象化した処理を, 素朴な再帰関数に書き戻す手法だとみなすことができます.<br />
2249. <br />
2250. <h3>
2251. Hylomorphismの変換例</h3>
2252.  さて, Hylomorphismの変換に関する一番の関心事は, 本当に高速化するのかという点と, 具体的にプログラムへ適用できるのかという点です. というわけで, 以下は, 8Queen問題のプログラムでHylomorphismを使ってみたケースです.<br />
2253. <br />
2254.  <a href="http://uid0130.blogspot.jp/2014/12/clojure8queen.html">前に書いた記事</a>の8Queen問題の解法では, バックトラックにより計算していましたが, 今回は, 素朴な総当り法を使います.<br />
2255. <br />
2256.  8Queen問題の解とは, 究極的には, 1〜8の数字の並び, だとみなすことができます. 例えば, x座標を固定した場合, 鳩の巣論法的に, 各x座標(= 1, 2, ... 8)には必ず一つQueenが入っている必要があるからです. というわけで, x座標の情報は不要になり, 順序を持ったy座標列が, 解となります.<br />
2257. <br />
2258.  というわけで, このプログラムでは, y座標のpermutationを与え, そこから, xy座標の組を計算し, その座標列が正しいかどうかを判定し, 正しければ解を返します. 以下がコードです.<br />
2259. <pre class="prettyprint lang-clj">(use 'clojure.math.combinatorics)
2260.  
2261. ;; unfoldl & hylomorphism
2262. (defn unfoldl [pred g h start]
2263.   (map g (take-while #(not (pred %)) (iterate h start))))
2264.  
2265. (defn hylol2
2266.  [f e p g h b]
2267.  (if (p b)
2268.    e
2269.    (f (g b) (hylol2 f e p g h (h b)))))
2270.  
2271. ;; 8 queen
2272. (defn conflict? [x y others]
2273.  (and (not (empty? others))
2274.       (let [x1 (ffirst others) y1 (second (first others))]
2275.         (or (= x x1) (= y y1)
2276.             (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
2277.             (conflict? x y (rest others))))))
2278.  
2279. (defn not-conflict? [ls]
2280.  (let [xy (first ls) others (rest ls)]
2281.    (not (conflict? (first xy) (second xy) others))))
2282.  
2283. (defn andf
2284.  ([a] a)
2285.  ([a b] (and a b)))
2286.  
2287. (defn correct-answer? [arrangement]
2288.  (reduce andf
2289.    (map not-conflict?
2290.      (take-while first (iterate rest arrangement)))))
2291.  
2292. (defn correct-answer?-v2 [arrangement]
2293.  (hylol2 andf true #(not (first %)) not-conflict? rest arrangement))
2294.  
2295. (defn check-and-cons [checker yss]
2296.  (let [arrangement (map list (range 8) yss)]
2297.    (if (checker arrangement) arrangement [])))
2298.  
2299. (defn get-correct-answers [permutations checker]
2300.  (filter first (map (partial check-and-cons checker) permutations)))
2301.  
2302. (def perm (doall (permutations (range 8))))
2303.  
2304. (def correct-answers
2305.  (get-correct-answers perm correct-answer?))
2306.  
2307. (def correct-answers-v2
2308.  (get-correct-answers perm correct-answer?-v2))</pre>
2309.  実行時間を計測してみると, 確かに高速化されていることがわかります. correct-answersの方が, foldl/unfoldl(に相当するもの)を使った場合で, correct-answers-v2がhylol2によりプログラム変換を行ったケースです.<br />
2310. <pre class="prettyprint lang-clj">user> (time (count correct-answers))
2311. "Elapsed time: 733.504269 msecs"
2312. 92
2313. user> (time (count correct-answers-v2))
2314. "Elapsed time: 592.678338 msecs"
2315. 92</pre>
2316.  上記の結果を見た場合, それ以外の部分でボトルネックになっている部分もありそうですが, Hylomorphismの変換により, 一応, 高速化ができていることが観察できました.<br />
2317. <br />
2318.  さて, 問題のプログラム変換は以下の部分で行っています. correct-answer?が, 素朴なfoldl/unfoldlで, correct-answer?-v2がリストを生成しないHylomorphismを使ったコードになります. correct-answer?の方にunfoldlというキーワードは見当たりませんが, map/take-while/iterateの組み合わせがそれに相当します.<br />
2319. <pre class="prettyprint lang-clj">(defn correct-answer? [arrangement]
2320.  (reduce andf
2321.    (map not-conflict?
2322.      (take-while first (iterate rest arrangement)))))
2323.  
2324. (defn correct-answer?-v2 [arrangement]
2325.  (hylol2 andf true #(not (first %)) not-conflict? rest arrangement))
2326. </pre>
2327. <div>
2328.  ここでは, [[1 2] [3 4] ...]のようなQueenの位置を表すリスト(arrangement)を受け取り, そこから, 部分リストを生成し(<b>iterate/take-while</b>), 各部分リストの｢先頭の要素｣と｢他の要素｣が衝突しないか(互いが取り合える位置にいないか)をチェックして(<b>map not-conflict?</b>), 矛盾しているケースがないかどうかをandf(andの関数版)で確認し(<b>reduce</b>), その答えの正解/不正解をboolで返すというものです.<br />
2329. <br />
2330.  例えば, 座標のリスト[p<sub>1</sub> p<sub>2</sub> ... p<sub>8</sub>]があるときに互いに衝突していないかを判定するためには, p<sub>1</sub>と[p<sub>2</sub> ... p<sub>8</sub>], p<sub>2</sub>と[p<sub>3</sub> ... p<sub>8</sub>], p<sub>3</sub>と[p<sub>4</sub> ... p<sub>8</sub>]と判定していくため, 上記のようなrestをiterateする実装になっています.<br />
2331. <br />
2332.  reduce, map. take-while, iterateが一堂に会しているので, 図らずともHylomorphismの変換が簡単にできました.</div>
2333. <br />
2334.  Hylomorphismの変換から得られる教訓(?)は, プログラム中に, ジェネレータによるリスト生成を行う部分があり, その先で, reduce(畳み込み関数)がそのリストを畳もうと待ち構えているとき, そのコードは, リストを使わないコードへ書き換えることができるかもしれない, ということです. そして, 書き換えたコードは, 余分な(本来の計算結果に不要な)データ構造の生成が不要になることで, 高速化できる筈だという結論です.<br />
2335. <br />
2336. <b>参考文献</b><br />
2337. <ul>
2338. <li>関数プログラミングの楽しみ, Jeremy Gibbons & Oege de Moor(編集), 山下 伸夫 (翻訳), オーム社, 2010/6/23</li>
2339. <ul>
2340. <li>ifphの続編(?), この記事の内容は本書のhylomorphismのセクションを元にかかれています.</li>
2341. </ul>
2342. <li><a href="http://ci.nii.ac.jp/naid/110003743241">構成的アルゴリズム論</a></li>
2343. <ul>
2344. <li>hyloだけでなく, map分配則などプログラム運算の様々な規則が紹介されています. チュートリアル.</li>
2345. </ul>
2346. <li><a href="http://www.matlux.net/blog/2014/05/04/anamorphic-adventure-in-clojure">Anamorphic Adventure in Clojure<span style="color: black;"> - Matlux</span></a></li>
2347. <ul>
2348. <li>Clojureで, Anamorphism(unfold相当)を定義する話. </li>
2349. </ul>
2350. </ul>
2351. &lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/5979444267830605928/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=5979444267830605928&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/5979444267830605928'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/5979444267830605928'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2014/12/clojureunfoldhylomorphism.html' title='ClojureでunfoldとHylomorphism'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-8997547567488107702</id><published>2014-12-30T03:30:00.001+09:00</published><updated>2014-12-30T03:48:36.597+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Karva Notation"/><category scheme="http://www.blogger.com/atom/ns#" term="遺伝的アルゴリズム"/><category scheme="http://www.blogger.com/atom/ns#" term="遺伝的プログラミング"/><title type='text'>Karva Notationという木構造を表す記法</title><content type='html'>&lt;div style=&quot;text-align: center;&quot;&gt;
2352. <br /></div>
2353. <div style="text-align: center;">
2354. <a href="http://stackoverflow.com/questions/11869206/parsing-karva-notation-in-haskell">Parsing Karva notation in haskell</a></div>
2355. <div style="text-align: center;">
2356. <a href="http://www.gene-expression-programming.com/Tutorial002.asp">Karva Notation and K-Expressions</a></div>
2357. <br />
2358.  今日, hylomorphismについて調べていたらKarva Notationという記法に出会った. 上がhylomorphismについてググっていたときに出てきた記事で, 下がKarva Notationの説明の記事.<br />
2359. <br />
2360.  一見すると, ポーランド記法のような書き方で, 演算子と識別子(変数?)を並べただけの書き方に見えますが, 例題の木構造とKarva Notationを見比べてみると, ポーランド記法とは全く別物です.<br />
2361. <br />
2362.  こんな感じの木構造に対して,<br />
2363.      +<br />
2364.    ┏━┓<br />
2365.    a   *<br />
2366.      ┏━┓<br />
2367.      /   d<br />
2368.   ┏━┓<br />
2369.   b   c<br />
2370. <div>
2371. <br /></div>
2372.  S式では,<br />
2373. <br />
2374.  (+ a (* (/ b c) d))<br />
2375. <br />
2376. と書くところを, Karva Notationは,<br />
2377. <br />
2378.  + a * / d b c<br />
2379. <br />
2380.  と表すようなのです. ポーランド記法だと, + a * / b c d になります.<br />
2381. <br />
2382.  この記法では [深さ0の要素(=木構造のトップ)] [深さ1の要素] ... ... [深さnの要素] の順で各深さのレベルにおいて, それぞれ左から要素を記述していくという書き方です.<br />
2383.  上記の例では,<br />
2384. <br />
2385.  [(木構造トップの) +] [(深さ1の) a (と) *]  [(深さ2の) / (と) d]  [(深さ3の) b (と) c]<br />
2386. <br />
2387.  で, + a * / d b c となるわけです.<br />
2388. <br />
2389.  こんな不思議な(可読性の低い)記法が, 何に使われるのかと思ったら, 遺伝的プログラミングでした.<br />
2390. <br />
2391. <div style="text-align: center;">
2392. <a href="http://ja.wikipedia.org/wiki/%E9%81%BA%E4%BC%9D%E7%9A%84%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%9F%E3%83%B3%E3%82%B0">遺伝的プログラミング - Wikipedia</a></div>
2393. <br />
2394.  遺伝的プログラミングは, Wikipediaにもあるように, 遺伝的アルゴリズムをプログラミングへ発展させたもので, プログラムを意味する遺伝子どうしを掛け合わせたり, 突然変異させたりして, プログラム(もしくは関数)を進化させて, 解を得るという手法です. プログラムを木構造(抽象構文木)として表現し, この木構造を遺伝子として扱うことで, プログラムどうしを交叉(遺伝子どうしの配合)させます.<br />
2395. <br />
2396.  そして, 普通, プログラム(関数)の遺伝子の表現は, S式など用いて行うわけですが, 上記のような Karva Notationによるプログラムの表現でも遺伝的プログラミングができる, ということのようです.<br />
2397. <br />
2398.  そう考えると, なかなか面白い記法ですね. SGAで使われるような0/1の遺伝子の表現と同じような単なる記号列なので, SGAと同じような文字列の1点交叉や2点交叉ができてしまいます.<br />
2399. <br />
2400. <b>参考文献</b><br />
2401. &lt;a href=&quot;http://www.gene-expression-programming.com/webpapers/GEP.pdf&quot;&gt;Gene Expression Programming: A New Adaptive Algorithm for Solving Problems&lt;/a&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/8997547567488107702/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=8997547567488107702&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8997547567488107702'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8997547567488107702'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2014/12/karva-notation.html' title='Karva Notationという木構造を表す記法'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-8554217856170085758</id><published>2014-12-26T05:08:00.001+09:00</published><updated>2014-12-26T05:08:58.533+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="ダイクストラ法"/><title type='text'>Clojureでダイクストラ法</title><content type='html'>&lt;div style=&quot;text-align: center;&quot;&gt;&lt;a href=&quot;http://ja.wikipedia.org/wiki/%E3%83%80%E3%82%A4%E3%82%AF%E3%82%B9%E3%83%88%E3%83%A9%E6%B3%95&quot;&gt;ダイクストラ法 - Wikipedia&lt;/a&gt;&lt;/div&gt;&lt;br /&gt;
2402.  ダイクストラ法, 与えられたグラフにおいて, ある頂点からそれ以外の各頂点への最短のパス(ルート)を求めるアルゴリズムの一つです.<br />
2403. <br />
2404. <ol><li>グラフの頂点を, 到達済み頂点のグループと, 未到達頂点のグループへ分割します.　到達済み頂点のグループの初期値は, 開始頂点1つからなるグループで, 未到達の頂点グループの初期値は, それ以外の頂点すべてを含んだグループになります.</li>
2405. <li>「到達済み頂点のグループのうち, どれかの頂点」(=vn)との間に「最も短い辺を持つ未到達の頂点」(=vm)を到達済み頂点のグループへ追加する. また, この辺を新しいルートとする. (開始点から新しく追加されたvmまでのパスは, 「開始点～vnまでのパス + 新しく追加された辺」となります.)</li>
2406. <li>未到達頂点のグループに要素がなければアルゴリズム終了. 未到達頂点のグループに要素があれば, 2へ.</li>
2407. </ol><br />
2408.  日本語で書くとこんな感じで, 未到達の頂点が1つづつ減っていって, すべての頂点へのルートが決定します.<br />
2409. <br />
2410.  なんとなく階層的クラスタリングに似ている気もしますが. 以下のような感じでダイクストラ法の実行結果が得られます. a～jがグラフ中の各点で隣の数字が開始点からの最短距離で, 赤線が開始点からの各点へのルートを表します. 黒線は, グラフに含まれているが, 最短ルートには含まれない辺. 例えば, c→jのルートは, c → d → a → j となります.<br />
2411. <br />
2412.  以下の図において, 各点は, (x,y)座標が与えられており, 各点間の距離(=辺の長さ)は二乗距離で定義されます. (つまり, 視覚的な距離と, 頂点間の距離(辺の長さ)がおおよそ対応しています.)<br />
2413. <div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiryE_HiwfbtpCpoXjef4UQMMwENE8lN4_u7YYnrKnvj1GRZ288J7VUGWg2SoVAqBjwhwaAwXGmoUSoWaRxGVlyI6XHRkV7BKqWTYQX4aUdLJkBOjMhCY7m5YF5SxIU2h60J4a7NKCRi6M/s1600/dj.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiryE_HiwfbtpCpoXjef4UQMMwENE8lN4_u7YYnrKnvj1GRZ288J7VUGWg2SoVAqBjwhwaAwXGmoUSoWaRxGVlyI6XHRkV7BKqWTYQX4aUdLJkBOjMhCY7m5YF5SxIU2h60J4a7NKCRi6M/s1600/dj.PNG" height="318" width="320" /></a></div> ナイーブなダイクストラ法の実装が以下のコードです. ダイクストラ法本体の実装より, グラフと実行結果可視化のコードの方がなぜか, 分量が多いですが.<br />
2414. <pre class="prettyprint lang-clj">(use '[clojure.core.match :only (match)]
2415.     '[clojure.math.numeric-tower :as math])
2416.  
2417. ;;---------------------------------------------------------------
2418. ;; find path
2419.  
2420. (defn mean-square [x1 x2 y1 y2]
2421.  (math/sqrt (+ (* (- x1 x2) (- x1 x2)) (* (- y1 y2) (- y1 y2)))))
2422.  
2423. (defn get-weights [routes points-with-coord]
2424.  (defn get-distance
2425.    [point-A point-B]
2426.    (let [a (get points-with-coord point-A)
2427.          b (get points-with-coord point-B)]
2428.      (mean-square (first a) (first b) (second a) (second b))))
2429.  (->> routes
2430.       (map #(get-distance (first %) (second %)))
2431.       (interleave routes)
2432.       (apply hash-map)))
2433.  
2434. (defn get-neighbors [routes]
2435.  (->> (concat (map reverse routes) routes)
2436.       (map vec)
2437.       sort
2438.       (group-by first)
2439.       (map (fn [x] (list (first x) (map second (second x)))))
2440.       (reduce concat)
2441.       (apply hash-map)))
2442.  
2443. (defn find-path [start routes vs weights]
2444.  
2445.  (defn length [u v]
2446.    (weights (sort (list u v))))
2447.  
2448.  (defn get-dist [x dp]
2449.    (get-in dp [x :dist]))
2450.  
2451.  (defn find-nearest [xs dp]
2452.    (->> (map (fn [x] [(get-dist x dp) x]) xs)
2453.         sort first second))
2454.  
2455.  (defn short-route? [u v dp]
2456.    (< (+ (length u v) (get-dist u dp)) (get-dist v dp)))
2457.  
2458.  (defn set-shorter [u v dp]
2459.    (assoc-in dp [v] {:dist (+ (get-dist u dp) (length u v)) :prev u}))
2460.  
2461.  (defn update-at [u dp v]
2462.    (if (short-route? u v dp) (set-shorter u v dp) dp))
2463.  
2464.  (let [distance-previous-data
2465.        (->> vs
2466.             (map #(list % {:dist Double/POSITIVE_INFINITY :prev nil}))
2467.             (apply concat) (apply hash-map)
2468.             (#(assoc-in % [start] {:dist 0 :prev nil})))]
2469.   (loop [q vs dp distance-previous-data]
2470.      (if (empty? q)
2471.        dp
2472.        (let [u (find-nearest q dp)
2473.              new (reduce (partial update-at u) dp (u (get-neighbors routes)))]
2474.          (recur (remove #(= u %) q) new))))))
2475.  
2476. ;;---------------------------------------------------------------
2477. (def spwc ;;sample-points-with-coord
2478.  {:a [20 80] :b [35 20] :c [80 40] :d [60 100] :e [70 10]
2479.   :f [10 60] :g [120 80] :h [20 35] :i [110 20] :j [0 120]})
2480.  
2481. (def sample-routes
2482.  (let [routes
2483.        [[:j :f] [:j :a] [:f :a] [:f :h]
2484.         [:a :d] [:d :g] [:g :c] [:c :d]
2485.         [:g :i] [:c :i] [:c :e] [:e :i]
2486.         [:a :h] [:h :b] [:b :e] [:b :c]]]
2487.    (map sort routes)))
2488.  
2489. ;; samples
2490. ;; (find-path :j sample-routes (keys spwc) (get-weights sample-routes spwc))
2491. ;; (find-path :c sample-routes (keys spwc) (get-weights sample-routes spwc))
2492.  
2493. ;;---------------------------------------------------------------
2494. ;; graph plot
2495.  
2496. (import (javax.swing JFrame))
2497. (import (java.awt Color))
2498. (import (java.awt Graphics))
2499. (import (java.awt Graphics2D))
2500. (import (java.awt Font))
2501.  
2502. (def radius 8)
2503.  
2504. (defn x-extend [x]
2505.  (+ (* (- x radius) 3) 50))
2506.  
2507. (defn y-extend [y]
2508.  (+ (- (* (- y radius) 3)) 400))
2509.  
2510. (defn vertex->str [key]
2511.  (apply str (rest (str key))))
2512.  
2513. ;; (plot-graph spwc sample-routes)
2514. (defn plot-graph [points route-pairs answer]
2515.  (let [window-size 450
2516.        font  (Font.  "Monospace" Font/BOLD 14)
2517.        frame (JFrame. "Route")
2518.        get-x #(+ radius (x-extend (first %1)))   ;; for draw-line
2519.        get-y #(+ radius (y-extend (second %1)))] ;; for draw-line
2520.  
2521.    (doto frame
2522.      (.setSize window-size window-size)
2523.      (.setVisible true)
2524.      (.setResizable false))
2525.    (Thread/sleep 100) ;; wait for the generateion of Window
2526.  
2527.    (def graphics (.. frame (getGraphics)))
2528.  
2529.    (defn plot-point [name]
2530.      (let [coord (name points)
2531.            r (* radius 2)
2532.            x-pos (x-extend (first  coord))
2533.            y-pos (y-extend (second coord))]
2534.  
2535.        (doto (cast Graphics2D graphics)
2536.          (.setColor (Color. 255 100 100))
2537.          (.fillOval x-pos y-pos r r)
2538.          (.setColor (Color. 100 190 190))
2539.          (.drawOval x-pos y-pos r r)
2540.          (.setColor Color/blue)
2541.          (.setFont font)
2542.          (.drawString
2543.           (->> answer name :dist round (str (vertex->str name) "="))
2544.           (+ x-pos 20) (+ y-pos 10)))))
2545.  
2546.    (defn draw-line [point-a point-b]
2547.      (let [a (point-a points) b (point-b points)]
2548.        (if (or (= point-b (:prev (point-a answer)))  ;; from b to a
2549.                (= point-a (:prev (point-b answer)))) ;; from a to b
2550.          (.setColor graphics Color/red)
2551.          (.setColor graphics Color/black))
2552.        (.drawLine graphics (get-x a) (get-y a) (get-x b) (get-y b))))
2553.  
2554.    ;; draw background
2555.    (doto graphics
2556.      (.setColor Color/white)
2557.      (.fillRect 0 0 window-size window-size))
2558.  
2559.    ;; draw route
2560.    (doall (map draw-line (map first route-pairs) (map second route-pairs)))
2561.  
2562.    ;; draw points
2563.    (doall (map plot-point (keys points)))
2564.  
2565.    (println "done!")))
2566.  
2567. ;;---------------------------------------------------------------
2568. ;; execution example
2569. (def from-a (find-path :a sample-routes (keys spwc) (get-weights sample-routes spwc)))
2570. (def from-c (find-path :c sample-routes (keys spwc) (get-weights sample-routes spwc)))
2571. (def from-e (find-path :e sample-routes (keys spwc) (get-weights sample-routes spwc)))</pre> こんな感じになりました. find-path関数で, 最短ルートとその距離を求めます. find-pathの一番目の引数は, 開始点. get-weights関数は, 各辺の重み(=距離)を計算しています. plot-graphでSwingにより, グラフを表示します.<br />
2572. <br />
2573.  以下のように実行します.<br />
2574. <pre class="prettyprint lang-clj">user> (load-file "find-path.clj")
2575. #'user/from-e
2576. user> (plot-graph spwc sample-routes from-e)
2577. done!
2578. nil
2579. user> (plot-graph spwc sample-routes from-a)
2580. done!
2581. nil</pre>というわけで実行結果. 開始点をaとすると,<br />
2582. <div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiTpibCJSE6VJ9pC3G7LHLF0czLbJ-PhXtOlO3YUuoCcb5HKEb12x31-YCVZHLwdQRmpka4HCN9DqWO_hTLs8y0uCYLHRX1-X3YoLVl_JAHg-rhDG8UmT8xBdpqgZ0Fm8spuHnscYTvE2U/s1600/froma.PNG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiTpibCJSE6VJ9pC3G7LHLF0czLbJ-PhXtOlO3YUuoCcb5HKEb12x31-YCVZHLwdQRmpka4HCN9DqWO_hTLs8y0uCYLHRX1-X3YoLVl_JAHg-rhDG8UmT8xBdpqgZ0Fm8spuHnscYTvE2U/s1600/froma.PNG" height="319" width="320" /></a></div><div class="separator" style="clear: both; text-align: left;">となり, 開始点をeとすると,</div><br />
2583. &lt;div class=&quot;separator&quot; style=&quot;clear: both; text-align: center;&quot;&gt;&lt;a href=&quot;https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg4Bw83th_AKFIwxUod16yrlDpSJU-I1r7lx89wWAcT4nxgqFGW-ZGkhkueFDjE_a_PadTtcr-C9GchJ2KnKULfyx8QcQr0s3weHJrFQJoyyWrMVdnHYP1vcxj2HHZ4HbCmiIHFfkMg12M/s1600/frome.PNG&quot; imageanchor=&quot;1&quot; style=&quot;margin-left: 1em; margin-right: 1em;&quot;&gt;&lt;img border=&quot;0&quot; src=&quot;https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg4Bw83th_AKFIwxUod16yrlDpSJU-I1r7lx89wWAcT4nxgqFGW-ZGkhkueFDjE_a_PadTtcr-C9GchJ2KnKULfyx8QcQr0s3weHJrFQJoyyWrMVdnHYP1vcxj2HHZ4HbCmiIHFfkMg12M/s1600/frome.PNG&quot; height=&quot;320&quot; width=&quot;317&quot; /&gt;&lt;/a&gt;&lt;/div&gt;こんな感じ.&lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/8554217856170085758/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=8554217856170085758&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8554217856170085758'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/8554217856170085758'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2014/12/clojure.html' title='Clojureでダイクストラ法'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><media:thumbnail xmlns:media="http://search.yahoo.com/mrss/" url="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiryE_HiwfbtpCpoXjef4UQMMwENE8lN4_u7YYnrKnvj1GRZ288J7VUGWg2SoVAqBjwhwaAwXGmoUSoWaRxGVlyI6XHRkV7BKqWTYQX4aUdLJkBOjMhCY7m5YF5SxIU2h60J4a7NKCRi6M/s72-c/dj.PNG" height="72" width="72"/><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4261787448062796649.post-553906605412714647</id><published>2014-12-26T02:11:00.001+09:00</published><updated>2014-12-26T02:11:43.643+09:00</updated><category scheme="http://www.blogger.com/atom/ns#" term="Clojure"/><category scheme="http://www.blogger.com/atom/ns#" term="正規表現"/><category scheme="http://www.blogger.com/atom/ns#" term="青空文庫"/><title type='text'>青空文庫のルビ取り(Clojure)と1重, 2重の括弧を認識する正規表現</title><content type='html'>&amp;nbsp;青空文庫のテキストファイルは, ルビが振ってあるため, 何か自然言語的な処理をする前段階として, ルビや本文に関係ないテキストのトリミングの作業が必要になります. この手のトリミングのプログラムはネット上にいくつかありますが, この記事もいくつかあるうちの一つです.&lt;br /&gt;
2584. <br />
2585.  正規表現では基本的に括弧は扱えないわけですが, 別に全く認識できないというわけではなくて, 任意のn回ネストした括弧が認識できないというだけです. つまり, {w | w = a<sup>n</sup>b<sup>n</sup>, n ∊自然数}みたいな言語のクラスが認識できません.<br />
2586. <br />
2587.   "((( ... ((( ))) ... )))"みたいな言語や"(( ... ) ( ... ))"のような言語(いずれも左右の括弧が正しく対応している場合). しかし, 1回ネストしているとか, 2回ネストしているとか, 有限回ネストしている括弧<b>だけ</b>の認識なら, 必ずしも不可能ではありません. しかも, かなりイディオム的に記述可能です.<br />
2588. <br />
2589.  Clojure(Java)の正規表現でルビ部分を認識する正規表現は,<br />
2590. <br />
2591. <div style="text-align: center;">《[^》]*》</div><br />
2592.  と書けます. 最初に開く括弧(《)を認識し, 閉じ括弧以外([^》]*)の文字からなる文字列を受け付けて, 閉じ括弧(<span style="text-align: center;">》)</span>が来たら, 括弧全体を認識するといった感じ.<br />
2593. <br />
2594.  余談ですが, 二回ネストしている括弧を認識する場合は, 以下のような感じになります.<br />
2595. <br />
2596. <div style="text-align: center;">《([^《^》]|(<span style="color: blue;">《[^》]*》</span>))*》</div><div style="text-align: left;"><br />
2597. </div><div style="text-align: left;"> 一重の括弧を認識する正規表現の中にもう一つ別の括弧を認識する正規表現(青い部分)が入っている感じです. 外側の開閉括弧間の文字列は, <span style="text-align: center;">([^《^》]|(</span><span style="color: blue; text-align: center;">《[^》]*》</span><span style="text-align: center;">))*で認識します. 三重括弧の場合は, </span><span style="color: blue; text-align: center;">[^》]*</span><span style="text-align: center;">の中を拡張して, </span><span style="text-align: center;">([^《^》]|(</span><span style="color: blue; text-align: center;">《[^》]*》</span><span style="text-align: center;">))*で書き換えれば, 三重括弧が認識できる要領になります.</span></div><div style="text-align: left;"><span style="text-align: center;"><br />
2598. </span></div><div style="text-align: left;"><span style="text-align: center;"> こんな感じで, スタックに積むように, 正規表現を伸ばしていけば, 有限回ネストする括弧の認識を正規表現で書くことができます.</span></div><br />
2599.  以下が実行例. 括弧(《》)の部分をparに書き換えます. 上から順に, 1重の括弧の認識, 1重の括弧の失敗例, 2重括弧の認識, 3重括弧の認識例です.<br />
2600. <pre class="prettyprint lang-clj">user> (clojure.string/replace "《some》 text 《》 here"  #"(《[^》]*》)" "par")
2601. "par text par here"
2602. user> (clojure.string/replace "《《text》》 《》"  #"《[^》]*》" "par")
2603. "par》 par"
2604. user> (clojure.string/replace "《《text》 abc 《text》》 《text》 《》"  #"《([^《^》]|(《([^《^》]|(《[^》]*》))*》))*》" "[]")
2605. "[] [] []"
2606. user> (clojure.string/replace "《《text》 abc 《text》》 《《text》 abc 《text《》》》 《text》 《》"  #"《([^《^》]|(《([^《^》]|(《[^》]*》))*》))*》" "[]")
2607. "[] [] [] []"
2608. </pre> というわけで, 青空文庫のテキストからルビとコメント［＃……］, バー(｜), 本文と関係ない部分を取り除くプログラム. <br />
2609. <pre class="prettyprint lang-clj">(use '[leiningen.exec :only (deps)])
2610.  
2611. (def top-bar
2612.  (re-pattern (apply str (take 55 (cycle "-")))))
2613.  
2614. (defn remove-top&bot [text]
2615.  (first (clojure.string/split (nth (clojure.string/split text top-bar) 2)
2616.                               #"\n\r\n\r\n\r\n")))
2617. (defn remove-pars [text]
2618.  (clojure.string/replace text #"｜|(《[^》]*》)|(［[^］]*］)" ""))
2619.  
2620. (defn file-in-out [trim-fn file-name]
2621.  (let [target-text (slurp file-name :encoding "shift-jis")
2622.        new-file-name (str file-name ".rr.txt")]
2623.    (println (trim-fn target-text))))
2624.  
2625. (file-in-out #(remove-pars (remove-top&bot %)) (second *command-line-args*))</pre> shift-jisなのでslurpで, エンコードの指定をする必要があります. また, 本文に関係ない部分のテキストもカットしてあります.<br />
2626. &lt;pre class=&quot;prettyprint&quot;&gt;C:\aozora&amp;gt;lein exec removepars.clj 夏目漱石//道草.txt &amp;gt; 道草nopar.txt&lt;/pre&gt;のようにして使います.&lt;script&gt;prettyPrint();&lt;/script&gt;</content><link rel='replies' type='application/atom+xml' href='https://uid0130.blogspot.com/feeds/553906605412714647/comments/default' title='コメントの投稿'/><link rel='replies' type='text/html' href='https://www.blogger.com/comment.g?blogID=4261787448062796649&amp;postID=553906605412714647&amp;isPopup=true' title='0 件のコメント'/><link rel='edit' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/553906605412714647'/><link rel='self' type='application/atom+xml' href='https://www.blogger.com/feeds/4261787448062796649/posts/default/553906605412714647'/><link rel='alternate' type='text/html' href='https://uid0130.blogspot.com/2014/12/clojure1-2.html' title='青空文庫のルビ取り(Clojure)と1重, 2重の括弧を認識する正規表現'/><author><name>yuwki0131</name><uri>http://www.blogger.com/profile/09012740807504010273</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='32' height='28' src='//blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhJpdFu54Kbk0ZJ6GnWAnwjb8jHS8Jj_39Yqw8ZvnmQ4fl8hR3HwDlRoE2KrgIP04fmd4LKncEpDhwvWQnIhQ0HDeZSEDEI5rDGpASzugB9IGee06kyd9LW3vHVjll-mTw/s128/*'/></author><thr:total>0</thr:total></entry></feed>

If you would like to create a banner that links to this page (i.e. this validation result), do the following:

1. Download the "valid Atom 1.0" banner.

2. Upload the image to your own server. (This step is important. Please do not link directly to the image on this server.)

3. Add this HTML to your page (change the image src attribute if necessary):

   <a href="http://www.feedvalidator.org/check.cgi?url=http%3A//uid0130.blogspot.jp/feeds/posts/default"><img src="valid-atom.png" alt="[Valid Atom 1.0]" title="Validate my Atom 1.0 feed" /></a>

If you would like to create a text link instead, here is the URL you can use:

http://www.feedvalidator.org/check.cgi?url=http%3A//uid0130.blogspot.jp/feeds/posts/default

Home · About · News · Docs · Terms