├── .gitignore ├── .travis.yml ├── README.md ├── org ├── potter.html └── potter.org ├── project.clj └── src └── potter.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /org/auto 2 | /target 3 | /lib 4 | /classes 5 | /checkouts 6 | pom.xml 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | jdk: 4 | - oraclejdk7 5 | - openjdk7 6 | - openjdk6 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # org-babel-example 2 | 3 | This is a Literate Program, so all the source code and documentation 4 | for this project can be found in one file: org/potter.org. Open it in 5 | a version of Emacs containing Org-Mode and have fun! 6 | 7 | ## License 8 | 9 | Copyright © 2012 Gary W. Johnson (lambdatronic@gmail.com) 10 | 11 | Distributed under the Eclipse Public License, the same as Clojure. 12 | -------------------------------------------------------------------------------- /org/potter.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | A Literate Programming Solution to the Potter Kata (http://codingdojo.org/cgi-bin/wiki.pl?KataPotter) 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 63 | 85 | 126 | 127 | 128 | 129 |
130 | 131 |
132 | 133 |
134 |

A Literate Programming Solution to the Potter Kata (http://codingdojo.org/cgi-bin/wiki.pl?KataPotter)

135 | 136 | 137 | 138 | 139 | 140 |
141 |

Table of Contents

142 |
143 | 159 |
160 |
161 | 162 |
163 |

1 Introduction

164 |
165 | 166 | 167 |

168 | This is a very special document in that it not only explains the inner 169 | workings of this software system but also contains the complete source 170 | code of its implementation. Such a document is called a Literate 171 | Program1 after the software development paradigm 172 | proposed by Donald Knuth in the late 1970s and first implemented in 173 | his 1981 WEB system. 174 |

175 |

176 | Unlike WEB and its later offspring CWEB, which were each limited to a 177 | single programming language (Pascal and C respectively), this Literate 178 | Program has been written using Emacs' Org-Mode2, allowing us to freely intermix any number of 179 | programming languages to create our final product. The main 180 | programming language we will use here is Clojure3, a modern dialect of Lisp that targets the Java 181 | Virtual Machine (JVM)4. However, if we needed helper programs in other 182 | languages (e.g., Bash, C++, Python), their code could also be freely 183 | intermixed in this document and automatically extracted later for 184 | compilation and execution. 185 |

186 |

187 | In addition to reading this document, its Org source file (potter.org) 188 | may be opened in Emacs and manipulated in three ways: 189 |

190 |
191 |
Tangle
Typing `M-x org-babel-tangle' will cause Emacs to extract 192 | all the source code blocks within potter.org into separate 193 | files and rearrange them into valid compilation order so 194 | that they may be compiled into an executable application. 195 | 196 |
197 |
Weave
Typing `M-x org-export-as-pdf' or `M-x org-export-as-html' 198 | will cause Emacs to generate an attractively typeset 199 | version of potter.org as either a PDF file (potter.pdf) or an 200 | HTML webpage (potter.html) respectively. This is likely the 201 | way in which the manual you are currently reading was 202 | created. 203 | 204 |
205 |
Evaluate
If potter.org is opened in Emacs' Org major mode (`M-x 206 | org-mode'), and Emacs is connected to an external 207 | Clojure process5, the code blocks within 208 | potter.org may be loaded and executed individually by the 209 | connected Clojure server using `M-x 210 | org-babel-execute-src-block' (typically bound to `C-c 211 | C-c').6 212 |
213 |
214 | 215 | 216 |

217 | See comments in the header section of potter.org for the specific order 218 | in which the above Emacs commands should be executed. 219 |

220 |
221 | 222 |
223 | 224 |
225 |

2 Problem Description

226 |
227 | 228 | 229 |

230 | Once upon a time there was a series of 5 books about a very English 231 | hero called Harry. (At least when this Kata was invented, there were 232 | only 5. Since then they have multiplied) Children all over the world 233 | thought he was fantastic, and, of course, so did the publisher. So in 234 | a gesture of immense generosity to mankind, (and to increase sales) 235 | they set up the following pricing model to take advantage of Harry's 236 | magical powers. 237 |

238 |

239 | One copy of any of the five books costs 8 EUR. If, however, you buy 240 | two different books from the series, you get a 5% discount on those 241 | two books. If you buy 3 different books, you get a 10% discount. With 242 | 4 different books, you get a 20% discount. If you go the whole hog, 243 | and buy all 5, you get a huge 25% discount. 244 |

245 |

246 | Note that if you buy, say, four books, of which 3 are different 247 | titles, you get a 10% discount on the 3 that form part of a set, but 248 | the fourth book still costs 8 EUR. 249 |

250 |

251 | Potter mania is sweeping the country and parents of teenagers 252 | everywhere are queueing up with shopping baskets overflowing with 253 | Potter books. Your mission is to write a piece of code to calculate 254 | the price of any conceivable shopping basket, giving as big a discount 255 | as possible. 256 |

257 |
258 | 259 |
260 | 261 |
262 |

3 Procedure

263 |
264 | 265 | 266 |

267 | Given a shopping basket specification [1 1 3 2 1 5 3 4] (i.e., a 268 | vector of the books present in the basket by their number in the 269 | series), our goal is to find the partition of the basket's contents 270 | that minimizes the total cost of purchasing the books in the basket. 271 |

272 | 273 |
274 | 275 |
276 |

3.1 Find all partitions and then calculate their costs

277 |
278 | 279 | 280 |

281 | One approach that we could take to solve this problem is as follows: 282 |

283 |
    284 |
  1. Find all partitions of the shopping basket contents. 285 |
    2. 286 |
  2. Calculate the cost of the shopping basket contents using each partition. 287 |
    3. 288 |
  3. Select the minimum cost partition. 289 |
    4. 290 |
