Bringing Clojure to project Euler 19

Question

I recently began learning Clojure for fun, and after completing the koans, I decide that project Euler would provide my next challenge. Here is the problem statement:

(If someone knows how to put this in spolier tags with out breaking the formatting, please feel free to edit or comment and let me know how to fix it.)

Counting Sundays Problem 19

You are given the following information, but you may prefer to do some research for yourself.

• 1 Jan 1900 was a Monday.
• Thirty days has September,
• April, June and November.
• All the rest have thirty-one,
• Saving February alone,
• Which has twenty-eight, rain or shine.
• And on leap years, twenty-nine.
• A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

This is the code I used to arrive at the solution. Note that I purposely avoided the date/time APIs so I could try more of the language features out.

(ns euler.n19)


(def week-days (cycle [:mon :tue :wed :thr :fri :sat :sun]))

(defn leap-year?
  ([year] (if (= 0 (mod year 100))
            (= 0 (mod year 400))
            (= 0 (mod year 4)))))

(def months [:jan :feb :mar :apr :may :jun :jul :agu :sep :oct :nov :dec])
(def month-length {:jan 31 :feb 28 :mar 31 :apr 30 
                   :may 31 :jun 30 :jul 31 :agu 31
                   :sep 30 :oct 31 :nov 30 :dec 31})
(def leap-year-month-length (assoc month-length :feb 29))

(def years (->> (range 1901 2001)
               (map (fn [yr] (if (leap-year? yr) 
                               leap-year-month-length 
                               month-length)))))

(defn zip
  ([coll-1 coll-2] map list coll-1 coll-2))

