Merge pull request #25 from mschristiansen/master

Elisp and rewritten Clojure Version

clojure/mschristiansen/src/berry/core.clj

@@ -1,107 +1,36 @@
 (ns berry.core
-  (:use [clojure.java.io :only [reader]]
-        [clojure.data.csv :only [read-csv]]
+  (:use [clojure.data.csv :only [read-csv]]
         [clj-time.core :only [plus days]]
         [clj-time.format :only [formatter parse unparse]]))
 
-;;; Define file locations and parse the file
-;;; 
-(def in-file "../../produce.csv")
-(def out-file "pricefile.txt")
-
-(def items
-  (drop 1  ;Leave headers out.
-        (with-open [file (reader in-file)]
-            (doall
-             (read-csv file)))))
-
-
-(defn sell-by-date-for
-  "Return the sell-by-date based on category keyword"
-  [category]
-  (condp = category
-    :apples (days 14)
-    :bananas (days 5)
-    (days 7)))
-
-(defn markup-for
-  "Return markup based on category keyword"
-  [category]
-  (condp = category
-    :apples 1.40
-    :bananas 1.35
-    :berries 1.55
-    1.50))
-
-(defn lookup-number
-  "Helper function to lookup a number in the item sequence."
-  [item index]
-  (Integer/parseInt (nth item index)))
-
-(defn get-product-category
-  "Return category keyword based on product code."
-  [item]
-  (let [product-code (lookup-number item 1)]
-    (condp < product-code
-      1300 :berries
-      1200 :bananas
-      1100 :apples
-      1000 :fruit)))
-
-;;; Getting the sales price
-;;; 
-(defn calculate-price
-  "Calculate price based on category and format result"
-  [item]
-  (let [category (get-product-category item)
-        cost (lookup-number item 4)]
-    (str "R"
-         (format "%8.2f"
-                 (* (markup-for category) (/ cost 100))))))
-
-;;; Getting the date
-;;; 
-(def date-format (formatter "yyyy/MM/dd"))
-
-(defn lookup-date
-  "Helper function to lookup and format the date from an item."
-  [item]
-  (parse date-format (nth item 3)))
-
-(defn poor-supplier
-  "Check if supplier no. 32 and allow for 3 extra days."
-  [item]
-  (let [supplier (lookup-number item 0)]
-    (if (= supplier 32) (days -3) (days 0))))
-
-(defn calculate-sell-by-date
-  "Calculate the sell-by-date based on category, delivery date and
-  supplier quality"
-  [item]
-  (let [category (get-product-category item)
-        category-days (sell-by-date-for category)
-        delivery-date (lookup-date item)
-        special-case (poor-supplier item)]
-    (unparse date-format
-             (plus delivery-date category-days special-case))))
-
-;;; Writing to the file in the correct format
-;;;
-
-(defn include-description
-  "Take substring of length 31 from item description"
-  [item]
-  (subs (nth item 2) 0 31))
-
-(defn create-tags
-  "Concatenate the strings together and add end-of-line."
-  [item]
-  (let [tags (lookup-number item 5)]
-    (repeat tags
-            (str (calculate-price item)
-                 (calculate-sell-by-date item)
-                 (include-description item)
-                 "\n"))))
+(defn lookup [code attr]
+  (attr (condp < code
+          1300 {:markup 1.55 :lasts (days 7)}  ; Berries
+          1200 {:markup 1.35 :lasts (days 5)}  ; Bananas
+          1100 {:markup 1.40 :lasts (days 14)} ; Apples
+          {:markup 1.50 :lasts (days 7)})))    ; Default
+
+(def trouble #{"32" "101"})             ; Susan, Togetherness
+(def premium #{"219" "204"})            ; Promise, Karel
+
+(defn price [cost code supplier]
+  (let [price (* cost (lookup code :markup))]
+    (cond (neg? (- price 2)) 0.0
+          (trouble supplier) (- price 2)
+          (premium supplier) (Math/ceil (+ price (* cost 0.10)))
+          :else price)))
+
+(defn sell-by [delivery code supplier]
+  (let [fmt (formatter "yyyy/MM/dd")
+        date (plus (parse fmt delivery) (lookup code :lasts))]
+    (unparse fmt (if (trouble supplier) (plus date (days -3)) date))))
+
+(defn create-tags [s [supplier code desc delivery cost amount]]
+  (let [p (price (* (Integer. cost) 0.01) (Integer. code) supplier)
+        d (sell-by delivery (Integer. code) supplier)]
+    (apply str s (repeat (Integer. amount)
+                         (format "R%8.2f%s%.31s\n" p d desc)))))
 
 (defn -main []
-  (spit out-file (doall (reduce str (mapcat create-tags items)))))
+  (with-open [file (clojure.java.io/reader "../../produce.csv")]
+    (spit "pricefile.txt" (reduce create-tags "" (rest (read-csv file))))))

elisp/mschristiansen/README.org

@@ -0,0 +1,6 @@
+* Holling Berries Challenge in Emacs Lisp
+
+Open berries.el in GNU Emacs and evaluate the buffer with 'C-c v' Then
+run 'M-x berries-pricefile' and give the produce.csv file. The program
+will create a new buffer named pricefile.txt with the labels.
+

elisp/mschristiansen/berries-test.el

@@ -0,0 +1,31 @@
+;;; berries-test.el -- tests for berries.el
+
+;; No copyright
+
+;; Author: Mikkel S. Christiansen
+;; Version: 1.0
+;; Package-Requires: nil
+;; Keywords: text parsing
+
+;;; Commentary:
+
+(require 'berries)
+
+(ert-deftest berries-test-label ()
+  "Test the label function in berries.el"
+  (should (string=
+           "R   21.072012/02/29Apples 1kg Golden Delicious. Th\n"
+           (format label 21.07 "2012/02/29"
+                   "Apples 1kg Golden Delicious. The sweetest Apples!"))))
+
+(ert-deftest test-sell-by ()
+  (should (string= "2012/02/29" (sell-by 1101 "15" "2012/02/15"))))
+
+(ert-deftest test-price ()
+  (should (equal 21.07 (price 1101 "15" 15.05))))
+
+(ert-deftest test-create-labels ()
+  (should (string= "R   21.072012/02/29Apples 1kg Golden Delicious. Th\n"
+                   (create-labels '("15" "1101" "Apples 1kg Golden Delicious. The sweetest Apples! Always a favourite. Love, Mrs. Hollingberry" "2012/02/15" "1505" "1"))))
+  (should (string= "R   18.032012/02/27Apples 1kg Red. Less crunchy th\n"
+                   (create-labels '("32" "1103" "Apples 1kg Red. Less crunchy than the green ones, that's for sure. I prefer these myself nowadays. Love, Mrs. Hollingberry" "2012/02/16" "1431" "1")))))

elisp/mschristiansen/berries.el

@@ -0,0 +1,100 @@
+;;; berries.el --- Helping Mr. and Mrs. Holling Berries
+
+;; No copyright
+
+;; Author: Mikkel S. Christiansen
+;; Version: 1.0
+;; Package-Requires: nil
+;; Keywords: text parsing
+
+;;; Commentary:
+
+;; This program was written for the HollingBerries Challenge
+;; Details here: https://github.com/apauley/HollingBerries
+
+(defconst label "R%8.2f%s%.31s\n" "Label format")
+(defconst poor-suppliers '("32" "101") "Susan, Togetherness")
+(defconst premium-suppliers '("219" "204") "Karel, Promise")
+
+(defun fruit (code)
+  (cond
+   ((betweenp code 1100 1199) 'apples)
+   ((betweenp code 1200 1299) 'bananas)
+   ((betweenp code 1300 1399) 'berries)))
+
+(defun betweenp (x low high)
+  (and (>= x low) (<= x high)))
+
+(defun lookup (code alist default)
+  "Lookup value based on key and return default value if no match."
+  (or (cdr (assq (fruit code) alist)) default))
+
+(defun markup (code)
+  "Return cost to price multiplier"
+  (lookup code '((berries . 1.55) (bananas . 1.35) (apples . 1.40)) 1.50))
+
+(defun lasts (code)
+  "Return how long a fruit lasts in days"
+  (lookup code '((bananas . 5) (apples . 14)) 7))
+
+(defun price (code supplier cost)
+  (cond
+   ((member supplier premium-suppliers) (ceiling (* cost (+ (markup code) 0.1))))
+   ((member supplier poor-suppliers) (let ((price (- (* cost (markup code)) 2)))
+                                       (if (> 0 price) 0 price)))
+   (t (* cost (markup code)))))
+
+(defun date-only-to-time (date)
+  "Convert from date (YYYY/MM/DD) to Elisp time"
+  (date-to-time (concat (replace-regexp-in-string "/" "-" date) " 00:00:00")))
+
+(defun date-add (date days)
+  "Add the given number of days to the date (YYYY/MM/DD)"
+  (let ((result (time-add (date-only-to-time date)
+                          (seconds-to-time (* days 24 60 60)))))
+    (format-time-string "%Y/%m/%d" result)))
+
+(defun sell-by (code supplier date)
+  "Return the sell-by date for a fruit"
+  (if (member supplier poor-suppliers)
+      (date-add date (- (lasts code) 3))
+    (date-add date (lasts code))))
+
+(defun create-labels (line)
+  (let* ((supplier (first line))
+         (code (string-to-int (second line)))
+         (desc (third line))
+         (delivered (fourth line))
+         (sell-by (sell-by code supplier delivered))
+         (cost (/ (string-to-int (fifth line)) 100.0))
+         (price (price code supplier cost))
+         (amount (string-to-int (sixth line))))
+    (apply 'concat
+           (make-list amount
+                      (format label price sell-by desc)))))
+
+(defun get-product ()
+  (split-string-and-unquote
+   (buffer-substring (line-beginning-position)
+                     (line-end-position)) "[,\n]"))
+
+(defun berries-pricefile (filename)
+  "Can be called interactively e.g. `M-x berries-pricelist'
+   and will prompt for the `produce.csv' file then create
+   `pricelist.txt' in the same directory."
+  (interactive "fproduce.csv file: ")
+  (let ((out-file "pricefile.txt"))
+    (find-file out-file)
+    (erase-buffer)
+    (with-temp-buffer
+      (insert-file-contents filename)
+      (setq in-file (current-buffer))
+      (while (zerop (forward-line 1))
+        (setq product (get-product))
+        (set-buffer out-file)
+        (when product
+          (insert (create-labels product)))
+        (set-buffer in-file))))
+  (message "Labels created!"))
+
+(provide 'berries)