291 | 292 | 293 | 294 | 295 | 296 | 
(def find-all-basket-partitions find-all-basket-partitions-via-tree-traversal)
297 | 
298 | (defn find-minimum-cost-partition-naive [shopping-basket-books]
299 |   (let [all-partitions (find-all-basket-partitions shopping-basket-books)
300 |         all-costs      (map calculate-partition-cost all-partitions)]
301 |     (apply min-key val (zipmap all-partitions all-costs))))
302 |
303 | 304 | 305 | 306 |
307 | 308 |
309 |

3.1.1 Find all basket partitions via power sets

310 |
311 | 312 | 313 |

314 | A partition \(P\) of a set \(S\) is a subset of all its subsets, for which 315 | the following three conditions hold: 316 |

317 |
    318 |
  1. \(P\) does not contain the empty set \(\emptyset\) (i.e., \(\emptyset \notin P\)). 319 |
    2. 320 |
  2. The union of the elements of \(P\) is equal to \(S\). 321 |
    3. 322 |
  3. The intersection of any two distinct elements of \(P\) is the empty set \(\emptyset\). 323 |
    4. 324 |
325 | 326 | 327 | 328 | 329 | 330 | 
(defn partition? [P S]
331 |   (and (not (contains? P #{}))
332 |        (= (apply union P) S)
333 |        (every? #(= (intersection (first %) (second %)) #{}) (combinations P 2))))
334 |
335 | 336 | 337 |

338 | The set of all subsets of a set \(S\) (including the empty set 339 | \(\emptyset\) and \(S\) itself) is called the power set of \(S\). The 340 | number of elements in the power set of \(S\) is equal to \(2^{|S|}\), 341 | where \(|S|\) is the number of elements in \(S\). 342 |

343 | 344 | 345 | 346 | 
(defn find-power-set [S]
347 |   (set (map set (subsets S))))
348 |
349 | 350 | 351 |

352 | To find all partitions of the set \(S\), we could naively find all 353 | subsets of its power set that satisfy the partition? predicate given 354 | above. 355 |

356 | 357 | 358 | 359 | 
(defn find-all-partitions [S]
360 |   (filter #(partition? % S) (subsets (find-power-set S))))
361 |
362 | 363 | 364 |

365 | Of course, since we are working with sets and no redundant elements 366 | are allowed within sets, we must begin our analysis by mapping the 367 | input shopping basket to a set of distinct elements. We do this by 368 | representing each book in the basket by its index in the input vector. 369 | Finally, once we have found all partitions of the index set, we 370 | translate the returned indices back to their book numbers. 371 |

372 | 373 | 374 | 375 | 
(defn find-all-basket-partitions-via-power-sets [shopping-basket-books]
376 |   (let [S (set (range (count shopping-basket-books)))]
377 |     (for [P (find-all-partitions S)]
378 |       (for [subset P]
379 |         (map shopping-basket-books subset)))))
380 |
381 | 382 | 383 |
384 | 385 |
386 | 387 |
388 |

3.1.2 Find all basket partitions via tree traversal

389 |
390 | 391 | 392 |

393 | Although mathematically correct, our first formulation is extremely 394 | computationally inefficient and will scale poorly as the size of \(S\) 395 | grows. Recall that our goal is to maximize the discount available to 396 | the shopper, and since no discounts are applied for groups of less 397 | than two books, we can exclude all such sets within the power set. 398 |

399 | 400 | 401 | 402 | 
(defn find-discounted-subsets [S]
403 |   (remove #(< (count %) 2) (subsets S)))
404 | 
405 | (defn find-discounted-subsets-alternate [S]
406 |   (mapcat #(combinations S %) (range 2 6)))
407 |
408 | 409 | 410 |

411 | Since we are working with sets and no redundant elements are allowed 412 | within a set, we must begin our analysis by mapping the shopping 413 | basket contents to a set of distinct elements. For our second attempt, 414 | we do this by creating a map of distinct books (by their number in the 415 | series) to the number of times each appears in the basket. 416 |

417 |

418 | We can then envision a basket partitioning procedure, that proceeds by 419 | iteratively selecting one of the discounted subsets of the 420 | distinct books remaining in the basket until the basket is either 421 | empty or only contains books which cannot be grouped into a 422 | discounted subset. These remaining books are then grouped 423 | together to form the final subset of the partition. 424 |

425 |

426 | In order to explore all such possible partitions, we construct a tree 427 | whose nodes are pairs of (book-freqs-in-basket, selected-book-groups). 428 | Successor nodes are constructed by selecting all discounted subsets of 429 | the parent node's book-freqs-in-basket and when none remain, simply 430 | grouping together any books still in book-freqs-in-basket as the final 431 | undiscounted subset. In such a tree, each path from the root node 432 | (i.e., the initial shopping basket contents) to a leaf node (i.e., one 433 | whose book-freqs-in-basket value is empty) represents a partition of 434 | the tree. Each leaf node's selected-book-groups field will contain a 435 | complete partition of the shopping basket contents. To find all 436 | partitions, we simply traverse this tree and return the 437 | selected-book-groups field on each leaf node. 438 |

439 | 440 | 441 | 442 | 
(defstruct node :book-freqs-in-basket :selected-book-groups)
443 | 
444 | (defn remove-from-basket [book-freqs subset]
445 |   (into {} (remove #(zero? (val %)) (reduce #(update-in %1 [%2] dec) book-freqs subset))))
446 | 
447 | (defn expand-book-freqs [book-freqs]
448 |   (mapcat (fn [[book-id frequency]] (repeat frequency book-id)) book-freqs))
449 | 
450 | (defn successors [{:keys [book-freqs-in-basket selected-book-groups]}]
451 |   (let [distinct-books (keys book-freqs-in-basket)]
452 |     (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))]
453 |       (for [books discounted-book-groups]
454 |         (struct-map node
455 |           :book-freqs-in-basket (remove-from-basket book-freqs-in-basket books)
456 |           :selected-book-groups (cons books selected-book-groups)))
457 |       (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)]
458 |         (list (struct-map node
459 |                 :book-freqs-in-basket nil
460 |                 :selected-book-groups (if (seq undiscounted-book-group)
461 |                                         (cons undiscounted-book-group selected-book-groups)
462 |                                         selected-book-groups)))))))
463 | 
464 | (defn leaf-node? [node]
465 |   (nil? (:book-freqs-in-basket node)))
466 | 
467 | (defn find-next-partition [[open-list partition]]
468 |   (if-let [node (first open-list)]
469 |     (if (leaf-node? node)
470 |       [(rest open-list) (:selected-book-groups node)]
471 |       (recur [(concat (successors node) (rest open-list)) nil]))))
472 | 
473 | (defn find-all-basket-partitions-via-tree-traversal [shopping-basket-books]
474 |   (let [root-node (struct-map node
475 |                     :book-freqs-in-basket (frequencies shopping-basket-books)
476 |                     :selected-book-groups ())]
477 |     (->> [(list root-node) nil]
478 |          (iterate find-next-partition)
479 |          rest
480 |          (take-while seq)
481 |          (map second))))
482 |
483 | 484 | 485 |
486 | 487 |
488 | 489 |
490 |

3.1.3 Calculate partition cost

491 |
492 | 493 | 494 |

495 | The cost of a partition is simply calculated as the sum of the costs 496 | of its bins. 497 |

498 | 499 | 500 | 501 | 
(defn calculate-partition-cost [partition]
502 |   (reduce + (map calculate-bin-cost partition)))
503 |
504 | 505 | 506 |

507 | To calculate the cost of a bin, we first determine the bin discount, 508 | which is a function of the number of distinct books in the bin as 509 | described in Problem Description. 510 |

511 | 512 | 513 | 514 | 
(defn get-bin-discount [bin]
515 |   (case (count (distinct bin))
516 |     2 0.05
517 |     3 0.10
518 |     4 0.20
519 |     5 0.25
520 |     0.0))
521 |
522 | 523 | 524 |

525 | We then multiply the number of books in the bin by the base book price 526 | (given as 8 euros in the problem statement) and apply the bin discount 527 | to the result. 528 |

529 | 530 | 531 | 532 | 
(def base-book-price 8.00)
533 | 
534 | (defn calculate-bin-cost [bin]
535 |   (* base-book-price (count bin) (- 1.0 (get-bin-discount bin))))
536 |
537 | 538 | 539 |
540 |
541 | 542 |
543 | 544 |
545 |

3.2 Find minimum cost partition directly via dynamic programming

546 |
547 | 548 | 549 |

550 | The tree traversal approach described in Find all basket partitions via tree traversal does successfully return all partitions of the 551 | shopping basket contents. However, if order is disregarded, many of 552 | the returned partitions end up being redundant. As this translates 553 | into wasted computation, we would like to find an even more efficient 554 | partitioning scheme that eliminates redundant entries. 555 |

556 |

557 | The approach we will try this time is called dynamic programming. 558 | Under this scheme, the minimum cost partition of the shopping basket 559 | contents will be defined recursively as the partition which minimizes 560 | the sum of the first selected book group's cost and the minimum 561 | partition cost of the remaining shopping basket contents. 562 |

563 |

564 | Ultimately, this algorithm will also perform what is essentially a 565 | depth-first tree search on the states of the shopping basket's 566 | contents after each successive book group selection. This means we 567 | will be searching the same state space as we did in the tree traversal 568 | approach from the previous section. 569 |

570 |

571 | However, what is unique about the dynamic programming methodology is 572 | that we can avoid redundant searches through the state space by 573 | memoizing the minimum cost partition at each stage of our tree 574 | traversal in terms of the remaining shopping basket contents. Since we 575 | will be representing what is in the basket as a frequency table, the 576 | order in which we select book groups from the basket will not affect 577 | the number of memoized states. 578 |

579 |

580 | For readability, we simply recalculate the partition cost at each 581 | unmemoized step of the tree traversal. If we found this to be a major 582 | efficiency problem in our final application, we could calculate the 583 | bin cost of each newly selected book group and add that to the minimum 584 | partition cost of the remaining shopping basket contents at each step. 585 | We leave this as an exercise for the reader. 586 |

587 | 588 | 589 | 590 | 
(defn find-minimum-cost-partition-aux [book-freqs-in-basket]
591 |   (if (seq book-freqs-in-basket)
592 |     (let [distinct-books (keys book-freqs-in-basket)]
593 |       (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))]
594 |         (apply min-key calculate-partition-cost
595 |                (for [books discounted-book-groups]
596 |                  (cons books (find-minimum-cost-partition-aux (remove-from-basket book-freqs-in-basket books)))))
597 |         (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)]
598 |           (list undiscounted-book-group))))))
599 | (def find-minimum-cost-partition-aux (memoize find-minimum-cost-partition-aux))
600 | 
601 | (defn find-minimum-cost-partition-via-dynamic-programming [shopping-basket-books]
602 |   (let [minimum-cost-partition (find-minimum-cost-partition-aux (frequencies shopping-basket-books))]
603 |     [minimum-cost-partition (calculate-partition-cost minimum-cost-partition)]))
604 |
605 | 606 | 607 |
608 |

Footnotes:

609 |
610 |

1 See http://en.wikipedia.org/wiki/Literate_programming 611 | for more information. 612 |

613 | 614 | 615 |

2 http://orgmode.org 616 |

617 | 618 | 619 |

3 http://clojure.org 620 |

621 | 622 | 623 |

4 See 624 | http://en.wikipedia.org/wiki/Java_virtual_machine for more 625 | information. 626 |

627 | 628 | 629 |

5 Connecting to an external Clojure 630 | process is beyond the scope of this document but 631 | requires setting up either SLIME + Swank-Clojure and 632 | typing `M-x clojure-jack-in' or nrepl.el + NREPL and 633 | typing `M-x nrepl-jack-in', 634 |

635 | 636 | 637 |

6 See 638 | http://orgmode.org/manual/Evaluating-code-blocks.html 639 | for more information. 640 |

641 |
642 |
643 | 644 |
645 |
646 |
647 | 648 |
649 |

Date: 2012-09-10

650 |

Author: Gary W. Johnson

651 |

Org version 7.8.11 with Emacs version 24

652 | Validate XHTML 1.0 653 | 654 |
655 | 656 | 657 | -------------------------------------------------------------------------------- /org/potter.org: -------------------------------------------------------------------------------- 1 | #+TITLE: A Literate Programming Solution to the Potter Kata (http://codingdojo.org/cgi-bin/wiki.pl?KataPotter) 2 | #+AUTHOR: Gary W. Johnson 3 | #+EMAIL: lambdatronic@gmail.com 4 | #+DATE: 2012-09-10 5 | # Copyright 2012 Gary W. Johnson (lambdatronic@gmail.com) 6 | 7 | ############################################################################## 8 | # 9 | # In order to load org-babel in Emacs, add this code to your 10 | # initialization file: 11 | # 12 | # ;; Add org-babel support 13 | # (when (locate-file "ob" load-path load-suffixes) 14 | # (require 'ob) 15 | # (require 'ob-tangle) 16 | # (require 'ob-clojure) 17 | # (org-babel-do-load-languages 18 | # 'org-babel-load-languages 19 | # '((emacs-lisp . t) 20 | # (clojure . t)))) 21 | # 22 | # ;; Pull in the htmlize library for pretty source code in HTML output 23 | # (require 'htmlize) 24 | # 25 | # ;; Fontify source code in org-latex export to PDF 26 | # (require 'org-latex) 27 | # (setq org-export-latex-listings 'minted) 28 | # (add-to-list 'org-export-latex-packages-alist '("" "minted")) 29 | # (setq org-export-latex-custom-lang-environments 30 | # '( 31 | # (emacs-lisp "common-lispcode") 32 | # )) 33 | # (setq org-export-latex-minted-options 34 | # '(("fontsize" "\\scriptsize") 35 | # ("linenos" "false"))) 36 | # (setq org-latex-to-pdf-process '("pdflatex -interaction nonstopmode -shell-escape -output-directory %o %f" 37 | # "bibtex %b" 38 | # "pdflatex -interaction nonstopmode -shell-escape -output-directory %o %f" 39 | # "pdflatex -interaction nonstopmode -shell-escape -output-directory %o %f")) 40 | # 41 | ############################################################################## 42 | # 43 | # As of the time of this writing (2012-09-10), there are some problems 44 | # using Emacs with Swank-Clojure or nrepl.el. To work around this, also add 45 | # one of the following two code blocks to your Emacs initialization 46 | # file: 47 | # 48 | # Under SLIME + Swank-Clojure: 49 | # ;; Patch result table rendering bug in ob-clojure (SLIME version) 50 | # (defun org-babel-execute:clojure (body params) 51 | # "Execute a block of Clojure code with Babel." 52 | # (require 'slime) 53 | # (with-temp-buffer 54 | # (insert (org-babel-expand-body:clojure body params)) 55 | # ((lambda (result) 56 | # (destructuring-bind (output value) result 57 | # (let ((result-params (cdr (assoc :result-params params)))) 58 | # (if (or (member "scalar" result-params) 59 | # (member "verbatim" result-params)) 60 | # value 61 | # (condition-case nil (org-babel-script-escape value) 62 | # (error value)))))) 63 | # (slime-eval 64 | # `(swank:eval-and-grab-output 65 | # ,(buffer-substring-no-properties (point-min) (point-max))) 66 | # (cdr (assoc :package params)))))) 67 | # 68 | # Under nrepl.el + NREPL: 69 | # ;; Patch ob-clojure to work with nrepl 70 | # (declare-function nrepl-send-string-sync "ext:nrepl" (code &optional ns)) 71 | # 72 | # (defun org-babel-execute:clojure (body params) 73 | # "Execute a block of Clojure code with Babel." 74 | # (require 'nrepl) 75 | # (with-temp-buffer 76 | # (insert (org-babel-expand-body:clojure body params)) 77 | # ((lambda (result) 78 | # (let ((result-params (cdr (assoc :result-params params)))) 79 | # (if (or (member "scalar" result-params) 80 | # (member "verbatim" result-params)) 81 | # result 82 | # (condition-case nil (org-babel-script-escape result) 83 | # (error result))))) 84 | # (plist-get (nrepl-send-string-sync 85 | # (buffer-substring-no-properties (point-min) (point-max)) 86 | # (cdr (assoc :package params))) 87 | # :value)))) 88 | # 89 | ############################################################################## 90 | # 91 | # Finally, to prepare your Emacs environment for tangling, weaving, or 92 | # evaluating this file, open it in org-mode and follow these steps: 93 | # 94 | # Under SLIME + Swank-Clojure: 95 | # 1. M-x org-babel-tangle (regenerates source files) 96 | # 2. M-x clojure-jack-in (starts SLIME + Clojure) 97 | # 3. C-c C-c (from within toplevel-load-block, loads source code into SLIME) 98 | # 4. M-x org-export-as-html (regenerate woven HTML documentation) 99 | # 100 | # Under nrepl.el + NREPL: 101 | # 1. M-x org-babel-tangle (regenerates source files) 102 | # 2. M-x nrepl-jack-in (starts nrepl.el + NREPL) 103 | # 3. M-x nrepl-interaction-mode (to enable NREPL keybindings in this buffer) 104 | # 4. C-c C-c (from within toplevel-load-block, loads source code into NREPL) 105 | # 5. M-x org-export-as-html (regenerate woven HTML documentation) 106 | # 107 | ############################################################################## 108 | 109 | #+name: toplevel-load-block 110 | #+begin_src clojure :exports none :tangle ../src/potter.clj :padline no :results silent :noweb yes 111 | (ns potter 112 | (:use [clojure.set :only [union intersection]] 113 | [clojure.math.combinatorics :only [combinations subsets]])) 114 | 115 | <> 116 | 117 | <> 118 | 119 | <> 120 | 121 | <> 122 | 123 | <> 124 | 125 | <> 126 | 127 | <> 128 | 129 | <> 130 | 131 | <> 132 | 133 | <> 134 | 135 | <> 136 | #+end_src 137 | 138 | * Introduction 139 | 140 | This is a very special document in that it not only explains the inner 141 | workings of this software system but also contains the complete source 142 | code of its implementation. Such a document is called a Literate 143 | Program[fn:Foo: See http://en.wikipedia.org/wiki/Literate_programming 144 | for more information.] after the software development paradigm 145 | proposed by Donald Knuth in the late 1970s and first implemented in 146 | his 1981 WEB system. 147 | 148 | Unlike WEB and its later offspring CWEB, which were each limited to a 149 | single programming language (Pascal and C respectively), this Literate 150 | Program has been written using Emacs' Org-Mode[fn:: 151 | http://orgmode.org], allowing us to freely intermix any number of 152 | programming languages to create our final product. The main 153 | programming language we will use here is Clojure[fn:: 154 | http://clojure.org], a modern dialect of Lisp that targets the Java 155 | Virtual Machine (JVM)[fn:: See 156 | http://en.wikipedia.org/wiki/Java_virtual_machine for more 157 | information.]. However, if we needed helper programs in other 158 | languages (e.g., Bash, C++, Python), their code could also be freely 159 | intermixed in this document and automatically extracted later for 160 | compilation and execution. 161 | 162 | In addition to reading this document, its Org source file (potter.org) 163 | may be opened in Emacs and manipulated in three ways: 164 | 165 | - Tangle :: Typing `M-x org-babel-tangle' will cause Emacs to extract 166 | all the source code blocks within potter.org into separate 167 | files and rearrange them into valid compilation order so 168 | that they may be compiled into an executable application. 169 | 170 | - Weave :: Typing `M-x org-export-as-pdf' or `M-x org-export-as-html' 171 | will cause Emacs to generate an attractively typeset 172 | version of potter.org as either a PDF file (potter.pdf) or an 173 | HTML webpage (potter.html) respectively. This is likely the 174 | way in which the manual you are currently reading was 175 | created. 176 | 177 | - Evaluate :: If potter.org is opened in Emacs' Org major mode (`M-x 178 | org-mode'), and Emacs is connected to an external 179 | Clojure process[fn:: Connecting to an external Clojure 180 | process is beyond the scope of this document but 181 | requires setting up either SLIME + Swank-Clojure and 182 | typing `M-x clojure-jack-in' or nrepl.el + NREPL and 183 | typing `M-x nrepl-jack-in', ], the code blocks within 184 | potter.org may be loaded and executed individually by the 185 | connected Clojure server using `M-x 186 | org-babel-execute-src-block' (typically bound to `C-c 187 | C-c').[fn:: See 188 | http://orgmode.org/manual/Evaluating-code-blocks.html 189 | for more information.] 190 | 191 | See comments in the header section of potter.org for the specific order 192 | in which the above Emacs commands should be executed. 193 | 194 | * Problem Description 195 | 196 | Once upon a time there was a series of 5 books about a very English 197 | hero called Harry. (At least when this Kata was invented, there were 198 | only 5. Since then they have multiplied) Children all over the world 199 | thought he was fantastic, and, of course, so did the publisher. So in 200 | a gesture of immense generosity to mankind, (and to increase sales) 201 | they set up the following pricing model to take advantage of Harry's 202 | magical powers. 203 | 204 | One copy of any of the five books costs 8 EUR. If, however, you buy 205 | two different books from the series, you get a 5% discount on those 206 | two books. If you buy 3 different books, you get a 10% discount. With 207 | 4 different books, you get a 20% discount. If you go the whole hog, 208 | and buy all 5, you get a huge 25% discount. 209 | 210 | Note that if you buy, say, four books, of which 3 are different 211 | titles, you get a 10% discount on the 3 that form part of a set, but 212 | the fourth book still costs 8 EUR. 213 | 214 | Potter mania is sweeping the country and parents of teenagers 215 | everywhere are queueing up with shopping baskets overflowing with 216 | Potter books. Your mission is to write a piece of code to calculate 217 | the price of any conceivable shopping basket, giving as big a discount 218 | as possible. 219 | 220 | * Procedure 221 | 222 | Given a shopping basket specification [1 1 3 2 1 5 3 4] (i.e., a 223 | vector of the books present in the basket by their number in the 224 | series), our goal is to find the partition of the basket's contents 225 | that minimizes the total cost of purchasing the books in the basket. 226 | 227 | ** Find all partitions and then calculate their costs 228 | 229 | One approach that we could take to solve this problem is as follows: 230 | 231 | 1. Find all partitions of the shopping basket contents. 232 | 2. Calculate the cost of the shopping basket contents using each partition. 233 | 3. Select the minimum cost partition. 234 | 235 | #+name: find-minimum-cost-partition-naive 236 | #+begin_src clojure 237 | (def find-all-basket-partitions find-all-basket-partitions-via-tree-traversal) 238 | 239 | (defn find-minimum-cost-partition-naive [shopping-basket-books] 240 | (let [all-partitions (find-all-basket-partitions shopping-basket-books) 241 | all-costs (map calculate-partition-cost all-partitions)] 242 | (apply min-key val (zipmap all-partitions all-costs)))) 243 | #+end_src 244 | 245 | *** Find all basket partitions via power sets 246 | 247 | A partition $P$ of a set $S$ is a subset of all its subsets, for which 248 | the following three conditions hold: 249 | 250 | 1. $P$ does not contain the empty set $\emptyset$ (i.e., $\emptyset \notin P$). 251 | 2. The union of the elements of $P$ is equal to $S$. 252 | 3. The intersection of any two distinct elements of $P$ is the empty set $\emptyset$. 253 | 254 | #+name: partition? 255 | #+begin_src clojure 256 | (defn partition? [P S] 257 | (and (not (contains? P #{})) 258 | (= (apply union P) S) 259 | (every? #(= (intersection (first %) (second %)) #{}) (combinations P 2)))) 260 | #+end_src 261 | 262 | The set of all subsets of a set $S$ (including the empty set 263 | $\emptyset$ and $S$ itself) is called the /power set/ of $S$. The 264 | number of elements in the power set of $S$ is equal to $2^{|S|}$, 265 | where $|S|$ is the number of elements in $S$. 266 | 267 | #+name: find-power-set 268 | #+begin_src clojure 269 | (defn find-power-set [S] 270 | (set (map set (subsets S)))) 271 | #+end_src 272 | 273 | To find all partitions of the set $S$, we could naively find all 274 | subsets of its power set that satisfy the partition? predicate given 275 | above. 276 | 277 | #+name: find-all-partitions 278 | #+begin_src clojure 279 | (defn find-all-partitions [S] 280 | (filter #(partition? % S) (subsets (find-power-set S)))) 281 | #+end_src 282 | 283 | Of course, since we are working with sets and no redundant elements 284 | are allowed within sets, we must begin our analysis by mapping the 285 | input shopping basket to a set of distinct elements. We do this by 286 | representing each book in the basket by its index in the input vector. 287 | Finally, once we have found all partitions of the index set, we 288 | translate the returned indices back to their book numbers. 289 | 290 | #+name: find-all-basket-partitions-via-power-sets 291 | #+begin_src clojure 292 | (defn find-all-basket-partitions-via-power-sets [shopping-basket-books] 293 | (let [S (set (range (count shopping-basket-books)))] 294 | (for [P (find-all-partitions S)] 295 | (for [subset P] 296 | (map shopping-basket-books subset))))) 297 | #+end_src 298 | 299 | *** Find all basket partitions via tree traversal 300 | 301 | Although mathematically correct, our first formulation is extremely 302 | computationally inefficient and will scale poorly as the size of $S$ 303 | grows. Recall that our goal is to maximize the discount available to 304 | the shopper, and since no discounts are applied for groups of less 305 | than two books, we can exclude all such sets within the power set. 306 | 307 | #+name: find-discounted-subsets 308 | #+begin_src clojure 309 | (defn find-discounted-subsets [S] 310 | (remove #(< (count %) 2) (subsets S))) 311 | 312 | (defn find-discounted-subsets-alternate [S] 313 | (mapcat #(combinations S %) (range 2 6))) 314 | #+end_src 315 | 316 | Since we are working with sets and no redundant elements are allowed 317 | within a set, we must begin our analysis by mapping the shopping 318 | basket contents to a set of distinct elements. For our second attempt, 319 | we do this by creating a map of distinct books (by their number in the 320 | series) to the number of times each appears in the basket. 321 | 322 | We can then envision a basket partitioning procedure, that proceeds by 323 | iteratively selecting one of the discounted subsets of the 324 | distinct books remaining in the basket until the basket is either 325 | empty or only contains books which cannot be grouped into a 326 | discounted subset. These remaining books are then grouped 327 | together to form the final subset of the partition. 328 | 329 | In order to explore all such possible partitions, we construct a tree 330 | whose nodes are pairs of (book-freqs-in-basket, selected-book-groups). 331 | Successor nodes are constructed by selecting all discounted subsets of 332 | the parent node's book-freqs-in-basket and when none remain, simply 333 | grouping together any books still in book-freqs-in-basket as the final 334 | undiscounted subset. In such a tree, each path from the root node 335 | (i.e., the initial shopping basket contents) to a leaf node (i.e., one 336 | whose book-freqs-in-basket value is empty) represents a partition of 337 | the tree. Each leaf node's selected-book-groups field will contain a 338 | complete partition of the shopping basket contents. To find all 339 | partitions, we simply traverse this tree and return the 340 | selected-book-groups field on each leaf node. 341 | 342 | #+name: find-all-basket-partitions-via-tree-traversal 343 | #+begin_src clojure 344 | (defstruct node :book-freqs-in-basket :selected-book-groups) 345 | 346 | (defn remove-from-basket [book-freqs subset] 347 | (into {} (remove #(zero? (val %)) (reduce #(update-in %1 [%2] dec) book-freqs subset)))) 348 | 349 | (defn expand-book-freqs [book-freqs] 350 | (mapcat (fn [[book-id frequency]] (repeat frequency book-id)) book-freqs)) 351 | 352 | (defn successors [{:keys [book-freqs-in-basket selected-book-groups]}] 353 | (let [distinct-books (keys book-freqs-in-basket)] 354 | (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))] 355 | (for [books discounted-book-groups] 356 | (struct-map node 357 | :book-freqs-in-basket (remove-from-basket book-freqs-in-basket books) 358 | :selected-book-groups (cons books selected-book-groups))) 359 | (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)] 360 | (list (struct-map node 361 | :book-freqs-in-basket nil 362 | :selected-book-groups (if (seq undiscounted-book-group) 363 | (cons undiscounted-book-group selected-book-groups) 364 | selected-book-groups))))))) 365 | 366 | (defn leaf-node? [node] 367 | (nil? (:book-freqs-in-basket node))) 368 | 369 | (defn find-next-partition [[open-list partition]] 370 | (if-let [node (first open-list)] 371 | (if (leaf-node? node) 372 | [(rest open-list) (:selected-book-groups node)] 373 | (recur [(concat (successors node) (rest open-list)) nil])))) 374 | 375 | (defn find-all-basket-partitions-via-tree-traversal [shopping-basket-books] 376 | (let [root-node (struct-map node 377 | :book-freqs-in-basket (frequencies shopping-basket-books) 378 | :selected-book-groups ())] 379 | (->> [(list root-node) nil] 380 | (iterate find-next-partition) 381 | rest 382 | (take-while seq) 383 | (map second)))) 384 | #+end_src 385 | 386 | *** Calculate partition cost 387 | 388 | The cost of a partition is simply calculated as the sum of the costs 389 | of its bins. 390 | 391 | #+name: calculate-partition-cost 392 | #+begin_src clojure 393 | (defn calculate-partition-cost [partition] 394 | (reduce + (map calculate-bin-cost partition))) 395 | #+end_src 396 | 397 | To calculate the cost of a bin, we first determine the bin discount, 398 | which is a function of the number of distinct books in the bin as 399 | described in [[Problem Description]]. 400 | 401 | #+name: get-bin-discount 402 | #+begin_src clojure 403 | (defn get-bin-discount [bin] 404 | (case (count (distinct bin)) 405 | 2 0.05 406 | 3 0.10 407 | 4 0.20 408 | 5 0.25 409 | 0.0)) 410 | #+end_src 411 | 412 | We then multiply the number of books in the bin by the base book price 413 | (given as 8 euros in the problem statement) and apply the bin discount 414 | to the result. 415 | 416 | #+name: calculate-bin-cost 417 | #+begin_src clojure 418 | (def base-book-price 8.00) 419 | 420 | (defn calculate-bin-cost [bin] 421 | (* base-book-price (count bin) (- 1.0 (get-bin-discount bin)))) 422 | #+end_src 423 | 424 | ** Find minimum cost partition directly via dynamic programming 425 | 426 | The tree traversal approach described in [[Find all basket partitions 427 | via tree traversal]] does successfully return all partitions of the 428 | shopping basket contents. However, if order is disregarded, many of 429 | the returned partitions end up being redundant. As this translates 430 | into wasted computation, we would like to find an even more efficient 431 | partitioning scheme that eliminates redundant entries. 432 | 433 | The approach we will try this time is called /dynamic programming/. 434 | Under this scheme, the minimum cost partition of the shopping basket 435 | contents will be defined recursively as the partition which minimizes 436 | the sum of the first selected book group's cost and the minimum 437 | partition cost of the remaining shopping basket contents. 438 | 439 | Ultimately, this algorithm will also perform what is essentially a 440 | depth-first tree search on the states of the shopping basket's 441 | contents after each successive book group selection. This means we 442 | will be searching the same state space as we did in the tree traversal 443 | approach from the previous section. 444 | 445 | However, what is unique about the dynamic programming methodology is 446 | that we can avoid redundant searches through the state space by 447 | memoizing the minimum cost partition at each stage of our tree 448 | traversal in terms of the remaining shopping basket contents. Since we 449 | will be representing what is in the basket as a frequency table, the 450 | order in which we select book groups from the basket will not affect 451 | the number of memoized states. 452 | 453 | For readability, we simply recalculate the partition cost at each 454 | unmemoized step of the tree traversal. If we found this to be a major 455 | efficiency problem in our final application, we could calculate the 456 | bin cost of each newly selected book group and add that to the minimum 457 | partition cost of the remaining shopping basket contents at each step. 458 | We leave this as an exercise for the reader. 459 | 460 | #+name: find-minimum-cost-partition-via-dynamic-programming 461 | #+begin_src clojure 462 | (defn find-minimum-cost-partition-aux [book-freqs-in-basket] 463 | (if (seq book-freqs-in-basket) 464 | (let [distinct-books (keys book-freqs-in-basket)] 465 | (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))] 466 | (apply min-key calculate-partition-cost 467 | (for [books discounted-book-groups] 468 | (cons books (find-minimum-cost-partition-aux (remove-from-basket book-freqs-in-basket books))))) 469 | (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)] 470 | (list undiscounted-book-group)))))) 471 | (def find-minimum-cost-partition-aux (memoize find-minimum-cost-partition-aux)) 472 | 473 | (defn find-minimum-cost-partition-via-dynamic-programming [shopping-basket-books] 474 | (let [minimum-cost-partition (find-minimum-cost-partition-aux (frequencies shopping-basket-books))] 475 | [minimum-cost-partition (calculate-partition-cost minimum-cost-partition)])) 476 | #+end_src 477 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org-babel-example "1.0.0" 2 | :description (str "Solving the Potter Kata (http://codingdojo.org/cgi-bin/wiki.pl?KataPotter)" 3 | " as a Literate Programming exercise using Emacs' Org Babel mode.") 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"] 7 | [org.clojure/math.combinatorics "0.0.3"]]) 8 | -------------------------------------------------------------------------------- /src/potter.clj: -------------------------------------------------------------------------------- 1 | (ns potter 2 | (:use [clojure.set :only [union intersection]] 3 | [clojure.math.combinatorics :only [combinations subsets]])) 4 | 5 | (defn partition? [P S] 6 | (and (not (contains? P #{})) 7 | (= (apply union P) S) 8 | (every? #(= (intersection (first %) (second %)) #{}) (combinations P 2)))) 9 | 10 | (defn find-power-set [S] 11 | (set (map set (subsets S)))) 12 | 13 | (defn find-all-partitions [S] 14 | (filter #(partition? % S) (subsets (find-power-set S)))) 15 | 16 | (defn find-all-basket-partitions-via-power-sets [shopping-basket-books] 17 | (let [S (set (range (count shopping-basket-books)))] 18 | (for [P (find-all-partitions S)] 19 | (for [subset P] 20 | (map shopping-basket-books subset))))) 21 | 22 | (defn find-discounted-subsets [S] 23 | (remove #(< (count %) 2) (subsets S))) 24 | 25 | (defn find-discounted-subsets-alternate [S] 26 | (mapcat #(combinations S %) (range 2 6))) 27 | 28 | (defstruct node :book-freqs-in-basket :selected-book-groups) 29 | 30 | (defn remove-from-basket [book-freqs subset] 31 | (into {} (remove #(zero? (val %)) (reduce #(update-in %1 [%2] dec) book-freqs subset)))) 32 | 33 | (defn expand-book-freqs [book-freqs] 34 | (mapcat (fn [[book-id frequency]] (repeat frequency book-id)) book-freqs)) 35 | 36 | (defn successors [{:keys [book-freqs-in-basket selected-book-groups]}] 37 | (let [distinct-books (keys book-freqs-in-basket)] 38 | (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))] 39 | (for [books discounted-book-groups] 40 | (struct-map node 41 | :book-freqs-in-basket (remove-from-basket book-freqs-in-basket books) 42 | :selected-book-groups (cons books selected-book-groups))) 43 | (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)] 44 | (list (struct-map node 45 | :book-freqs-in-basket nil 46 | :selected-book-groups (if (seq undiscounted-book-group) 47 | (cons undiscounted-book-group selected-book-groups) 48 | selected-book-groups))))))) 49 | 50 | (defn leaf-node? [node] 51 | (nil? (:book-freqs-in-basket node))) 52 | 53 | (defn find-next-partition [[open-list partition]] 54 | (if-let [node (first open-list)] 55 | (if (leaf-node? node) 56 | [(rest open-list) (:selected-book-groups node)] 57 | (recur [(concat (successors node) (rest open-list)) nil])))) 58 | 59 | (defn find-all-basket-partitions-via-tree-traversal [shopping-basket-books] 60 | (let [root-node (struct-map node 61 | :book-freqs-in-basket (frequencies shopping-basket-books) 62 | :selected-book-groups ())] 63 | (->> [(list root-node) nil] 64 | (iterate find-next-partition) 65 | rest 66 | (take-while seq) 67 | (map second)))) 68 | 69 | (defn get-bin-discount [bin] 70 | (case (count (distinct bin)) 71 | 2 0.05 72 | 3 0.10 73 | 4 0.20 74 | 5 0.25 75 | 0.0)) 76 | 77 | (def base-book-price 8.00) 78 | 79 | (defn calculate-bin-cost [bin] 80 | (* base-book-price (count bin) (- 1.0 (get-bin-discount bin)))) 81 | 82 | (defn calculate-partition-cost [partition] 83 | (reduce + (map calculate-bin-cost partition))) 84 | 85 | (def find-all-basket-partitions find-all-basket-partitions-via-tree-traversal) 86 | 87 | (defn find-minimum-cost-partition-naive [shopping-basket-books] 88 | (let [all-partitions (find-all-basket-partitions shopping-basket-books) 89 | all-costs (map calculate-partition-cost all-partitions)] 90 | (apply min-key val (zipmap all-partitions all-costs)))) 91 | 92 | (defn find-minimum-cost-partition-aux [book-freqs-in-basket] 93 | (if (seq book-freqs-in-basket) 94 | (let [distinct-books (keys book-freqs-in-basket)] 95 | (if-let [discounted-book-groups (seq (find-discounted-subsets distinct-books))] 96 | (apply min-key calculate-partition-cost 97 | (for [books discounted-book-groups] 98 | (cons books (find-minimum-cost-partition-aux (remove-from-basket book-freqs-in-basket books))))) 99 | (let [undiscounted-book-group (expand-book-freqs book-freqs-in-basket)] 100 | (list undiscounted-book-group)))))) 101 | (def find-minimum-cost-partition-aux (memoize find-minimum-cost-partition-aux)) 102 | 103 | (defn find-minimum-cost-partition-via-dynamic-programming [shopping-basket-books] 104 | (let [minimum-cost-partition (find-minimum-cost-partition-aux (frequencies shopping-basket-books))] 105 | [minimum-cost-partition (calculate-partition-cost minimum-cost-partition)])) 106 | --------------------------------------------------------------------------------