fork download
copy 
  1. ; billing period
  2.  
  3. (define (julian year month day)
  4.   (let* ((a (quotient (- 14 month) 12))
  5.          (y (+ year 4800 (- a)))
  6.          (m (+ month (* 12 a) -3)))
  7.     (+ day
  8.        (quotient (+ (* 153 m) 2) 5)
  9.        (* 365 y)
  10.        (quotient y 4)
  11.        (- (quotient y 100))
  12.        (quotient y 400)
  13.        (- 32045))))
  14.  
  15. (define (gregorian julian)
  16.   (let* ((j (+ julian 32044))
  17.          (g (quotient j 146097))
  18.          (dg (modulo j 146097))
  19.          (c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
  20.          (dc (- dg (* c 36524)))
  21.          (b (quotient dc 1461))
  22.          (db (modulo dc 1461))
  23.          (a (quotient (* (+ (quotient db 365) 1) 3) 4))
  24.          (da (- db (* a 365)))
  25.          (y (+ (* g 400) (* c 100) (* b 4) a))
  26.          (m (- (quotient (+ (* da 5) 308) 153) 2))
  27.          (d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
  28.          (year (+ y (- 4800) (quotient (+ m 2) 12)))
  29.          (month (+ (modulo (+ m 2) 12) 1))
  30.          (day (+ d 1)))
  31.     (values year month day)))
  32.  
  33. (define (period year month day)
  34.   (define (first-of-month? julian)
  35.     (call-with-values
  36.       (lambda () (gregorian julian))
  37.       (lambda (year month day) (= day 1))))
  38.   (do ((j (julian year 1 1) (+ j 1))
  39.        (p 0 (+ p (if (or (= (modulo j 7) 5) (first-of-month? j)) 1 0))))
  40.       ((< (julian year month day) j) p)))
  41.  
  42. (display (period 2018 5 18)) (newline)
Success #stdin #stdout 0.06s 8304KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
24
https://ideone.com/UhtqXu
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!