Skip to content

Instantly share code, notes, and snippets.

@glts
Created December 20, 2013 18:36
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save glts/8059302 to your computer and use it in GitHub Desktop.
Save glts/8059302 to your computer and use it in GitHub Desktop.
Tool for exploring a time-tracking system
;; Tool for exploring a time-tracking system
;;
;; Some time-tracking systems track time differently from what
;; an employee expects. Suppose you work 80%, Monday to Thursday. Some
;; time-tracking systems sum your hours up and distribute them over
;; the week: on average you'll work overtime Monday to Thursday, and
;; work too little on Friday. On average this is fair, but depending
;; on when the holidays are it can cost the employee a few hours.
(defn select
"Returns a lazy seq of all possible selections when taking
from coll n times. Recursive function."
[coll n]
(cond
(zero? n) [[]]
:else (let [sels (select coll (dec n))]
(for [c coll s sels] (cons c s)))))
;; Time-tracking
(def hours-per-week 42M)
(def hours-per-day (/ hours-per-week 5))
(def hoursmap {:full hours-per-day
:half (/ hours-per-day 2)
:off 0})
(defn timetrack-schedule
"Takes an employee's weekly schedule [:full :full :full :half :off] and
some week's holiday mask [1 1/2 0 0 1] and returns a seq of hours as billed
by the time-tracking system, in this example (5.88M 2.94M 0 0 5.88M)."
[schedule mask]
(let [hours (map hoursmap schedule)
dailyavg (/ (reduce + hours) (count hours))]
(map * (repeat dailyavg) mask)))
(defn actual-schedule
"Takes a schedule and a holiday mask as for \"timetrack-schedule\"
and returns a seq of hours that the employee can be expected to work
in that week, for example (8.4M 4.2M 0 0 0)."
[schedule mask]
(map (fn [pensum workload]
(if (and (= :half pensum) (= 1/2 workload))
(hoursmap :half) ; special case :half and 1/2 => 4.2 hours of work
(* (hoursmap pensum) workload)))
schedule mask))
(defn daily-diffs
"Takes a schedule and a holiday mask as for \"timetrack-schedule\"
and returns a seq of the differences between the actual work hours
and the billed work hours. These equal out at the end of a normal work
week (but not necessarily on a week with holidays)."
[schedule mask]
(let [actual (actual-schedule schedule mask)
billed (timetrack-schedule schedule mask)]
(map - actual billed)))
(defn week-diff
"Returns a week's difference between actual and billed work hours."
[schedule mask]
(reduce + (daily-diffs schedule mask)))
;; Exploration
(def schedule-david [:full :full :full :full :off])
(def schedule-mina [:full :full :full :half :off])
(def schedule-grete [:full :full :off :full :off])
(def schedule-tim [:full :full :off :full :full])
(def week-ordinary [1 1 1 1 1])
(def week-vacation [0 0 0 0 0])
(def week-2013-01 [1/2 0 0 1 1])
(def week-2013-31 [1 1 1 0 1])
(def week-2013-52 [1 1/2 0 0 1])
(def week-2014-01 [1 1/2 0 0 1])
;; Check whether David is being treated fairly
(assert (zero? (week-diff schedule-david week-ordinary))
"Total of daily diffs of ordinary week must equal 0!")
(assert (zero? (week-diff schedule-david week-vacation))
"Total of daily diffs of vacation week must equal 0!")
(let [all-possible-weeks (select [1 1/2 0] 5)]
(assert
(zero?
(reduce + (for [week all-possible-weeks] (week-diff schedule-david week))))
"Grand total of daily diffs of all week schedules must equal 0!"))
;; Check whether David got lucky with the 2013/2014 holidays
(println (+ (week-diff schedule-david week-2013-52)
(week-diff schedule-david week-2014-01))) ; => no! :(
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment