http://lisperati.com/haskell in clojure
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| [ | |
| [2,3,3,4,4,3,5,2,2,3,2,2,2,3,2,5,3,1,3,5,2,5,2,2,2,3,2,5,2,3], | |
| [2,3,3,2,3,3,5,2,3,4,2,2,1,1,1,2,1,5,1,4,2,5,2,2,2,2,4,1,1,1], | |
| [2,3,4,3,3,5,5,2,3,5,2,3,2,1,2,4,4,3,3,1,2,5,3,5,2,3,4,1,1,2], | |
| [1,3,3,3,3,3,3,3,4,4,3,3,4,4,2,3,3,3,1,4,3,4,3,3,2,1,3,2,3,3], | |
| [4,1,3,3,3,3,4,1,3,4,3,3,1,2,1,4,4,2,2,4,2,2,2,1,2,3,4,2,5,1], | |
| [2,1,1,2,3,5,4,1,1,1,2,3,5,1,3,2,4,2,3,5,2,5,2,2,2,3,4,2,2,4], | |
| [1,3,4,2,3,5,4,1,3,1,2,2,2,3,1,1,1,2,2,2,2,1,2,1,2,3,3,1,3,3], | |
| [3,3,3,1,3,2,2,1,2,3,2,3,2,3,2,3,3,5,2,1,2,5,2,1,2,1,4,2,2,2], | |
| [1,3,4,3,3,5,5,3,1,4,2,4,1,1,5,1,1,4,2,5,2,5,3,1,2,3,4,2,1,4], | |
| [1,3,4,2,4,5,4,3,2,1,3,4,1,1,4,5,4,5,3,4,2,2,2,1,2,3,3,4,1,4], | |
| [1,1,1,4,4,1,4,3,3,3,4,3,1,2,1,4,1,5,2,2,2,4,2,5,2,1,4,4,1,3], | |
| [2,2,1,3,4,3,4,2,5,2,3,3,3,2,5,2,3,5,2,3,1,1,4,1,2,3,4,1,3,2], | |
| [2,3,3,1,3,4,4,2,4,1,3,3,1,2,1,5,1,1,2,4,2,1,2,1,2,2,3,1,1,3], | |
| [1,3,2,1,3,2,3,2,3,3,3,3,4,2,5,1,4,5,3,4,2,5,2,1,2,3,4,5,1,4], | |
| [1,2,1,2,1,5,4,2,4,4,2,1,1,1,5,4,4,3,3,2,2,1,3,2,2,3,3,5,1,2], | |
| [5,3,4,4,3,2,4,3,1,5,4,2,5,1,1,2,4,3,3,4,2,5,4,2,2,3,3,3,1,4], | |
| [5,3,4,2,3,2,4,3,4,1,2,3,1,2,2,2,4,3,2,5,2,1,2,2,2,3,4,4,2,4], | |
| [3,3,3,1,3,2,5,2,5,3,3,2,2,3,5,3,4,5,2,4,1,5,2,2,2,2,4,3,2,3], | |
| [2,1,3,4,4,4,5,1,1,3,3,2,2,1,5,4,4,4,3,4,2,5,4,2,1,3,3,5,4,4], | |
| [1,3,3,1,3,2,3,2,1,5,4,4,1,3,5,2,4,5,2,5,2,5,1,2,2,2,3,2,1,4], | |
| [5,3,4,2,3,2,5,1,3,4,2,3,2,3,2,3,4,5,2,2,2,1,4,5,2,3,4,3,4,4], | |
| [5,3,3,4,4,3,5,3,1,1,3,3,1,1,2,4,4,1,2,1,2,4,2,2,1,3,3,2,1,4], | |
| [4,3,3,4,4,3,5,2,3,3,2,4,2,3,5,2,4,5,3,4,2,5,1,2,2,3,4,2,1,4], | |
| [1,3,4,3,4,4,5,3,5,3,3,1,1,2,1,4,4,2,2,5,2,1,3,2,2,3,3,5,1,2], | |
| [1,3,2,3,2,3,5,1,4,3,4,3,2,2,4,2,4,5,3,2,3,1,3,1,1,3,4,3,1,2], | |
| [1,2,3,2,3,1,4,3,1,5,3,2,5,2,4,2,1,2,2,5,2,5,2,2,2,3,4,4,1,3], | |
| [1,4,4,1,4,3,4,2,5,4,3,2,1,1,3,4,1,3,2,4,2,4,3,1,2,3,2,2,5,3], | |
| [3,4,3,2,4,3,5,2,2,4,3,2,1,1,3,2,4,3,2,5,2,2,2,1,2,3,4,5,1,4], | |
| [3,3,4,3,1,2,3,2,2,1,3,2,1,1,2,2,2,3,2,1,2,1,2,1,2,3,3,5,4,2], | |
| [3,3,4,1,4,5,2,2,3,4,3,3,1,2,3,4,3,4,3,2,3,5,1,1,2,3,4,2,1,1], | |
| [1,2,2,3,3,2,5,3,5,1,2,4,2,4,5,1,3,3,3,2,5,5,2,2,2,2,2,4,5,4], | |
| [1,4,3,2,3,5,3,3,4,3,4,4,5,3,1,4,2,1,3,4,1,1,4,1,2,3,3,3,1,1], | |
| [1,3,4,2,4,1,4,3,4,4,3,3,2,2,3,2,1,1,2,4,2,5,2,1,2,3,4,1,1,2], | |
| [1,3,5,2,4,2,2,1,1,1,3,2,3,2,2,3,1,3,3,4,4,1,4,2,2,3,3,3,4,1], | |
| [2,3,1,1,3,4,5,1,5,5,2,1,2,1,5,2,4,2,2,4,2,5,2,2,2,3,1,1,1,2], | |
| [4,3,2,2,4,3,5,2,4,3,3,4,5,2,3,2,1,3,2,5,2,5,2,2,2,3,3,5,2,2], | |
| [3,3,1,1,4,5,2,2,1,4,2,3,4,1,3,2,2,3,2,4,2,5,3,2,2,3,2,2,1,3], | |
| [1,2,2,4,2,2,4,2,4,3,2,3,1,1,5,2,4,3,3,4,1,5,1,1,2,3,2,4,4,4], | |
| [2,3,3,2,3,2,5,3,3,1,4,1,1,1,2,2,1,5,1,5,2,5,2,1,2,3,3,5,1,1], | |
| [1,1,5,1,3,2,4,2,5,1,3,4,1,2,5,4,3,4,2,4,4,1,2,1,2,1,3,5,1,4], | |
| [5,2,5,4,3,3,4,2,5,1,4,4,1,2,4,2,1,2,2,4,4,4,2,1,1,3,3,5,1,3], | |
| [4,3,3,1,4,2,3,2,3,4,3,3,1,2,2,5,1,3,2,4,4,2,1,5,2,2,4,5,1,4], | |
| [1,3,4,2,1,5,2,2,4,3,3,3,1,2,5,1,1,2,2,4,2,5,3,2,2,3,2,5,5,4], | |
| [1,2,4,4,2,3,5,1,3,3,2,3,2,3,3,2,4,3,2,2,2,1,2,1,2,3,4,5,1,3], | |
| [2,3,4,4,4,2,3,2,1,1,4,4,5,2,2,2,3,3,3,4,2,1,2,5,2,3,3,5,2,4], | |
| [1,1,2,4,5,2,5,2,3,4,2,1,3,1,3,5,3,3,2,2,1,5,4,5,2,3,3,4,5,2], | |
| [1,3,3,4,4,2,4,2,2,3,3,4,1,1,1,4,4,4,3,4,1,1,2,5,1,3,3,2,4,4], | |
| [2,3,2,4,2,2,4,3,1,1,3,3,5,2,3,5,1,5,2,4,2,5,3,2,1,3,3,3,1,4], | |
| [5,4,2,3,1,2,5,2,2,3,4,2,2,1,3,1,4,1,2,3,2,5,4,1,2,2,2,2,3,2], | |
| [5,1,4,3,1,2,3,2,4,3,2,3,2,1,3,2,4,4,3,1,2,2,2,2,1,3,3,5,1,1], | |
| [4,3,1,2,2,5,4,3,4,3,3,4,1,2,3,2,1,2,3,4,1,1,3,5,2,3,3,5,1,4], | |
| [1,3,3,3,3,2,5,2,4,4,2,2,2,3,2,4,4,5,2,4,2,5,4,2,1,3,4,3,4,2], | |
| [1,4,4,2,3,2,3,1,2,2,2,2,3,2,5,3,1,3,2,4,2,2,2,1,2,2,3,4,2,4], | |
| [5,3,2,3,4,5,4,3,1,3,3,3,5,2,4,5,5,4,3,2,2,1,3,2,1,3,3,2,2,2], | |
| [3,4,1,3,1,2,5,1,2,4,2,3,1,3,5,4,4,4,1,5,4,5,4,2,2,2,2,2,5,4], | |
| [3,4,4,2,2,1,4,2,5,3,3,3,1,3,5,3,4,3,1,5,2,1,2,5,2,3,4,5,1,3], | |
| [5,1,2,3,5,5,1,2,4,3,3,2,1,1,4,4,4,5,3,2,2,5,2,2,1,3,3,4,3,2], | |
| [5,2,2,3,5,2,3,2,3,3,3,4,3,4,5,1,3,5,3,4,1,1,4,1,2,3,2,2,4,2], | |
| [2,3,4,1,1,5,3,3,5,3,3,3,1,2,2,1,3,3,2,1,1,5,3,2,2,3,1,5,1,2], | |
| [1,3,3,2,1,3,5,2,3,1,4,2,3,2,3,2,1,5,2,2,2,1,2,2,1,2,3,2,4,2], | |
| [5,1,2,3,1,3,4,2,2,3,3,3,2,2,5,1,5,4,1,5,4,2,4,2,2,3,3,5,2,4], | |
| [3,2,4,3,4,3,2,2,4,1,1,2,1,3,1,5,1,3,2,2,1,5,2,2,2,3,4,4,2,4], | |
| [1,3,4,2,1,5,5,1,1,4,4,2,5,2,2,4,2,3,2,4,2,4,3,2,2,3,3,3,1,2], | |
| [2,2,4,3,3,2,5,2,4,4,2,4,2,3,5,3,4,5,2,2,2,5,2,2,2,3,4,1,3,1], | |
| [1,3,2,1,4,2,4,2,1,3,2,4,2,3,5,1,4,1,2,5,2,5,3,5,2,3,1,2,2,3], | |
| [2,3,1,2,4,2,4,2,4,1,3,3,1,1,2,5,2,2,2,2,5,1,2,2,1,2,3,5,5,3], | |
| [1,1,4,2,4,4,4,3,1,3,2,4,1,1,5,5,4,2,2,1,2,5,2,2,2,1,2,5,1,4], | |
| [3,3,3,3,4,3,2,2,3,3,3,1,3,2,1,1,1,5,1,5,3,2,4,2,2,2,3,4,1,1], | |
| [2,3,4,2,3,2,5,1,1,4,3,3,1,3,2,5,3,3,2,5,4,5,3,2,2,3,4,2,5,4], | |
| [1,1,5,1,1,5,5,2,1,4,3,1,2,1,3,5,4,1,3,2,2,5,1,2,2,2,3,1,1,4], | |
| [1,1,3,4,3,2,2,2,5,3,2,3,1,1,5,4,3,4,2,2,1,1,2,1,1,2,4,1,3,3], | |
| [3,3,5,2,2,2,4,2,1,2,2,3,1,2,5,4,1,1,2,5,2,5,2,1,2,3,3,2,1,3], | |
| [2,3,5,2,1,3,4,2,3,1,3,2,5,2,5,1,4,2,2,4,2,5,2,1,1,3,3,5,1,3], | |
| [3,1,4,4,4,2,5,2,1,1,3,4,1,2,3,4,3,4,3,2,2,2,3,1,1,3,2,5,4,3], | |
| [1,2,4,2,4,5,4,2,2,3,3,3,1,2,5,1,5,3,3,4,4,2,2,1,2,2,3,5,1,3], | |
| [3,3,5,2,4,5,4,2,4,1,3,2,2,1,1,1,4,3,2,4,2,1,1,1,2,3,3,3,1,3], | |
| [4,3,1,1,1,5,3,2,5,1,3,2,1,1,1,4,4,3,3,1,2,5,1,2,2,2,2,4,4,4], | |
| [2,3,4,4,5,2,3,2,4,3,4,3,1,4,1,2,1,3,2,1,4,4,3,1,2,3,3,5,4,4], | |
| [2,1,5,2,4,2,5,2,2,1,3,3,2,2,1,4,1,4,3,5,2,2,1,1,2,1,4,2,2,1], | |
| [2,1,4,2,5,5,2,1,2,3,3,2,1,1,5,4,3,1,2,5,1,1,3,1,1,3,2,5,2,4], | |
| [1,3,1,2,4,3,5,2,2,1,4,3,1,1,4,5,1,1,3,4,4,2,3,1,2,3,3,3,1,4], | |
| [1,1,4,2,5,5,2,2,5,2,3,2,1,2,5,4,1,1,2,4,1,2,2,5,2,2,3,1,1,3], | |
| [5,3,4,3,1,5,4,1,5,5,4,1,1,2,4,5,4,2,1,5,2,2,2,1,2,3,3,4,5,5], | |
| [1,1,2,3,5,5,4,1,5,4,2,2,4,4,5,4,4,4,2,4,2,5,3,4,2,3,2,5,2,3], | |
| [2,3,5,2,4,5,5,1,1,4,3,2,5,2,3,5,1,3,2,4,2,5,3,1,1,3,3,1,3,4], | |
| [3,3,1,2,4,4,4,3,4,1,4,1,1,2,4,2,1,4,2,4,2,1,1,1,2,3,3,5,1,1], | |
| [2,3,4,2,3,5,5,3,4,1,4,2,5,2,5,2,1,1,3,5,1,1,4,1,2,3,4,1,1,3], | |
| [2,1,3,2,4,2,4,1,4,3,4,4,2,2,5,3,5,5,1,2,1,4,2,2,1,2,3,5,5,2], | |
| [3,3,1,2,3,1,5,1,1,3,3,3,2,3,2,3,1,3,2,5,2,5,1,2,2,3,4,5,1,3], | |
| [1,2,3,3,1,3,5,2,5,3,4,3,5,2,1,3,4,1,2,5,2,1,1,2,2,3,3,3,1,1], | |
| [1,3,5,2,1,3,4,1,4,4,3,4,1,2,4,3,4,1,2,4,2,5,2,2,2,2,3,2,2,2], | |
| [3,1,3,2,5,3,3,1,4,2,3,3,1,2,5,3,4,5,2,4,5,5,4,2,2,3,3,3,4,1], | |
| [2,3,4,2,4,2,4,2,4,1,3,2,1,2,5,4,1,1,2,4,2,1,2,1,2,3,3,4,2,1], | |
| [2,3,4,2,3,1,2,2,1,1,2,3,5,2,5,1,1,5,2,5,3,1,2,2,2,3,3,5,4,1], | |
| [5,3,3,3,2,5,5,2,4,3,2,4,1,2,1,2,1,1,2,4,2,5,2,1,2,3,2,5,1,3], | |
| [1,1,3,2,4,5,4,1,4,3,3,4,5,2,4,2,4,3,2,4,5,2,2,2,1,2,2,4,1,1], | |
| [5,3,4,2,1,5,4,2,3,1,3,4,5,2,5,5,5,1,2,2,2,5,2,1,2,3,2,5,1,2], | |
| [1,2,3,2,3,2,4,1,4,1,3,3,1,3,5,1,1,5,1,2,2,1,4,1,1,2,2,4,4,3], | |
| [3,3,2,2,4,2,5,1,1,3,3,3,1,1,4,4,3,3,3,4,2,1,2,1,2,3,2,3,2,4], | |
| [5,2,1,2,1,5,2,1,2,5,1,2,1,2,3,5,4,3,2,4,1,5,2,1,1,2,2,2,3,3], | |
| [5,3,4,3,5,5,1,2,2,3,4,4,1,2,4,1,4,5,2,1,1,5,2,1,2,3,3,2,2,4], | |
| [3,3,4,3,4,3,1,1,3,1,2,3,1,2,3,5,5,3,2,4,2,2,1,1,2,2,2,2,1,2], | |
| [3,2,4,4,2,5,4,3,4,3,4,1,2,3,1,5,1,3,1,4,1,5,2,1,2,3,3,5,2,1], | |
| [2,3,4,3,3,5,5,1,4,1,2,3,5,2,2,1,1,2,1,5,2,5,2,1,2,3,1,2,1,3], | |
| [2,3,3,1,3,5,4,1,4,1,3,3,1,2,4,1,1,5,1,5,1,5,4,1,2,2,4,1,1,3], | |
| [5,1,4,3,1,4,4,2,5,3,2,4,2,2,2,1,2,3,2,2,1,1,3,2,2,3,3,3,1,4], | |
| [5,2,4,3,5,2,3,2,1,3,3,4,5,1,3,2,4,1,2,4,1,4,3,5,2,2,3,4,2,4], | |
| [1,3,3,2,5,3,2,1,2,5,4,2,5,2,5,1,1,3,1,5,4,4,2,1,2,2,3,1,2,3], | |
| [2,2,3,4,3,1,4,2,1,1,3,3,5,2,1,2,5,3,2,5,2,5,1,1,2,3,3,1,1,3], | |
| [2,3,3,2,3,3,4,2,1,4,2,4,1,1,5,2,1,5,1,4,2,5,2,1,2,3,3,3,2,3], | |
| [1,3,4,3,4,2,4,2,1,1,3,2,1,1,2,4,1,3,3,5,2,1,3,1,2,3,3,4,3,4], | |
| [4,1,3,4,4,5,4,2,5,1,3,3,5,2,5,3,5,1,3,2,3,2,3,1,2,3,3,5,1,3], | |
| [5,3,3,3,3,1,5,2,1,4,1,2,4,4,4,4,5,5,3,5,5,1,2,5,2,2,3,2,3,3], | |
| [1,4,3,2,1,2,2,3,4,3,3,2,1,2,4,1,1,2,1,4,5,1,2,2,1,3,2,5,3,3], | |
| [1,1,4,3,2,5,5,3,4,1,4,3,5,3,2,4,5,3,3,4,5,2,2,1,2,3,3,4,1,1], | |
| [1,4,5,2,4,2,4,3,3,2,2,4,1,2,1,2,3,1,2,4,5,2,4,1,2,3,3,5,4,1], | |
| [1,3,4,4,2,2,4,1,5,3,3,2,1,1,5,2,1,5,2,4,2,1,2,1,2,3,3,1,4,4], | |
| [4,3,3,2,4,3,4,1,4,3,2,3,5,2,5,5,1,2,2,4,2,5,2,3,1,3,2,5,5,4], | |
| [3,3,4,2,3,5,2,2,3,5,2,3,5,2,4,2,1,5,2,5,3,5,2,1,1,3,3,3,5,1], | |
| [3,3,5,2,1,3,5,2,4,5,4,4,4,1,1,2,1,2,1,4,4,2,3,5,1,1,3,2,1,1], | |
| [3,2,4,1,3,5,3,2,1,5,3,4,2,1,3,2,4,5,3,4,2,5,1,5,2,3,3,5,2,1], | |
| [2,3,5,2,4,4,4,2,4,1,2,2,5,2,2,2,4,3,2,1,2,2,2,1,2,3,2,5,2,1], | |
| [5,3,4,4,3,1,4,3,1,1,3,1,2,2,1,4,1,2,2,2,2,5,4,2,2,3,3,5,1,4], | |
| [1,3,4,2,4,2,2,2,4,3,3,3,1,1,1,2,4,1,3,2,2,5,2,1,2,3,4,4,4,4], | |
| [3,1,4,3,4,1,5,3,4,4,3,2,1,2,2,4,2,3,2,2,2,5,2,1,2,3,3,2,1,1], | |
| [3,4,3,2,4,2,4,2,5,1,3,3,5,3,5,1,4,5,3,2,2,2,2,2,2,2,4,5,2,4], | |
| [2,3,4,4,1,3,3,3,4,1,2,3,5,1,1,3,4,5,3,4,3,2,2,2,2,2,3,5,2,4], | |
| [2,2,4,3,2,4,5,2,3,3,3,3,2,2,4,5,5,1,2,5,2,1,4,5,2,3,1,5,4,4], | |
| [5,3,3,3,5,5,4,2,4,5,4,4,1,1,5,1,1,3,2,5,4,4,4,1,1,3,3,4,5,1], | |
| [1,1,4,4,2,3,4,1,2,3,3,3,4,2,4,1,4,5,2,2,2,4,4,2,2,2,3,5,2,4], | |
| [4,3,3,3,4,5,4,1,3,3,4,1,1,2,4,1,5,2,1,3,2,2,3,1,2,3,3,4,5,4], | |
| [1,2,4,1,3,3,3,2,2,5,2,3,2,2,3,1,4,3,2,5,2,1,3,2,2,3,2,5,2,3], | |
| [1,2,4,2,4,1,2,2,4,1,2,3,1,2,4,5,1,1,2,5,1,5,3,1,2,3,1,5,1,3], | |
| [2,3,5,2,2,1,4,3,5,4,4,1,1,2,3,5,4,1,2,4,5,5,4,1,1,3,3,5,5,1], | |
| [4,3,1,1,5,2,3,2,5,1,3,3,2,1,2,4,1,5,3,4,2,2,1,1,1,3,3,2,2,2], | |
| [4,3,4,2,3,3,2,2,4,3,3,2,1,2,5,2,1,4,2,2,5,2,3,1,2,2,4,5,4,2], | |
| [1,2,3,2,3,5,5,1,4,5,2,3,1,2,4,3,4,4,2,5,2,1,4,1,1,3,2,5,4,3], | |
| [4,3,3,1,2,3,5,1,5,1,3,3,4,2,1,1,2,3,1,4,2,2,4,5,2,3,4,4,4,3], | |
| [2,3,3,2,4,1,4,2,3,1,4,2,5,2,4,2,4,1,2,5,1,2,2,1,2,3,3,5,1,3], | |
| [5,3,4,2,4,5,4,2,1,3,3,2,1,2,5,5,5,1,2,2,1,1,2,2,2,3,2,4,1,4], | |
| [5,3,4,4,3,5,2,1,1,3,4,3,1,1,1,4,4,2,1,4,1,2,2,1,2,3,2,5,1,3], | |
| [5,4,4,4,2,5,2,1,5,3,4,2,4,2,3,3,1,3,2,5,4,2,4,4,2,1,3,5,1,3], | |
| [4,3,5,2,4,2,3,2,4,4,4,1,1,2,3,2,3,1,2,4,2,2,2,1,2,3,2,4,1,4], | |
| [1,1,4,2,2,1,5,2,1,1,2,2,1,2,5,4,1,2,2,2,2,5,2,1,2,3,3,1,2,3], | |
| [2,3,4,3,3,5,4,3,1,5,2,3,1,2,5,4,1,2,1,5,2,4,2,1,2,3,4,1,1,3], | |
| [3,3,1,1,2,4,4,2,4,3,2,3,1,2,3,2,5,2,2,2,1,5,2,1,1,3,4,3,1,3], | |
| [5,3,3,3,5,2,3,2,5,3,4,3,1,1,3,5,1,1,2,4,1,4,2,1,2,3,4,3,1,4], | |
| [1,1,4,3,3,5,2,1,4,5,3,3,5,2,2,1,1,2,2,5,2,5,2,1,2,2,3,1,5,3], | |
| [1,1,4,4,2,5,3,2,1,5,3,3,1,1,1,2,4,1,2,5,2,1,2,2,2,3,3,3,1,3], | |
| [3,3,4,3,4,3,4,2,3,1,4,4,1,2,1,5,1,3,3,4,2,1,2,2,2,3,3,4,2,1], | |
| [2,2,4,2,1,4,5,2,5,4,3,3,1,2,1,4,1,2,3,4,5,5,3,1,2,3,3,1,1,4], | |
| [2,3,3,4,5,5,3,2,2,5,3,1,1,1,3,5,4,1,1,4,2,5,2,5,2,3,4,4,2,4], | |
| [1,3,3,2,3,5,4,3,1,3,3,3,5,2,5,2,1,3,2,2,2,1,3,1,2,3,3,4,1,3], | |
| [1,2,2,4,4,5,5,2,5,3,3,3,1,2,2,5,1,1,3,4,1,1,1,1,2,3,2,5,2,4], | |
| [4,3,4,2,3,4,3,3,5,3,4,3,1,3,5,1,4,5,1,4,2,5,2,1,2,3,4,5,1,2], | |
| [1,3,4,4,5,4,3,2,2,1,2,1,1,1,3,5,4,5,2,4,2,5,4,2,2,3,2,5,5,4], | |
| [3,3,1,1,1,5,2,2,4,5,2,4,2,1,5,5,4,1,1,1,2,5,2,2,1,3,1,3,1,4], | |
| [3,2,4,3,4,5,5,2,3,4,4,1,1,1,2,4,4,3,2,5,2,1,2,2,2,3,2,4,1,5], | |
| [2,4,4,4,4,2,2,2,1,1,3,2,1,2,5,2,4,3,1,1,2,5,2,1,2,3,3,5,1,4], | |
| [3,3,3,1,1,2,4,1,4,3,2,2,1,2,3,5,1,5,2,5,2,5,3,1,2,3,2,5,2,2], | |
| [4,3,4,3,4,3,5,1,4,3,3,3,5,2,4,3,5,2,2,2,2,5,2,1,2,3,2,4,1,2], | |
| [1,3,1,1,2,4,3,3,1,1,3,2,1,1,2,5,4,3,3,1,2,5,3,1,1,3,3,3,2,3], | |
| [1,1,3,3,5,3,3,2,2,5,4,2,3,2,2,1,4,3,2,4,2,5,1,1,2,3,4,3,3,2], | |
| [2,1,4,1,5,2,5,1,3,5,2,3,2,1,4,5,5,1,2,4,2,5,3,5,2,3,2,2,1,4], | |
| [1,3,4,1,3,2,5,2,3,1,4,3,2,1,3,3,4,5,3,5,2,5,2,1,2,3,4,3,4,3], | |
| [1,2,4,2,4,2,4,2,2,2,3,4,1,2,2,5,4,4,3,4,5,5,2,1,2,3,3,5,2,3], | |
| [1,1,4,1,5,2,3,2,1,3,2,3,1,3,2,4,3,4,3,4,4,5,2,2,2,3,2,5,2,4], | |
| [4,1,3,4,3,5,4,2,1,1,3,3,5,2,5,2,1,3,2,1,2,1,1,1,2,2,2,5,1,4], | |
| [1,1,3,1,3,5,5,2,4,4,3,3,1,1,5,3,3,3,2,5,1,1,1,1,2,3,3,2,2,4], | |
| [5,1,4,2,4,3,4,2,1,3,3,3,5,1,1,5,3,1,2,4,2,1,2,2,2,3,3,3,3,4], | |
| [1,1,5,1,2,4,5,3,5,4,3,4,1,2,4,5,3,2,2,4,2,1,2,2,2,3,3,5,4,3], | |
| [1,2,4,1,2,4,2,2,4,4,2,2,4,3,3,1,4,1,3,5,2,5,2,1,2,2,3,5,5,3], | |
| [1,1,4,4,5,3,4,1,3,1,2,3,1,1,3,4,4,5,2,1,2,5,2,1,2,3,2,2,1,4], | |
| [1,3,1,4,1,5,3,2,4,5,3,3,1,1,3,2,1,3,2,4,2,5,2,1,2,3,4,2,1,2], | |
| [5,4,2,2,2,2,4,2,1,3,3,1,1,2,1,4,3,3,3,5,2,1,2,1,2,3,3,2,2,4], | |
| [2,3,4,3,1,3,3,2,3,1,3,3,1,1,2,4,5,3,2,2,1,2,2,2,2,2,3,2,2,2], | |
| [1,3,4,1,4,3,4,3,3,3,2,4,5,1,5,4,4,5,2,1,1,5,4,4,2,1,4,2,5,4], | |
| [2,2,4,1,5,5,5,2,1,2,2,3,3,1,4,4,1,3,3,1,4,5,4,2,2,3,2,4,2,2], | |
| [4,2,2,4,5,2,3,2,4,1,3,4,1,2,4,5,3,5,2,4,2,5,4,2,2,3,3,5,1,2], | |
| [3,3,4,4,4,2,3,2,3,3,3,2,5,1,3,4,3,5,1,4,2,1,2,1,2,3,3,5,1,2], | |
| [3,3,4,2,4,2,5,1,2,4,3,3,1,2,3,4,1,3,3,4,5,2,2,2,2,3,3,4,1,1], | |
| [4,3,2,2,4,4,4,2,2,2,3,2,5,1,1,2,1,1,2,4,2,2,2,1,2,3,3,5,1,3], | |
| [1,3,3,1,2,5,1,3,2,3,3,3,1,2,1,5,1,2,2,5,2,2,1,1,2,3,4,2,2,4], | |
| [2,3,4,2,1,4,3,2,1,3,3,3,1,2,1,4,4,2,2,1,2,5,2,1,2,3,2,5,2,2], | |
| [1,3,4,1,3,4,2,2,4,3,3,4,2,2,5,2,1,4,2,5,2,5,2,5,1,3,3,5,1,3], | |
| [1,3,3,3,5,3,5,1,1,3,4,4,3,3,2,3,2,5,2,1,2,5,4,4,2,3,3,5,2,2], | |
| [2,3,1,1,3,5,5,3,1,3,2,4,2,2,3,3,1,3,2,3,3,4,3,4,2,2,3,3,4,4], | |
| [5,3,2,2,2,4,5,2,2,3,3,3,1,2,3,5,1,1,2,1,2,2,2,2,1,3,2,5,2,2], | |
| [3,3,4,2,2,4,5,2,2,3,3,3,1,2,2,5,3,1,2,4,2,5,2,1,1,3,2,5,4,4], | |
| [1,1,4,3,4,5,5,2,5,3,3,3,4,2,1,3,4,5,2,3,2,5,2,2,2,3,3,3,4,4], | |
| [1,3,2,4,5,3,4,1,4,1,2,2,1,2,2,4,1,5,2,2,2,5,3,1,2,3,2,5,2,4], | |
| [2,3,3,3,4,3,5,3,4,3,2,3,1,2,3,2,1,4,2,2,2,1,3,5,2,3,2,3,1,4], | |
| [3,3,3,3,4,2,4,2,5,1,3,3,1,3,5,5,1,3,2,2,2,5,3,4,2,2,4,5,1,4], | |
| [3,4,2,1,4,3,5,1,5,1,2,3,5,2,5,2,4,5,3,5,2,5,1,5,2,3,2,5,4,4], | |
| [2,1,4,2,4,5,4,2,3,4,2,1,2,2,4,5,1,1,3,4,2,5,2,1,2,3,3,1,1,3], | |
| [1,4,3,1,4,4,5,3,5,1,2,3,2,2,5,5,4,5,2,5,5,5,2,1,2,2,4,5,5,4], | |
| [1,3,4,2,1,2,3,3,1,3,3,4,1,3,3,3,4,3,2,1,2,5,3,1,2,3,2,3,1,4], | |
| [3,3,4,2,4,5,2,2,4,1,2,4,5,2,1,4,1,1,3,1,2,5,2,1,1,3,3,4,1,2], | |
| [2,4,5,2,1,3,4,3,5,4,3,4,4,2,5,1,1,4,2,1,4,2,4,5,1,3,3,5,1,4], | |
| [3,3,2,4,5,2,1,2,1,3,2,4,1,2,3,5,4,3,2,4,2,1,2,2,2,3,3,5,2,2] | |
| ] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;;;; run with: | |
| ;;;; java -cp /path/to/clojure-jar/clojure-1.5.0-RC1.jar clojure.main picnic.clj | |
| ;; import Data.List | |
| ;; import Text.Regex | |
| ;; import System.Random | |
| ;; import Data.Ord | |
| ;; type Point = (Float,Float) | |
| ;; type Color = (Int,Int,Int) | |
| ;; type Polygon = [Point] | |
| ;; type Person = [Int] | |
| ;; type Link = [Point] | |
| ;; type Placement = [(Point,Person)] | |
| ;; type EnergyFunction a = a -> Int | |
| ;; type TemperatureFunction = Int -> Int -> Float | |
| ;; type TransitionProbabilityFunction = Int -> Int -> Float -> Float | |
| ;; type MotionFunction a = StdGen -> a -> (StdGen,a) | |
| ;; main = do | |
| ;; putStr "Hello World! Let's have a picnic! \n" | |
| ;; people_text <- readFile "people.txt" | |
| ;; let people :: [Person] | |
| ;; people = read people_text | |
| ;; putStr "Number of people coming: " | |
| ;; print (length people) | |
| (defn read-string-safe [s] | |
| (binding [*read-eval* false] | |
| (read-string s))) | |
| (prn "Hello, World! Let's have a picnic!") | |
| (def people (read-string-safe (slurp "people.edn"))) | |
| (prn "Number of people coming:" (count people)) | |
| ;; let writePoint :: Point -> String | |
| ;; writePoint (x,y) = (show x)++","++(show y)++" " | |
| ;; let writePolygon :: (Color,Polygon) -> String | |
| ;; writePolygon ((r,g,b),p) = "<polygon points=\""++(concatMap writePoint p)++"\" style=\"fill:#cccccc;stroke:rgb("++(show r)++","++(show g)++","++(show b)++");stroke-width:2\"/>" | |
| ;; let writePolygons :: [(Color,Polygon)] -> String | |
| ;; writePolygons p = "<svg xmlns=\"http://www.w3.org/2000/svg\">"++(concatMap writePolygon p)++"</svg>" | |
| ;; let colorize :: Color -> [Polygon] -> [(Color,Polygon)] | |
| ;; colorize = zip.repeat | |
| ;; let rainbow@[red,green,blue,yellow,purple,teal] = map colorize [(255,0,0),(0,255,0),(0,0,255),(255,255,0),(255,0,255),(0,255,255)] | |
| ;; writeFile "tut0.svg" $ writePolygons (blue [[(100,100),(200,100),(200,200),(100,200)],[(200,200),(300,200),(300,300),(200,300)]]) | |
| (defn write-point [[x y]] | |
| (str x "," y " ")) | |
| (require '[clojure.string :as string]) | |
| (defn write-polygon [[[r g b] p]] | |
| (str "<polygon points=\"" (string/join (map write-point p)) "\" style=\"fill:#cccccc;stroke:rgb(" r "," g "," b ");stroke-width:2\"/>")) | |
| (defn write-polygons [ps] | |
| (str "<svg xmlns=\"http://www.w3.org/2000/svg\">" (string/join (map write-polygon ps)) "</svg>")) | |
| (defn colorize [c ps] | |
| (map (partial vector c) ps)) | |
| (def rainbow (map (fn [c] | |
| (fn [p] | |
| (colorize c p))) [[255 0 0] [0 255 0] [0 0 255] [255 255 0] [255 0 255] [0 255 255]])) | |
| (def red (nth rainbow 0)) | |
| (def green (nth rainbow 1)) | |
| (def blue (nth rainbow 2)) | |
| (def yellow (nth rainbow 3)) | |
| (def purple (nth rainbow 4)) | |
| (def teal (nth rainbow 5)) | |
| (->> (write-polygons (blue [[[100 100] [200 100] [200 200] [100 200]] | |
| [[200 200] [300 200] [300 300] [200 300]]])) | |
| (spit "tut0.svg")) | |
| ;; let readPoint :: String -> Point | |
| ;; readPoint s | Just [x,y] <- matchRegex (mkRegex "([0-9.]+),([0-9.]+)") s = (read x,read y) | |
| ;; let readPolygon :: String -> Polygon | |
| ;; readPolygon = (map readPoint).(splitRegex $ mkRegex " L ") | |
| ;; let readPolygons :: String -> [Polygon] | |
| ;; readPolygons = (map readPolygon).tail.(splitRegex $ mkRegex "<path") | |
| ;; park_data <- readFile "park.svg" | |
| ;; let park = readPolygons park_data | |
| ;; writeFile "tut1.svg" $ writePolygons (green park) | |
| (defn read-point [s] | |
| (let [[_ x-str y-str] (re-find #"([0-9.]+),([0-9.]+)" s)] | |
| (map read-string-safe [x-str y-str]))) | |
| (defn read-polygon [s] | |
| (->> (string/split s #" L ") | |
| (map read-point))) | |
| (defn read-polygons [s] | |
| (->> (string/split s #"<path") | |
| rest | |
| (map read-polygon))) | |
| (def park (read-polygons (slurp "park.svg"))) | |
| (->> (write-polygons (green park)) | |
| (spit "tut1.svg")) | |
| ;; let triangulate :: Polygon -> [Polygon] | |
| ;; triangulate (a:b:c:xs) = [a,b,c]:triangulate (a:c:xs) | |
| ;; triangulate _ = [] | |
| ;; let triangles = concatMap triangulate park | |
| ;; writeFile "tut2.svg" $ writePolygons (purple triangles) | |
| (defn triangulate [[a b c & xs]] | |
| (if (and a b c) | |
| (conj (triangulate (concat [a c] xs)) [a b c]) | |
| [])) | |
| (def triangles (mapcat triangulate park)) | |
| (->> (write-polygons (purple triangles)) | |
| (spit "tut2.svg")) | |
| ;; let clipTriangle :: (Point -> Point -> Point) -> [Point] -> [Point] -> [Polygon] | |
| ;; clipTriangle i [] [a,b,c] = [] | |
| ;; clipTriangle i [a] [b,c] = [[a,i a b,i a c]] | |
| ;; clipTriangle i [a,b] [c] = [[a,i a c,b],[b,i a c,i b c]] | |
| ;; clipTriangle i [a,b,c] [] = [[a,b,c]] | |
| ;; let slice :: (Point -> Bool) -> (Point -> Point -> Point) -> [Polygon] -> ([Polygon],[Polygon]) | |
| ;; slice f i t = (clip f,clip $ not.f) | |
| ;; where clip g = concatMap ((uncurry $ clipTriangle i).(partition g)) t | |
| ;; let sliceX :: Float -> [Polygon] -> ([Polygon],[Polygon]) | |
| ;; sliceX x = slice ((x >).fst) interpolateX | |
| ;; where interpolateX (x1,y1) (x2,y2) = (x,y1+(y2-y1)*(x-x1)/(x2-x1)) | |
| ;; let sliceY :: Float -> [Polygon] -> ([Polygon],[Polygon]) | |
| ;; sliceY y = slice ((y >).snd) interpolateY | |
| ;; where interpolateY (x1,y1) (x2,y2) = (x1+(x2-x1)*(y-y1)/(y2-y1),y) | |
| ;; let (left_side,right_side) = sliceX 200 triangles | |
| ;; writeFile "tut3.svg" $ writePolygons $ (red left_side) ++ (blue right_side) | |
| ;;;; This is different from the Haskell code. split? splits the | |
| ;;;; triangles into the triangles left of the split line and right of | |
| ;;;; the split line (this could also be above or below of the split | |
| ;;;; line for the vertical case). Triangles that are intersected by the | |
| ;;;; split? are split into smaller triangles in the appropriate part, | |
| ;;;; based on how many of the three points of each triangle are on | |
| ;;;; each side. | |
| (defn slice [split? split ps] | |
| (reduce | |
| (fn [[keep-left keep-right] p] | |
| (let [left (filter split? p) | |
| right (remove split? p)] | |
| (condp = (count left) | |
| 0 [keep-left (conj keep-right p)] | |
| 1 (let [[a] left | |
| [b c] right | |
| ab (split a b) | |
| ac (split a c)] | |
| [(conj keep-left [a ab ac]) | |
| (conj keep-right [ab ac c] [b ab c])]) | |
| 2 (let [[a b] left | |
| [c] right | |
| ac (split a c) | |
| bc (split b c)] | |
| [(conj keep-left [a b ac] [b ac bc]) | |
| (conj keep-right [ac bc c])]) | |
| 3 [(conj keep-left p) keep-right]))) | |
| [[] []] | |
| ps)) | |
| (defn slice-x [x ps] | |
| (let [interpolate-x (fn [[x1 y1] [x2 y2]] | |
| [x (+ y1 (/ (* (- y2 y1) (- x x1)) | |
| (- x2 x1)))])] | |
| (slice (fn [[px _]] | |
| (> x px)) interpolate-x ps))) | |
| (defn slice-y [y ps] | |
| (let [interpolate-y (fn [[x1 y1] [x2 y2]] | |
| [(+ x1 (/ (* (- x2 x1) (- y y1)) | |
| (- y2 y1))) y])] | |
| (slice (fn [[_ py]] | |
| (> y py)) interpolate-y ps))) | |
| (let [[left-side right-side] (slice-x 200 triangles)] | |
| (->> (write-polygons (concat (red left-side) | |
| (blue right-side))) | |
| (spit "tut3.svg"))) | |
| ;; let boundingRect :: [Polygon] -> (Float,Float,Float,Float) | |
| ;; boundingRect p = (minimum xs,minimum ys,maximum xs,maximum ys) | |
| ;; where xs = map fst $ concat p | |
| ;; ys = map snd $ concat p | |
| ;; let halveTriangles :: Int -> [Polygon] -> ([Polygon],[Polygon]) | |
| ;; halveTriangles n p = let (l,t,r,b) = boundingRect p | |
| ;; f = fromIntegral n | |
| ;; h = fromIntegral $ div n 2 | |
| ;; in if r-l > b-t | |
| ;; then sliceX ((r*h+l*(f-h))/f) p | |
| ;; else sliceY ((b*h+t*(f-h))/f) p | |
| ;; let distance :: Point -> Point -> Float | |
| ;; distance p1 p2 = sqrt (deltax*deltax+deltay*deltay) | |
| ;; where deltax = (fst p1)-(fst p2) | |
| ;; deltay = (snd p1)-(snd p2) | |
| ;; let area :: Polygon -> Float | |
| ;; area [a,b,c] = let x = distance a b | |
| ;; y = distance b c | |
| ;; z = distance c a | |
| ;; s = (x+y+z)/2 | |
| ;; in sqrt (s*(s-x)*(s-y)*(s-z)) | |
| ;; let allocatePeople :: Int -> [Polygon] -> [[Polygon]] | |
| ;; allocatePeople 0 t = [] | |
| ;; allocatePeople 1 t = [t] | |
| ;; allocatePeople n t = let (t1,t2) = halveTriangles n t | |
| ;; a1 = sum $ map area t1 | |
| ;; a2 = sum $ map area t2 | |
| ;; f = round $ (fromIntegral n)*a1/(a1+a2) | |
| ;; in (allocatePeople f t1)++(allocatePeople (n-f) t2) | |
| ;; let lots = allocatePeople (length people) triangles | |
| ;; writeFile "tut4.svg" $ writePolygons $ concat $ zipWith ($) (cycle rainbow) lots | |
| (defn bounding-rect [ps] | |
| (let [xs (map first (apply concat ps)) | |
| ys (map second (apply concat ps))] | |
| [(apply min xs) (apply min ys) | |
| (apply max xs) (apply max ys)])) | |
| (defn halve-triangles [n p] | |
| (let [[l t r b] (bounding-rect p) | |
| h (quot n 2)] | |
| (if (> (- r l) | |
| (- b t)) | |
| (let [cut (/ (+ (* r h) | |
| (* l (- n h))) n)] | |
| (slice-x cut p)) | |
| (let [cut (/ (+ (* b h) | |
| (* t (- n h))) n)] | |
| (slice-y cut p))))) | |
| (defn distance [[p1x p1y] [p2x p2y]] | |
| (let [deltax (- p1x p2x) | |
| deltay (- p1y p2y)] | |
| (Math/sqrt (+ (* deltax deltax) | |
| (* deltay deltay))))) | |
| (defn area [[a b c]] | |
| (let [x (distance a b) | |
| y (distance b c) | |
| z (distance c a) | |
| s (/ (+ x y z) 2)] | |
| (Math/sqrt (* s (- s x) (- s y) (- s z))))) | |
| (defn allocate-people [n t] | |
| (cond | |
| (= n 0) [] | |
| (= n 1) [t] | |
| :else (let [[t1 t2] (halve-triangles n t) | |
| a1 (reduce + (map area t1)) | |
| a2 (reduce + (map area t2)) | |
| f (Math/round (/ (* n a1) (+ a1 a2)))] | |
| (concat | |
| (allocate-people f t1) | |
| (allocate-people (- n f) t2))))) | |
| (def lots (allocate-people (count people) triangles)) | |
| (->> (write-polygons (mapcat (fn [f ps] (f ps)) (cycle rainbow) lots)) | |
| (spit "tut4.svg")) | |
| ;; let findLotCenter :: [Polygon] -> Point | |
| ;; findLotCenter p = let (l,t,r,b) = boundingRect p | |
| ;; m@(x,y) = ((r+l)/2,(b+t)/2) | |
| ;; (lh,rh) = sliceX x p | |
| ;; (th,bh) = sliceY y $ lh ++ rh | |
| ;; centerOrder p1 p2 = compare (distance p1 m) (distance p2 m) | |
| ;; in minimumBy (comparing $ distance m) $ concat $ th ++ bh | |
| ;; let makeDot :: Point -> Polygon | |
| ;; makeDot (x,y) = [(x-2,y-2),(x+2,y-2),(x+2,y+2),(x-2,y+2)] | |
| ;; let centers = map findLotCenter lots | |
| ;; let spots = blue $ map makeDot centers | |
| ;; writeFile "tut5.svg" $ writePolygons $ (green park) ++ spots | |
| (defn find-lot-center [p] | |
| (let [[l t r b] (bounding-rect p) | |
| [x y :as m] [(/ (+ r l) 2) (/ (+ b t) 2)] | |
| [lh rh] (slice-x x p) | |
| [th bh] (slice-y y (concat lh rh))] | |
| (apply min-key (partial distance m) (apply concat (concat th bh))))) | |
| (defn make-dot [[x y]] | |
| [[(- x 2) (- y 2)] [(+ x 2) (- y 2)] [(+ x 2) (+ y 2)] [(- x 2) (+ y 2)]]) | |
| (def centers (map find-lot-center lots)) | |
| (def spots (blue (map make-dot centers))) | |
| (->> (write-polygons (concat (green park) | |
| spots)) | |
| (spit "tut5.svg")) | |
| ;; let shortestLinks :: Int -> [Link] -> [Link] | |
| ;; shortestLinks n = (take n).(sortBy $ comparing linkLength) | |
| ;; where linkLength [a,b] = distance a b | |
| ;; let sittingNeighbors :: Int -> [Point] -> [Link] | |
| ;; sittingNeighbors n p = nub $ shortestLinks (n * (length p)) [[a,b] | a <- p, b <- p, a /= b] | |
| ;; let sitting = sittingNeighbors 4 centers | |
| ;; writeFile "tut6.svg" $ writePolygons $ (green park) ++ spots ++ (red sitting) | |
| (defn shortest-links [n ls] | |
| (take n (sort-by (fn [[a b]] (distance a b)) ls))) | |
| (defn sitting-neighbors [n p] | |
| (distinct (shortest-links (* n (count p)) | |
| (for [a p | |
| b p | |
| :when (not= a b)] | |
| [a b])))) | |
| (def sitting (sitting-neighbors 4 centers)) | |
| (->> (write-polygons (concat (green park) | |
| spots | |
| (red sitting))) | |
| (spit "tut6.svg")) | |
| ;; let walkingNeighbors :: Int -> [Point] -> [Link] | |
| ;; walkingNeighbors n l = nub $ concatMap myNeighbors l | |
| ;; where myNeighbors :: Point -> [Link] | |
| ;; myNeighbors p = shortestLinks n [sort [p,c] | c <- l, p /= c] | |
| ;; let walking = walkingNeighbors 4 centers | |
| ;; writeFile "tut7.svg" $ writePolygons $ (green park) ++ spots ++ (red walking) | |
| (defn walking-neighbors [n l] | |
| (let [my-neighbors (fn [p] | |
| (shortest-links 4 (for [c l | |
| :when (not= c p)] | |
| [p c])))] | |
| (distinct (mapcat my-neighbors l)))) | |
| (def walking (walking-neighbors 4 centers)) | |
| (->> (write-polygons (concat (green park) | |
| spots | |
| (red walking))) | |
| (spit "tut7.svg")) | |
| ;; let starting_placement = zip centers people | |
| ;; let mismatches :: Person -> Person -> Int | |
| ;; mismatches a b = length $ filter (uncurry (/=)) $ zip a b | |
| ;; let similarityColor :: Person -> Person -> Color | |
| ;; similarityColor p1 p2 = let m = mismatches p1 p2 | |
| ;; h = div (length p1) 2 | |
| ;; d = 30 * (abs (h - m)) | |
| ;; b = max 0 (255-d) | |
| ;; o = min d 255 | |
| ;; in if m < h | |
| ;; then (0,o,b) | |
| ;; else (o,0,b) | |
| ;; let findPerson :: Placement -> Point -> Person | |
| ;; findPerson a p | Just (_,e) <- find ((== p).fst) a = e | |
| ;; let similarityLine :: Placement -> Link -> (Color,Polygon) | |
| ;; similarityLine l [p1,p2] = (similarityColor (findPerson l p1) (findPerson l p2),[p1,p2]) | |
| ;; writeFile "tut8.svg" $ writePolygons $ map (similarityLine starting_placement) sitting | |
| (def starting-placement (map list centers people)) | |
| (defn mismatches [a b] | |
| (reduce + 0 (for [[i j] (map list a b) | |
| :when (not= i j)] | |
| 1))) | |
| (defn similarity-color [p1 p2] | |
| (let [m (mismatches p1 p2) | |
| h (quot (count p1) 2) | |
| d (* 30 (Math/abs (- h m))) | |
| b (max 0 (- 255 d)) | |
| o (min d 255)] | |
| (if (< m h) | |
| [0 o b] | |
| [o 0 b]))) | |
| (defn find-person [a p] | |
| (some (fn [[i e]] | |
| (when (= i p) | |
| e)) a)) | |
| (defn similarity-line [l [p1 p2]] | |
| [(similarity-color (find-person l p1) (find-person l p2)) [p1 p2]]) | |
| (->> (write-polygons (map (partial similarity-line starting-placement) sitting)) | |
| (spit "tut8.svg")) | |
| ;; let picnicEnergy :: [Link] -> EnergyFunction Placement | |
| ;; picnicEnergy l a = sum $ map linkEnergy l | |
| ;; where linkEnergy :: Link -> Int | |
| ;; linkEnergy [p1,p2] = mismatches (findPerson a p1) (findPerson a p2) | |
| ;; let picnicMotion :: [Link] -> MotionFunction Placement | |
| ;; picnicMotion l r a = let (n,r2) = randomR (0,(length l)-1) r | |
| ;; [p1,p2] = l!!n | |
| ;; in (r2,(p1,findPerson a p2):(p2,findPerson a p1):(filter (not.((flip elem) [p1,p2]).fst) a)) | |
| ;; let picnicTemperature :: TemperatureFunction | |
| ;; picnicTemperature m c = 50.0 * (exp (0.0 - (5.0 * ((fromIntegral c) / (fromIntegral m))))) | |
| ;; let picnicTransitionalProbability :: TransitionProbabilityFunction | |
| ;; picnicTransitionalProbability e1 e2 t = exp ((fromIntegral (e1 - e2)) / t) | |
| ;; let annealing_time = 500 | |
| ;; putStr "starting energy: " | |
| ;; print $ picnicEnergy sitting starting_placement | |
| ;; putStr "starting temperature: " | |
| ;; print $ picnicTemperature annealing_time annealing_time | |
| (defn picnic-energy [l a] | |
| (let [link-energy (fn [[p1 p2]] | |
| (mismatches (find-person a p1) | |
| (find-person a p2)))] | |
| (reduce + (map link-energy l)))) | |
| (defn picnic-motion [l r a] | |
| (let [n (.nextInt r (count l)) | |
| [p1 p2] (nth l n)] | |
| [r (concat [[p1 (find-person a p2)] [p2 (find-person a p1)]] | |
| (for [p a | |
| :when (and (not= p p1) | |
| (not= p p2))] | |
| p))])) | |
| (defn picnic-temperature [m c] | |
| (* 50.0 (Math/exp (- 0.0 (* 5.0 (/ c m)))))) | |
| (defn picnic-transitional-probability [e1 e2 t] | |
| (Math/exp (/ (- e1 e2) t))) | |
| (def annealing-time 500) | |
| (prn "starting energy: " (picnic-energy sitting starting-placement)) | |
| (prn "starting temperature: " (picnic-temperature annealing-time annealing-time)) | |
| ;; let anneal_tick :: MotionFunction a -> TransitionProbabilityFunction -> EnergyFunction a -> Float -> (StdGen,a) -> (StdGen,a) | |
| ;; anneal_tick mf tpf ef t (r,p) = let (r2,p2) = mf r p | |
| ;; (n ,r3) = random r2 | |
| ;; in (r3, | |
| ;; if n < tpf (ef p) (ef p2) t | |
| ;; then p2 | |
| ;; else p) | |
| ;; let anneal :: EnergyFunction a -> MotionFunction a -> TransitionProbabilityFunction -> TemperatureFunction -> Int -> StdGen -> a -> a | |
| ;; anneal ef mf tpf tf m r s = snd $ foldl' (flip (anneal_tick mf tpf ef)) (r,s) (map (tf m) [0..m]) | |
| ;; random_generator <- getStdGen | |
| ;; putStr "starting annealing... " | |
| ;; putStr "number of annealing steps: " | |
| ;; print annealing_time | |
| (defn anneal-tick [mf tpf ef t [r p]] | |
| (let [[r2 p2] (mf r p) | |
| [n r3] [(.nextDouble r) r]] | |
| [r3 (if (< n (tpf (ef p) (ef p2) t)) | |
| p2 | |
| p)])) | |
| (defn anneal [ef mf tpf tf m r s] | |
| (second (reduce | |
| (fn [state t] | |
| (anneal-tick mf tpf ef t state)) | |
| [r s] | |
| (map (partial tf m) (range m))))) | |
| (def random-generator (java.util.Random.)) | |
| (prn "Starting annealing... ") | |
| (prn "Number of annealing steps: " annealing-time) | |
| ;; let ideal_placement = anneal | |
| ;; (picnicEnergy sitting) | |
| ;; (picnicMotion walking) | |
| ;; picnicTransitionalProbability | |
| ;; picnicTemperature | |
| ;; annealing_time | |
| ;; random_generator | |
| ;; starting_placement | |
| ;; writeFile "tut9.svg" $ writePolygons $ map (similarityLine ideal_placement) sitting | |
| ;; putStr "Done!\nfinal energy: " | |
| ;; print $ picnicEnergy sitting ideal_placement | |
| ;; putStr "final temperature: " | |
| ;; print $ picnicTemperature 0 annealing_time | |
| (def ideal-placement | |
| (anneal | |
| (partial picnic-energy sitting) | |
| (partial picnic-motion walking) | |
| picnic-transitional-probability | |
| picnic-temperature | |
| annealing-time | |
| random-generator | |
| starting-placement)) | |
| (->> (write-polygons (map (partial similarity-line ideal-placement) sitting)) | |
| (spit "tut9.svg")) | |
| (prn "Done final energy: " (picnic-energy sitting ideal-placement)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment