From: Vladimir V. Zolotych
Subject: TIME-RANGE
Date: 
Message-ID: <3A7EFE5E.7CCE3FE@eurocom.od.ua>
  Hello

This is my first program on Common Lisp.

;; (print-time-range (make-time-range "01:00:00" "08:00:00")) =>
("01:00:00" "08:00:00")
;; (ignore (setf t18 (make-time-range "01:00:00" "08:00:00"))) => nil
;; (ignore (setf t81 (make-time-range "08:00:00" "01:00:00"))) => nil
;; (ignore (setf ss1 (make-time-range "00:30:00" "01:15:17"))) => nil
;; (print-time-range (difference t18 ss1)) => ("01:15:17" "08:00:00")
;; (print-time-range (intersection t81 ss1)) => ("00:30:00" "01:00:00")
;; (print-time-range (difference t18 ss1)) => ("00:30:00" "01:15:17")


;; I'm not sure about the following EVAL-WHEN.
;; I can't compile w/o it.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "pregexp" "/usr/local/cmucl/pregexp/pregexp"))
;; Is it possible to customize place(s) where modules reside ?

(defpackage #:time-range
  (:nicknames #:tr)
  (:use #:common-lisp)
  (:export #:print-time-range #:make-time-range #:difference
#:intersection #:elapsed)
  (:import-from :cl-user #:pregexp-match))

(in-package #:tr)

(defconstant seconds-per-day (* 24 60 60))

(defstruct time
  (hour 0)
  (minute 0)
  (second 0))

(deftype time-range ()
  `(array bit (,seconds-per-day)))

(defun parse-time (time-string)
  "Get broken representation of the time (e.g hour, minute, second)."
  (let ((a (pregexp-match "(\\d{1,2}):(\\d{1,2}):(\\d{1,2})"
time-string)))
    (when a
      (destructuring-bind (hour minute second)
	  `(,@(mapcar #'read-from-string (cdr a)))
	(make-time :hour hour :minute minute :second second)))))

(defun time-to-seconds (time-string)
  "Convert string repr. of a time (e.g 08:00:00) to seconds."
  (let (a)
    (assert (setf a (parse-time time-string)) (time-string))
    (encode-universal-time (time-second a) (time-minute a) (time-hour a)
	      1 1 1900 0)))

(defun seconds-to-time (seconds)
  (multiple-value-bind (second minute hour) (decode-universal-time
seconds 0)
    (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second)))

(defun make-time-range (&rest intervals)
  (assert (and (> (length intervals) 0) (evenp (length intervals)))
(intervals))
  (let ((a (make-array seconds-per-day :element-type 'bit
:initial-element 0)))
    (labels ((set-time-range (array start end)
	       (declare (type time-range a))
	       (if (< end start)
		   (progn
		     (set-time-range array 0 end)
		     (set-time-range array start seconds-per-day))
		   (fill array 1 :start start :end end))))
      (do ((i intervals (nthcdr 2 i)))
	  ((null i))
	(set-time-range a (time-to-seconds (first i))
			(time-to-seconds (second i)))))
    a))

;; Is it worth to rewrite PRINT-TIME-RANGE with LOOP ?

(defun print-time-range (r)
  (let ((a 0) (b 0) (result nil))
    (loop
     (unless (setf a (position 1 r :start b)) (return))
     (push (seconds-to-time a) result)
     (push (seconds-to-time (cond ((setf b (position 0 r :start (1+
a))))
				  (t seconds-per-day)))
	   result)
     (unless b (return)))
    (reverse result)))

(defmacro elapsed (r)
  "Lenght of the R in seconds."
  (declare (type time-range r))		; Is DECLARE useful here?
  `(count 1 ,r))

(defmacro difference (r1 r2)
  "Subtract R2 from R1."
  `(bit-andc2 ,r1 ,r2))

(defmacro intersection (r1 r2)
  "Returns intersection of R1 and R2."
  `(bit-and ,r1 ,r2))

(defmacro ignore (form)
  `(progn
    ,form
    nil))

What do you think about it ?

Using CMUCL 18c.

I'd like to hear your opinions.

-- 
Vladimir Zolotych                         ······@eurocom.od.ua
From: Rainer Joswig
Subject: Re: TIME-RANGE
Date: 
Message-ID: <joswig-B82C59.08104706022001@news.is-europe.net>
  Hello
  
  This is my first program on Common Lisp.

Some comments.

You should make sure that there is no word wrap when
posting - otherwise it looks a bit distorted.
  
  ;; (print-time-range (make-time-range "01:00:00" "08:00:00")) => ("01:00:00" "08:00:00")
  ;; (ignore (setf t18 (make-time-range "01:00:00" "08:00:00"))) => nil
  ;; (ignore (setf t81 (make-time-range "08:00:00" "01:00:00"))) => nil
  ;; (ignore (setf ss1 (make-time-range "00:30:00" "01:15:17"))) => nil
  ;; (print-time-range (difference t18 ss1)) => ("01:15:17" "08:00:00")
  ;; (print-time-range (intersection t81 ss1)) => ("00:30:00" "01:00:00")
  ;; (print-time-range (difference t18 ss1)) => ("00:30:00" "01:15:17")
  
You give some examples what it should do. But you should explain
what the the problem is you want to solve,
what you want to achieve with your code, what the design
decisions are, what it limits are, etc.

How would you describe and document a new datatype,
its operations and its properties? How would you
test that your code does the right thing?

  
  ;; I'm not sure about the following EVAL-WHEN.
  ;; I can't compile w/o it.
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (require "pregexp" "/usr/local/cmucl/pregexp/pregexp"))
  ;; Is it possible to customize place(s) where modules reside ?
  
Your implementation manual may explain this. Often it
is possible.

  (defpackage #:time-range
    (:nicknames #:tr)
    (:use #:common-lisp)
    (:export #:print-time-range #:make-time-range #:difference
             #:intersection #:elapsed)
    (:import-from :cl-user #:pregexp-match))

I don't like the #: notation, but that's me. In CMUCL it is
basically not necessary.
  
  (in-package #:tr)
  
  (defconstant seconds-per-day (* 24 60 60))
  
  (defstruct time
    (hour 0)
    (minute 0)
    (second 0))

Common Lisp already has a datatype for time: integers.
You need to explain, why you need a new representation.
  
  (deftype time-range ()
    `(array bit (,seconds-per-day)))
  
Why do you choose a bit array as a representation?
Every time range will need 10kbytes - this seems
a lot of space wasted (I remember times when computers
had only 8kb for the whole RAM).

  (defun parse-time (time-string)
    "Get broken representation of the time (e.g hour, minute, second)."
    (let ((a (pregexp-match "(\\d{1,2}):(\\d{1,2}):(\\d{1,2})"
                            time-string)))
      (when a
        (destructuring-bind (hour minute second)
                            `(,@(mapcar #'read-from-string (cdr a)))
          (make-time :hour hour :minute minute :second second)))))

What is the difference between

  `(,@(mapcar #'1+ '(1 2 3)))

and

  (mapcar #'1+ '(1 2 3))  ?


  (defun time-to-seconds (time-string)
    "Convert string repr. of a time (e.g 08:00:00) to seconds."
    (let (a)
      (assert (setf a (parse-time time-string)) (time-string))
      (encode-universal-time (time-second a) (time-minute a) (time-hour a)
                         1 1 1900 0)))

You are not converting your time structures to seconds, but you are
using Common Lisp's time representation.
It would have been sufficient to do (+ seconds (* minutes 60) (* hours 3600)).

  (defun seconds-to-time (seconds)
    (multiple-value-bind (second minute hour) (decode-universal-time
                                               seconds 0)
      (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second)))

Same in the opposite direction.  

  (defun make-time-range (&rest intervals)
    (assert (and (> (length intervals) 0) (evenp (length intervals)))
            (intervals))
    (let ((a (make-array seconds-per-day :element-type 'bit :initial-element 0)))
      (labels ((set-time-range (array start end)
                 (declare (type time-range a))
                 (if (< end start)
                   (progn
                     (set-time-range array 0 end)
                     (set-time-range array start seconds-per-day))
                   (fill array 1 :start start :end end))))
        (do ((i intervals (nthcdr 2 i)))
            ((null i))
          (set-time-range a
                          (time-to-seconds (first i))
                          (time-to-seconds (second i)))))
      a))
  

  ;; Is it worth to rewrite PRINT-TIME-RANGE with LOOP ?
  
  (defun print-time-range (r)
    (let ((a 0) (b 0) (result nil))
      (loop
        (unless (setf a (position 1 r :start b))
          (return))
        (push (seconds-to-time a) result)
        (push (seconds-to-time (cond ((setf b (position 0 r :start (1+ a))))
                                     (t seconds-per-day)))
              result)
        (unless b (return)))
      (reverse result)))

See also PRINT-OBJECT .
  
  (defmacro elapsed (r)
    "Lenght of the R in seconds."
    (declare (type time-range r))        ; Is DECLARE useful here?
    `(count 1 ,r))

DECLARE is not very useful in the above position. The compiler
does not see the declaration when compiling the COUNT form.

An function would sufficient - instead of a macro.
If you would get rid of the extra function call,
declare it inline.
  
  (defmacro difference (r1 r2)
    "Subtract R2 from R1."
    `(bit-andc2 ,r1 ,r2))
  
  (defmacro intersection (r1 r2)
    "Returns intersection of R1 and R2."
    `(bit-and ,r1 ,r2))
  
  (defmacro ignore (form)
    `(progn
       ,form
       nil))

-- 
Rainer Joswig, Hamburg, Germany
Email: ·············@corporate-world.lisp.de