(defn count-number-of-times-day-on-nth-of-month
  ([day date]
   (->> years
        (map (fn [month-len] (map #(% month-len) months)))
        (flatten)
        (reduce (fn [[week-days num-occurrences] curr-month-len]
                  [(drop curr-month-len week-days)
                   (if (= day (nth week-days date))
                     (inc num-occurrences)
                     num-occurrences)])
                [(drop 1 week-days) 0])
        (second))))

(defn main ([]  println (count-number-of-times-day-on-nth-of-month :sun 0)))

In particular, I'm wondering how the reduce in count-number-of-times-day-on-nth-of-month could be clarified since it looks very messy to me.

(As an aside, after a few hours of pouring over this and the koans, I noticed that it is now very hard to type my other code correctly :)

Answer 1

A function that gives you the sequence of month lengths in a given year:

(defn month-seq [year]
  (map
    (if (leap-year? year) leap-year-month-length month-length)
    months))

... is all that your count-number-of-times-day-on-nth-of-month function needs.

• I've extended it to accept a year-range as well as day and date.
• I've replaced
  • flatten with the simpler mapcat and
  • reduce with reductions, to simplify the algorithm.

The result is ...

(defn count-number-of-times-day-on-nth-of-month
  [year-range day date]
  {:pre [(>= (first year-range) 1900)]}
  (let [month-lengths (mapcat month-seq (range 1900 (inc (last year-range))))
        day-seqs (reductions
                   (fn [s n] (drop n s))
                   week-days
                   month-lengths)
        first-days (map first day-seqs)]
    (->> first-days
         (drop (+ (* 12 (- (first year-range) 1900)) date))
         butlast
         frequencies
         day)))

For example,

(count-number-of-times-day-on-nth-of-month (range 1901 2001) :sun 0)

---

Odds and ends

• Your zip function (unused) and main function are each missing a pair of parentheses.
• If there is only one arity, there is no need for parentheses around the argument list and body.

For example,

(defn zip
  [coll-1 coll-2] (map list coll-1 coll-2))

---

Edited to correct a sign error in dealing with the date argument to count-number-of-times-day-on-nth-of-month.

Answer 2

My previous answer

• needlessly departs from the original and
• fails to expose its problems.

Let's have another go.

The function count-number-of-times-day-on-nth-of-month has one or two problems:

• The start day, 1 Jan 2001, is a Tuesday. This drops from the sky. It isn't derived from the given fact that 1 Jan 2000 is a Monday.
• In the reduce
  • The initial week day is not tested. It should be.
  • The final week day is tested. It should not be.

The one-off errors don't affect the problem case, because neither the initial nor final values fall on a Sunday.

---

Let's put the function into better shape.

• Replace the hazardous flatten with simple concat.
• Fuse it into the preceding map to make a mapcat.
• Keywords are functions. So we can use month-len as such in the mapcat function.
• Move the nth out of the loop into the initial drop.

This give us

(defn count-number-of-times-day-on-nth-of-month
  [day date]
  (->> years
       (mapcat (fn [month-len] (map month-len months)))
       (reduce (fn [[week-days num-occurrences] curr-month-len]
                 [(drop curr-month-len week-days)
                  (if (= day (first week-days))
                    (inc num-occurrences)
                    num-occurrences)])
               [(drop (inc date) week-day-cycle) 0])
       (second)))

Now we split the complex reduce into a reduction followed by a series of simple sequence functions.

(defn count-number-of-times-day-on-nth-of-month
  [day date]
  (->> years
       (mapcat (fn [month-len] (map month-len months)))
       (reductions
         (fn [week-days curr-month-len] (drop curr-month-len week-days))
         (drop (inc date) week-day-cycle))
       butlast
       (map first)
       (filter #(= day %))
       count))

This is slower but clearer. It isn't quite the same, as it correctly considers the initial value. However, we still have to chop off the final one. The requisite butlast has to come between the mapcat and the filter.

---

I've said that the code is flawed. This is difficult to prove. However, I found a way to frame the algorithm to make it easier to test.

The idea is to pass the calendar information into the function as a configuration object. We build up the standard calendar as follows:

(def standard-months [:jan :feb :mar :apr :may :jun :jul :agu :sep :oct :nov :dec])

(def non-leap-month-lengths
  (into {}
    (map
      (juxt identity #(case %, (:sep :apr :jun :nov) 30, :feb 28, 31))
      standard-months)))
(def leap-month-lengths (assoc non-leap-month-lengths :feb 29))

(defn standard-month-lengths [year]
  (if (leap-year? year) leap-month-lengths non-leap-month-lengths))

(def standard-calendar
  {:year-zero 1900
   :week-days [:mon :tue :wed :thr :fri :sat :sun]
   :months standard-months
   :month-lengths standard-month-lengths})

Then the general function becomes

(defn count-week-days-on-month-day
  [calendar [from-year up-to-year] month-day]
  (let [{:keys [year-zero week-days months month-lengths]} calendar]
    (->> (range year-zero up-to-year)
         (mapcat (comp #(map % months) month-lengths))
         (drop (+ (* (count months) (- from-year year-zero))))
         butlast
         (reductions
           (fn [wds cml] (drop cml wds))
           (drop (dec month-day) (cycle week-days)))
         (map first)
         frequencies)))

This

• drops the months preceding from-year explicitly;
• delivers the map of frequencies of all the week-days;
• starts with the first of the month at number 1.

The problem solution becomes

(defn count-number-of-times-day-on-nth-of-month [week-day month-day]
  (week-day (count-week-days-on-month-day
              standard-calendar [1901 2001]
              month-day)))

(count-number-of-times-day-on-nth-of-month :sun 1)

This produces the same answer as before, but the general function is easier to test. For example, ...

(def test-calendar
  {:year-zero 100
   :week-days [:doh :rae :me]
   :months [:yip]
   :month-lengths (constantly (constantly 1))})

(count-week-days-on-month-day test-calendar [100 110] :rae 1)
;{:doh 4, :rae 3, :me 3}

Notice that

• the frequencies add up to 10 - correct;
• the frequency of :doh is greater, as it should be.

This suggests that this code is correct and the original code is flawed.

---

Notes

• 1900 is not a leap year.
• So 1 Jan 2001 is 365 days after 1 Jan 1900.
• (mod 365 7) is 1.
• So 1 Jan 2001 falls one week-day later than 1 Jan 1900, a Tuesday.