extra/project-euler/019/019.factor

   1 ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: calendar combinators kernel math math.ranges namespaces sequences
   4     math.order project-euler.common ;
   5 IN: project-euler.019
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=19
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! You are given the following information, but you may prefer to do some
  13 ! research for yourself.
  14
  15 !     * 1 Jan 1900 was a Monday.
  16 !     * Thirty days has September, April, June and November.  All the rest have
  17 !       thirty-one, Saving February alone, Which has twenty-eight, rain or
  18 !       shine.  And on leap years, twenty-nine.
  19 !     * A leap year occurs on any year evenly divisible by 4, but not on a
  20 !       century unless it is divisible by 400.
  21
  22 ! How many Sundays fell on the first of the month during the twentieth century
  23 ! (1 Jan 1901 to 31 Dec 2000)?
  24
  25
  26 ! SOLUTION
  27 ! --------
  28
  29 ! Use Zeller congruence, which is implemented in the "calendar" module
  30 ! already, as "(day-of-week) ( year month day -- n )" where n is
  31 ! the day of the week (Sunday is 0).
  32
  33 : euler019 ( -- answer )
  34     1901 2000 [a..b] [
  35         12 [1..b] [ 1 (day-of-week) ] with map
  36     ] map concat [ 0 = ] count ;
  37
  38 ! [ euler019 ] 100 ave-time
  39 ! 1 ms ave run time - 0.51 SD (100 trials)
  40
  41
  42 ! ALTERNATE SOLUTIONS
  43 ! -------------------
  44
  45 <PRIVATE
  46
  47 : start-date ( -- timestamp )
  48     1901 1 1 <date> ;
  49
  50 : end-date ( -- timestamp )
  51     2000 12 31 <date> ;
  52
  53 : first-days ( end-date start-date -- days )
  54     [ 2dup after=? ]
  55     [ dup 1 months time+ swap day-of-week ]
  56     produce 2nip ;
  57
  58 PRIVATE>
  59
  60 : euler019a ( -- answer )
  61     end-date start-date first-days [ 0 = ] count ;
  62
  63 ! [ euler019a ] 100 ave-time
  64 ! 17 ms ave run time - 2.13 SD (100 trials)
  65
  66 SOLUTION: euler019