[PRL] Perl to MzScheme, line-by-line

[Doug Orleans]

Here's a line-by-line translation of Jeff's Perl program to MzScheme,
followed by my own rewrite.  Note that Jeff's program has a bug,
triggered by "1705"; also, I think "0515" was meant to be "1715".
(I fixed both of these in my rewrite.)


#!/usr/local/bin/mzscheme -r

(define days #(mon tue wed thu fri))

;; day -> constraints
;; a constraints is a vector of (start,stop) times
(define constraints
  #hash(
  ;;       mitch          will
  (mon . #("1200" "1330"  "1330" "1445"))
  ;;       carl et al     will           sam            jeff
  (tue . #("1145" "1705"  "1600" "2345"  "1100" "0515"  "0800" "1130"))
  ;;       pl             will
  (wed . #("1145" "1330"  "1145" "1445"))
  ;;       mitch          mitch          mitch          will           will           sam
  (thu . #("0900" "1100"  "1200" "1330"  "1330" "1445"  "1445" "1800"  "1800" "2100"  "1230" "1330"))
  ;;       mitch          will           sam
  (fri . #("0800" "2145"  "0800" "2145"  "1300" "1500"))
  ))

(define ok 1)
(define start-hour 8)
(define stop-hour 21)
(display "Day ")
(do ((h start-hour (add1 h))) ((> h stop-hour))
  (let ((hour (if (< h 10) (format "0~a" h) h)))
    (printf "~a00 " hour))
)
(newline)
(do ((i 0 (add1 i))) ((>= i (vector-length days)))
  (let* ((stack 0)
	 (day (vector-ref days i))
	 (cst (hash-table-get constraints day)))
    (display day)
    (do ((h start-hour (add1 h))) ((> h stop-hour))
      (let ((hour (if (< h 10) (format "0~a" h) h)))
	(display " ")
	(do ((m 0 (+ m 15))) ((> m 45))
	  (do ((j 0 (+ j 2))) ((>= j (vector-length cst)))
	    (let* ((start (vector-ref cst (+ j 0)))
		   (stop  (vector-ref cst (+ j 1)))
		   (min (if (< m 10) (format "0~a" m) m))
		   (time (format "~a~a" hour min)))
	      (when (equal? time start) (set! stack (add1 stack)))
	      (when (equal? time stop)  (set! stack (sub1 stack)))
	  ))
	  (display (if (zero? stack) " " stack))
	)
    ))
    (newline)
))

#!/usr/local/bin/mzscheme -r

(require (lib "1.ss" "srfi"))		;count

;; day -> constraints
;; a constraints is a plist of (start,stop) times
(define constraints
  '(
  ;;   mitch       will
  (mon (1200 1330) (1330 1445))
  ;;   carl et al  will        sam         jeff
  (tue (1145 1705) (1600 2345) (1100 1715) (0800 1130))
  ;;   pl          will
  (wed (1145 1330) (1145 1445))
  ;;   mitch       mitch       mitch       will        will        sam
  (thu (0900 1100) (1200 1330) (1330 1445) (1445 1800) (1800 2100) (1230 1330))
  ;;   mitch       will        sam
  (fri (0800 2145) (0800 2145) (1300 1500))
  ))

(define start-hour 8)
(define stop-hour 21)
(display "Day ")
(do ((h start-hour (add1 h))) ((> h stop-hour))
  (when (< h 10) (display "0"))
  (display h) (display "00 "))
(newline)
(for-each
 (lambda (day.cst)
   (display (car day.cst))
   (do ((h start-hour (add1 h))) ((> h stop-hour))
     (display " ")
     (do ((m 0 (+ m 15))) ((> m 45))
       (let* ((t (+ m (* h 100)))
	      (n (count (lambda (c) (and (>= t (car c)) (< t (cadr c))))
			(cdr day.cst))))
	 (display (if (zero? n) " " n)))))
   (newline))
 constraints)


--dougo at place.org