revenue.lisp

;;; -*- indent-tabs-mode:nil; -*-

;;; [2018-07-11] Challenge #365 [Intermediate] Sales Commissions
;;; /r/dailyprogrammer https://redd.it/8xzwl6
;;; Why do I suck so bad at this? *sigh*

(defun p () (load #P"~/reddit/dailyprogrammer/revenue.lisp"))

(defconstant commission-rate (/ 6.2 100)) ;percent

(defparameter table
  (format nil "~{~a~%~}~%"
          '("Revenue"
            ""
            "            Johnver Vanston Danbree Vansey  Mundyke"
            "Tea             190     140    1926     14      143"
            "Coffee          325      19     293   1491      162"
            "Water           682      14     852     56      659"
            "Milk            829     140     609    120       87"
            ""
            "Expenses"
            ""
            "            Johnver Vanston Danbree Vansey  Mundyke"
            "Tea             120      65     890     54      430"
            "Coffee          300      10      23    802      235"
            "Water            50     299    1290     12      145"
            "Milk             67     254      89    129       76")))


;;instead of reading the string-stream within block return the stream itself
(defparameter *table-input* (with-input-from-string ($_ table) $_))

(defparameter *salesmen* nil)
(defparameter *inventory* nil)
(defparameter *total-sales* nil)
(defparameter *commissions* nil)

(defmacro include (elem collection &key (test eq))
  `(unless (find ,elem ,collection :test ,test)
     (setq ,collection (append ,collection (list ,elem)))))

(defun read-section (section in-stream)
  (let ((multiplier (cond
                      ((string= "Revenue" section)   1)
                      ((string= "Expenses" section) -1)
                      (t (error (format nil "read-section: unknown section ~s" section)))))
        (roster nil)
        (item nil)
        (costs nil)
        (record nil))

    (setq roster (read-fields))
    ;;if it was an empty section... two+ employees required
    (if (cdr roster)
        (dolist (x roster) (include x *salesmen* :test #'string=))
        (return-from read-section (car roster)))

    (setq item (read-fields))

    (loop
       while (cdr item)
       do
         (setq costs (mapcar #'parse-integer (cdr item)))
         (setq item (car item))
         (include item *inventory* :test #'string=)

         (setq record
               (mapcar #'(lambda (r c) (cons (cons r item) c))
                       roster
                       (mapcar #'(lambda (x) (* x multiplier)) costs)))

         (setq *total-sales* (append record *total-sales*))
         (setq item (read-fields in-stream)))
    (car item)))


;;#'split is forward reference, can't invoke until defun'd
(defun read-fields (&optional (in-stream *table-input*))
  (let ((line "")
        (fields nil))
    (loop
       while (and line (not fields))
       do
         (setq line (read-line in-stream nil))
         (setq fields (split line)))
    fields))

;;why is this not a standard function...
(defun split (str &key (start 0) (end nil) (fs '(#\Space #\Tab)))
  ;;helper local function
  (labels ((split-point-p (x) (find x fs)))
    ;;skip leading spacers, or return nil if no element found
    (when (setq start (position-if-not #'split-point-p str :start start))
      ;;this might be nil...
      (setq end (position-if #'split-point-p str :start start))
      ;;returns as a list
      (cons (subseq str start end)
            ;;nil if consing last element without extra spaces at end (bug fix)
            (when end (split str :start end :fs fs))))))


(defun find-all (item sequence
                 &key
                   (from-end nil)
                   (test #'eq)
                   (test-not nil)
                   (start 0)
                   (end nil)
                   (key nil))
  (let ((len (length sequence))
        (pos (position item sequence
                       :from-end from-end
                       :test test
                       :test-not test-not
                       :start start
                       :end end
                       :key key)))

    (unless end (setq end len))

    (when pos
      (cons (elt sequence pos)
            (or (when (and from-end (< 0 pos))
                  (find-all item sequence
                            :from-end from-end :test test :test-not test-not :start start :end pos :key key))
                (when (< (+ 2 start) end)
                  (find-all item sequence
                            :from-end from-end :test test :test-not test-not :start (1+ pos) :end end :key key)))))))



;;;----- MAIN -----

(setq f (read-fields))
(setq section (car f))

;;read the table...
(loop
   while section
   do
     (setq section (read-section section *table-input*)))
     ;(format t "salesmen=~a~%inventory=~a~%records=~a~%~%" *salesmen* *inventory* *total-sales*))

;;calculate commissions...
(dolist (s *salesmen*)
  (let ((sum 0)
        (acc 0)
        (record (find-all s *total-sales* :test #'string= :key #'caar)))

    (dolist (i *inventory*)
      (let* ((tmp (find-all i record :test #'string= :key #'cdar))
             (acc nil))
        (setq acc (reduce #'(lambda (a b) (+ a (cdr b))) tmp :initial-value 0))
        (when (> acc 0) (incf sum acc))))

    (setq *commissions* (cons (cons s (* sum commission-rate)) *commissions*))))

;;prepare formatting...

(setq *commissions* (reverse *commissions*)) ;correct order

(defconstant *fmt*
  (with-output-to-string (str)
    (format str "~~{")
    (let ((w 0)
          (d 2))
      (dolist (x *commissions*)
        (setq w (1+ (length (car x))))
        (format str "~~~d,~dF" w d)))
    (format str "~~}~~%")))

;;names row
(format t (format nil "~?" "~~~dT " (list (length "Commissions"))))
(format t
        "~{~a~^ ~}~%"
        (mapcar #'car *commissions*))

;;commission row
(format t "~a" "Commissions")
(format t
        *fmt*
        (mapcar #'cdr *commissions*))