Skip to content
This repository was archived by the owner on Feb 11, 2018. It is now read-only.

Commit

Permalink
Add meetup exercise
Browse files Browse the repository at this point in the history
  • Loading branch information
mbertheau committed May 21, 2015
1 parent 89493f7 commit 5d5a4d5
Show file tree
Hide file tree
Showing 3 changed files with 72 additions and 1 deletion.
3 changes: 2 additions & 1 deletion config.json
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
"repository": "https://github.com/exercism/xracket",
"active": false,
"problems": [
"bob"
"bob",
"meetup"
]
}
47 changes: 47 additions & 0 deletions meetup/example.rkt
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
#lang racket

(require math/number-theory
racket/date)

(define (leap-year? year)
(or (and (divides? 4 year)
(not (divides? 100 year)))
(divides? 400 year)))

(define (days-in-month year month)
(case month
[(1 3 5 7 8 10 12) 31]
[(4 6 9 11) 30]
[(2) (if (leap-year? year) 29 28)]))

(define (make-date year month day)
(seconds->date (find-seconds 0 0 0 day month year #f)))

(define (meetup-day year month weekday week)
(let ([first-of-week
(case week
[(1st) 1]
[(2nd) 8]
[(teenth) 13]
[(3rd) 15]
[(4th) 22]
[(last) (- (days-in-month year month) 6)]
[else (raise-argument-error 'meetup-day "week" 3 year month weekday week)])]
[weekday
(case weekday
[(Sunday) 0]
[(Monday) 1]
[(Tuesday) 2]
[(Wednesday) 3]
[(Thursday) 4]
[(Friday) 5]
[(Saturday) 6]
[else (raise-argument-error 'meetup-day "weekday" 3 year month weekday week)])])
(make-date year month
(+ first-of-week
(modulo
(- weekday
(date-week-day (make-date year month first-of-week))) 7)
))))

(provide meetup-day)
23 changes: 23 additions & 0 deletions meetup/meetup-test.rkt
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
#lang racket

(require rackunit
rackunit/text-ui
racket/date
"meetup.rkt")

(define (make-date year month day)
(seconds->date (find-seconds 0 0 0 day month year #f)))

(define tests
(test-suite
"Tests for the meetup exercise"
(check-equal? (meetup-day 2013 5 'Monday 'teenth) (make-date 2013 5 13))
(check-equal? (meetup-day 2013 2 'Saturday 'teenth) (make-date 2013 2 16))
(check-equal? (meetup-day 2013 5 'Tuesday '1st) (make-date 2013 5 7))
(check-equal? (meetup-day 2013 4 'Monday '2nd) (make-date 2013 4 8))
(check-equal? (meetup-day 2013 9 'Thursday '3rd) (make-date 2013 9 19))
(check-equal? (meetup-day 2013 3 'Sunday '4th) (make-date 2013 3 24))
(check-equal? (meetup-day 2013 10 'Thursday 'last) (make-date 2013 10 31))
(check-equal? (meetup-day 2012 2 'Wednesday 'last) (make-date 2012 2 29))))

(exit (if (zero? (run-tests tests)) 0 1))

0 comments on commit 5d5a4d5

Please sign in to comment.