http://lisperati.com/haskell in clojure

park.svg

<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
   xmlns:svg="http://www.w3.org/2000/svg"
   xmlns="http://www.w3.org/2000/svg"
   version="1.0"
   width="600"
   height="342"
   id="svg2160">
  <defs
     id="defs2163" />
  <path
     d="M 106.7619,131.19048 L 17.190476,96.809524 L 22.619047,71.47619 L 34.380952,47.952381 L 46.142857,39.809524 L 157.42857,105.85714 L 106.7619,131.19048 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2199" />
  <path
     d="M 17.190476,96.809524 L 106.7619,131.19048 L 85.047619,188.19048 L 17.190476,187.28571 L 17.190476,96.809524 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2169" />
  <path
     d="M 142.04762,250.61905 L 76,197.2381 L 16.285714,199.04762 L 15.380952,265.09524 L 26.238095,287.71429 L 45.238095,298.57143 L 142.04762,250.61905 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2171" />
  <path
     d="M 53.380952,314.85714 L 72.380952,328.42857 L 96.809524,332.95238 L 272.33333,329.33334 L 291.33334,244.28571 L 242.47619,211.71429 L 53.380952,314.85714 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2173" />
  <path
     d="M 298.57143,252.42857 L 324.80952,254.2381 L 332.95238,327.52381 L 285,328.42857 L 298.57143,252.42857 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2175" />
  <path
     d="M 352.85714,325.71429 L 337.47619,248.80952 L 376.38095,214.42857 L 545.57143,303.09524 L 544.66667,328.42857 L 527.47619,331.14286 L 352.85714,325.71429 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2177" />
  <path
     d="M 237.95238,126.66667 L 289.52381,92.285714 L 276.85714,13.571429 L 86.857143,14.47619 L 66.952381,20.809524 L 56.095238,32.571429 L 237.95238,126.66667 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2179" />
  <path
     d="M 299.47619,89.571429 L 319.38095,88.666667 L 334.7619,17.190476 L 288.61905,16.285714 L 299.47619,89.571429 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2181" />
  <path
     d="M 377.28571,127.57143 L 325.71429,92.285714 L 345.61905,16.285714 L 532.90476,14.47619 L 559.14285,33.476191 L 523.85714,54.285715 L 377.28571,127.57143 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2183" />
  <path
     d="M 393.57143,171.90476 L 522.95238,158.33333 L 514.80952,72.380952 L 385.42857,139.33333 L 393.57143,171.90476 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2203" />
  <path
     d="M 522.95238,158.33333 L 393.57143,171.90476 L 380.90476,203.57143 L 468.66667,243.38095 L 508.47619,210.80952 L 522.95238,158.33333 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2185" />
  <path
     d="M 532,191.80952 L 585.38095,189.09524 L 586.28571,150.19048 L 531.09523,152 L 532,191.80952 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2187" />
  <path
     d="M 523.85714,67.857143 L 572.71429,39.809524 L 588.09524,58.809524 L 590.80952,103.14286 L 584.47619,141.14286 L 531.09524,140.2381 L 523.85714,67.857143 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2189" />
  <path
     d="M 528.38095,251.52381 L 587.19048,257.85714 L 579.95238,285.90476 L 560.95238,300.38095 L 517.52381,273.2381 L 528.38095,251.52381 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2207" />
  <path
     d="M 587.19048,257.85714 L 528.38095,251.52381 L 532,199.04762 L 587.19048,197.2381 L 587.19048,257.85714 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2191" />
  <path
     d="M 477.71429,250.61905 L 507.57143,267.80952 L 517.52381,247 L 518.42857,217.14286 L 477.71429,250.61905 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2193" />
  <path
     d="M 268.71429,139.33333 L 284.09524,125.7619 L 309.42857,120.33333 L 341.09524,133.90476 L 359.19048,161.95238 L 360.09524,188.19048 L 347.42857,207.19048 L 321.19048,221.66667 L 294.04762,222.57143 L 274.14286,209.90476 L 257.85714,188.19048 L 258.7619,157.42857 L 268.71429,139.33333 z "
     style="opacity:1;color:#000000;fill:#80ff80;fill-opacity:1;fill-rule:nonzero;stroke:#008000;stroke-width:2.5;stroke-linecap:round;stroke-linejoin:round;marker:none;marker-start:none;marker-mid:none;marker-end:none;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;visibility:visible;display:inline;overflow:visible;enable-background:accumulate"
     id="path2195" />
</svg>

people.edn

[
[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]
]

picnic.clj

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