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

[Matthias Felleisen]

Now eliminate the set! -- Matthias

On Sep 13, 2004, at 9:20 PM, Doug Orleans wrote:

> 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
>
> _______________________________________________
> PRL mailing list
> PRL at lists.ccs.neu.edu
> https://lists.ccs.neu.edu/bin/listinfo/prl