From: Emre Sevinc
Subject: Sir, yes Sir!: How many days left to freedom (exercises in CL, FORMAT 	inspired by Haskell)
Date: 
Message-ID: <115b5024-0284-425c-b42f-7903ef1fac5f@f36g2000hsa.googlegroups.com>
As a programmer who is about to finish his obligatory military service
in Turkey (yes it IS obligatory for every male citizen over some age)
I was trying to write some Lisp code
to calculate how many days are left to my leaving day (16th
September).

My first try was as seen below:

(defun remaining-safak ()
  "Return how many days left to leaving the army."
  (/ (- (encode-universal-time 0 0 0 16 9 2008)
	(get-universal-time))
     (* 60 60 24 1.0)))

CL-USER> (format t "~a days left to freedom." (remaining-safak))
37.562374 days left to freedom.

("safak" is a Turkish word meaning "dawn". So the original function
name
can also be read as remaining-days-to-the-dawn-of-freedom.)

When one of my friends saw this first naive attempt he provided a
Haskell
version [1]:

module Main where
import System.Time

tdiff d = do now <- getClockTime
             return $ diffClockTimes d now

safak = toClockTime (CalendarTime 2008 September 16 0 0 0 0 Tuesday 0
"" 0 True)

main = tdiff safak >>= return . (timeDiffToString . normalizeTimeDiff)
>>= print

······@terra:~% runhaskell Main.hs
"1 month, 6 days, 6 hours, 16 mins, 20 secs"
······@terra:~%

Seeing this and being assigned as an Internet sergeant in this
military base
I fired my lispbox once again and gave it another shot (no puns
intended):

(defconstant +seconds-a-minute+ 60)
(defconstant +seconds-a-hour+ (* 60 +seconds-a-minute+))
(defconstant +seconds-a-day+ (* 24 +seconds-a-hour+))
(defconstant +seconds-a-month+ (* 30 +seconds-a-day+))
(defconstant +seconds-a-year+ (* 12 +seconds-a-month+))

(defun time-interval-to-components (time-interval)
  (multiple-value-bind (years r) (truncate time-interval +seconds-a-
year+)
    (multiple-value-bind (months r) (truncate r +seconds-a-month+)
      (multiple-value-bind (days r) (truncate r +seconds-a-day+)
	(multiple-value-bind (hours r) (truncate r +seconds-a-hour+)
	  (multiple-value-bind (minutes seconds) (truncate r +seconds-a-minute
+)
	    (if (= years 0)   (setf years nil))
	    (if (= months 0)  (setf months nil))
	    (if (= days 0) (setf days nil))
	    (if (= hours 0) (setf hours nil))
	    (if (= minutes 0) (setf minutes nil))
	    (if (= seconds 0) (setf seconds nil))
	    (list years months days hours minutes seconds)))))))

(defun print-time-interval (interval-list)
"Prints the string representing the time interval given as a list."
  (format nil ····@[·@(~r~) ~:*~[years~;year,~:;years,~]~]·@[·@(~r~)
~:*~[months~;month~:;months,~]~] ·@[~r ~:*~[days,~;day,~:;days~]~]
·@[~r ~:*~[hours~;hour~:;hours~]~] ·@[~r
~:*~[minutes~;minute~:;minutes~]~] ·@[~r
~:*~[seconds~;second~:;seconds~]~]~}." interval-list))

(defun remaining-safak ()
"Return how many days left."
  (- (encode-universal-time 0 0 0 16 9 2008)
     (get-universal-time)))

CL-USER> (print-time-interval (time-interval-to-components (remaining-
safak)))
"One month five days twelve hours four minutes three seconds."

Not bad I guess and I like the twisted soul of FORMAT's control string
(CLHS
and PCL to the rescue), but I wonder if it could be done in shorter
and more clear way. Haskell System.Time lib seems to have useful date
calculation and conversion functions so I tried
to develop some of it in Lisp. I'm still not happy with the current
format
because it doesn't handle all the cases correctly (e.g. what happens
to the fullstop
if there are zero seconds, thus a SPACE is printed before it).

Comments and criticisms are welcome, and I'll reply by saying: Sir,
yes Sir! ;-)

1- http://tonguc.name/blog/kod/safak-haskell.html

Cheers,
--
Emre Sevinc

From: Volkan YAZICI
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, 	FORMAT inspired by Haskell)
Date: 
Message-ID: <9cd33ea5-4a01-4e29-9ec4-90a1dfeddf42@s50g2000hsb.googlegroups.com>
Selam Emre,

Pascal replied faster, but anyway, here[1] is my lazy turtle:

(defconstant +mins-per-hour+   60)
(defconstant +hours-per-day+   24)
(defconstant +days-per-month+  (/ 265.2425 12)) ; Assume leap year
every four years.
(defconstant +months-per-year+ 12)

(defconstant +secs-per-minute+ 60)
(defconstant +secs-per-hour+   (* +mins-per-hour+ +secs-per-minute+))
(defconstant +secs-per-day+    (* +hours-per-day+ +secs-per-hour+))
(defconstant +secs-per-month+  (round (* +days-per-month+ +secs-per-day
+)))
(defconstant +secs-per-year+   (round (* +months-per-year+ +secs-per-
month+)))

(defparameter *julian-time-units*
  `((,+secs-per-year+   "~d year~:p")
    (,+secs-per-month+  "~d month~:p")
    (,+secs-per-day+    "~d day~:p")
    (,+secs-per-hour+   "~d hour~:p")
    (,+secs-per-minute+ "~d minute~:p")
    (1                  "~d second~:p")))

(defparameter *default-time-units* *julian-time-units*)

(defun decode-universal-interval (interval)
  (nreverse
   (reduce
    (lambda (quotients divisor)
      (cons
       (or
        (unless (< interval divisor)
          (multiple-value-bind (q r) (truncate interval divisor)
            (setq interval r)
            q))
        0)
       quotients))
    (mapcar #'first *default-time-units*)
    :initial-value nil)))

(defun print-universal-interval (interval &optional (stream *standard-
output*))
  (format stream "~{~a~^ ~}"
          (nreverse
           (reduce
            (lambda (accum item)
              (destructuring-bind (quotient fmt) item
                (unless (zerop quotient) (push (format nil fmt
quotient) accum))
                accum))
            (mapcar #'list
                    (decode-universal-interval interval)
                    (mapcar #'second *default-time-units*))
            :initial-value nil))))

(defun format-universal-interval (stream arg colon-p at-sign-p)
  (declare (ignore colon-p at-sign-p))
  (print-universal-interval arg stream))


Regards.

[1] http://paste.lisp.org/display/65133
From: Pascal J. Bourguignon
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, FORMAT  inspired by Haskell)
Date: 
Message-ID: <7c3albkdb1.fsf@pbourguignon.anevia.com>
Emre Sevinc <···········@gmail.com> writes:

> (defconstant +seconds-a-minute+ 60)
> (defconstant +seconds-a-hour+ (* 60 +seconds-a-minute+))
> (defconstant +seconds-a-day+ (* 24 +seconds-a-hour+))
> (defconstant +seconds-a-month+ (* 30 +seconds-a-day+))
> (defconstant +seconds-a-year+ (* 12 +seconds-a-month+))

Introduce more abstraction: instead processing them one by one,
generalize and abstract it aways with a unique vector.

> (defun time-interval-to-components (time-interval)
>   (multiple-value-bind (years r) (truncate time-interval +seconds-a-
> year+)
>     (multiple-value-bind (months r) (truncate r +seconds-a-month+)
>       (multiple-value-bind (days r) (truncate r +seconds-a-day+)
> 	(multiple-value-bind (hours r) (truncate r +seconds-a-hour+)
> 	  (multiple-value-bind (minutes seconds) (truncate r +seconds-a-minute
> +)
> 	    (if (= years 0)   (setf years nil))
> 	    (if (= months 0)  (setf months nil))
> 	    (if (= days 0) (setf days nil))
> 	    (if (= hours 0) (setf hours nil))
> 	    (if (= minutes 0) (setf minutes nil))
> 	    (if (= seconds 0) (setf seconds nil))
> 	    (list years months days hours minutes seconds)))))))

Generalize!  It'll be shorter.

> (defun print-time-interval (interval-list)
> "Prints the string representing the time interval given as a list."
>   (format nil ····@[·@(~r~) ~:*~[years~;year,~:;years,~]~]·@[·@(~r~)
> ~:*~[months~;month~:;months,~]~] ·@[~r ~:*~[days,~;day,~:;days~]~]
> ·@[~r ~:*~[hours~;hour~:;hours~]~] ·@[~r
> ~:*~[minutes~;minute~:;minutes~]~] ·@[~r
> ~:*~[seconds~;second~:;seconds~]~]~}." interval-list))

Study CLHS.  There's ~P for English.

> (defun remaining-safak ()
> "Return how many days left."
>   (- (encode-universal-time 0 0 0 16 9 2008)
>      (get-universal-time)))
>
> CL-USER> (print-time-interval (time-interval-to-components (remaining-
> safak)))
> "One month five days twelve hours four minutes three seconds."
>
> Not bad I guess and I like the twisted soul of FORMAT's control string
> (CLHS and PCL to the rescue), but I wonder if it could be done in shorter
> and more clear way. 

Yes.

> Haskell System.Time lib seems to have useful date
> calculation and conversion functions so I tried
> to develop some of it in Lisp. I'm still not happy with the current
> format because it doesn't handle all the cases correctly (e.g. what happens
> to the fullstop if there are zero seconds, thus a SPACE is printed before it).
>
> Comments and criticisms are welcome, and I'll reply by saying: Sir,
> yes Sir! ;-)


(defun remaining-safak ()
  "Return how many days left."
  (- (encode-universal-time 0 0 0 16 9 2008)
     (get-universal-time)))


(defparameter *time-bases*       '(60       60        24    30     12))
(defparameter *time-bases-names* '("second" "minute" "hour" "day" "month" "year"))

(defmacro define-base-decomposer (name bases)
  "Note: BASES is evaluated."
  `(defun ,name (value)
     (labels ((decompose (value bases result)
                (if (null bases)
                    (reverse (cons (unless (zerop value) value) result))
                    (multiple-value-bind (q r) (truncate value (car bases))
                      (decompose q (cdr bases)
                                 (cons (unless (zerop r) r) result))))))
       (decompose value ,bases '()))))

(define-base-decomposer time-interval-to-components *time-bases*)

(defun format-decomposed-value (decomposed-values bases)
  (substitute #\. #\,
   (format nil "~:{~:[~*~;~:*~A ~A~2:*~P~*, ~]~}"
           (mapcar (function list)
                   (reverse decomposed-values)
                   (reverse bases)))
   :from-end t :count 1))

(format-decomposed-value (time-interval-to-components (remaining-safak))
                        *time-bases-names*)
--> "1 month, 5 days, 11 hours, 43 minutes, 9 seconds. "




(define-base-decomposer decode-mayan-date '(60 60 24 20 18 20 20))
(format-decomposed-value (decode-mayan-date (get-universal-time))
                         '("second""minute""hour""K'in""Winal""Tun""K'atun""B'ak'tun"))
--> "5 K'atuns, 10 Tuns, 3 Winals, 9 K'ins, 10 hours, 26 minutes, 8 seconds. "
(since 19000101T000000)


-- 
__Pascal Bourguignon__
From: Emre Sevinc
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, 	FORMAT inspired by Haskell)
Date: 
Message-ID: <a3e346ff-ac20-40f8-8738-57a6055ed11a@f36g2000hsa.googlegroups.com>
On Aug 11, 2:21 pm, ····@informatimago.com (Pascal J. Bourguignon)
wrote:
> Emre Sevinc <···········@gmail.com> writes:
> > (defconstant +seconds-a-minute+ 60)
> > (defconstant +seconds-a-hour+ (* 60 +seconds-a-minute+))
> > (defconstant +seconds-a-day+ (* 24 +seconds-a-hour+))
> > (defconstant +seconds-a-month+ (* 30 +seconds-a-day+))
> > (defconstant +seconds-a-year+ (* 12 +seconds-a-month+))
>
> Introduce more abstraction: instead processing them one by one,
> generalize and abstract it aways with a unique vector.
[...]
> Generalize!  It'll be shorter.
[...]
> Study CLHS.  There's ~P for English.

Words of wisdom.

Sir, yes Sir! ;-)

--
Emre
From: Daniel Janus
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, FORMAT  inspired by Haskell)
Date: 
Message-ID: <slrnga0u2j.3eg.przesunmalpe@students.mimuw.edu.pl>
Dnia 11.08.2008 Pascal J. Bourguignon <···@informatimago.com> napisa�/a:

> (define-base-decomposer decode-mayan-date '(60 60 24 20 18 20 20))
> (format-decomposed-value (decode-mayan-date (get-universal-time))
>                          '("second""minute""hour""K'in""Winal""Tun""K'atun""B'ak'tun"))
> --> "5 K'atuns, 10 Tuns, 3 Winals, 9 K'ins, 10 hours, 26 minutes, 8 seconds. "
> (since 19000101T000000)

Great!  Now make it output the date in Tzolkin/Haab format.  ;-)

-- 
Daniel 'Nathell' Janus, ······@nathell.korpus.pl, http://korpus.pl/~nathell
Any sufficiently complicated C or Fortran program contains an ad hoc, 
informally-specified, bug-ridden, slow implementation of half of Common Lisp.   
   -- Greenspun's Tenth Rule
From: cmo
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, 	FORMAT inspired by Haskell)
Date: 
Message-ID: <0f332b49-96b9-41bd-8bf4-b22111f376ef@k37g2000hsf.googlegroups.com>
On Aug 11, 3:21 pm, ····@informatimago.com (Pascal J. Bourguignon)
wrote:
> Emre Sevinc <···········@gmail.com> writes:
> > (defconstant +seconds-a-minute+ 60)
> > (defconstant +seconds-a-hour+ (* 60 +seconds-a-minute+))
> > (defconstant +seconds-a-day+ (* 24 +seconds-a-hour+))
> > (defconstant +seconds-a-month+ (* 30 +seconds-a-day+))
> > (defconstant +seconds-a-year+ (* 12 +seconds-a-month+))
>
> Introduce more abstraction: instead processing them one by one,
> generalize and abstract it aways with a unique vector.
>
> > (defun time-interval-to-components (time-interval)
> >   (multiple-value-bind (years r) (truncate time-interval +seconds-a-
> > year+)
> >     (multiple-value-bind (months r) (truncate r +seconds-a-month+)
> >       (multiple-value-bind (days r) (truncate r +seconds-a-day+)
> >    (multiple-value-bind (hours r) (truncate r +seconds-a-hour+)
> >      (multiple-value-bind (minutes seconds) (truncate r +seconds-a-minute
> > +)
> >        (if (= years 0)   (setf years nil))
> >        (if (= months 0)  (setf months nil))
> >        (if (= days 0) (setf days nil))
> >        (if (= hours 0) (setf hours nil))
> >        (if (= minutes 0) (setf minutes nil))
> >        (if (= seconds 0) (setf seconds nil))
> >        (list years months days hours minutes seconds)))))))
>
> Generalize!  It'll be shorter.
>
> > (defun print-time-interval (interval-list)
> > "Prints the string representing the time interval given as a list."
> >   (format nil ····@[·@(~r~) ~:*~[years~;year,~:;years,~]~]·@[·@(~r~)
> > ~:*~[months~;month~:;months,~]~] ·@[~r ~:*~[days,~;day,~:;days~]~]
> > ·@[~r ~:*~[hours~;hour~:;hours~]~] ·@[~r
> > ~:*~[minutes~;minute~:;minutes~]~] ·@[~r
> > ~:*~[seconds~;second~:;seconds~]~]~}." interval-list))
>
> Study CLHS.  There's ~P for English.
>
> > (defun remaining-safak ()
> > "Return how many days left."
> >   (- (encode-universal-time 0 0 0 16 9 2008)
> >      (get-universal-time)))
>
> > CL-USER> (print-time-interval (time-interval-to-components (remaining-
> > safak)))
> > "One month five days twelve hours four minutes three seconds."
>
> > Not bad I guess and I like the twisted soul of FORMAT's control string
> > (CLHS and PCL to the rescue), but I wonder if it could be done in shorter
> > and more clear way.
>
> Yes.
>
> > Haskell System.Time lib seems to have useful date
> > calculation and conversion functions so I tried
> > to develop some of it in Lisp. I'm still not happy with the current
> > format because it doesn't handle all the cases correctly (e.g. what happens
> > to the fullstop if there are zero seconds, thus a SPACE is printed before it).
>
> > Comments and criticisms are welcome, and I'll reply by saying: Sir,
> > yes Sir! ;-)
>
> (defun remaining-safak ()
>   "Return how many days left."
>   (- (encode-universal-time 0 0 0 16 9 2008)
>      (get-universal-time)))
>
> (defparameter *time-bases*       '(60       60        24    30     12))
> (defparameter *time-bases-names* '("second" "minute" "hour" "day" "month" "year"))
>
> (defmacro define-base-decomposer (name bases)
>   "Note: BASES is evaluated."
>   `(defun ,name (value)
>      (labels ((decompose (value bases result)
>                 (if (null bases)
>                     (reverse (cons (unless (zerop value) value) result))
>                     (multiple-value-bind (q r) (truncate value (car bases))
>                       (decompose q (cdr bases)
>                                  (cons (unless (zerop r) r) result))))))
>        (decompose value ,bases '()))))
>
> (define-base-decomposer time-interval-to-components *time-bases*)
>
> (defun format-decomposed-value (decomposed-values bases)
>   (substitute #\. #\,
>    (format nil "~:{~:[~*~;~:*~A ~A~2:*~P~*, ~]~}"
>            (mapcar (function list)
>                    (reverse decomposed-values)
>                    (reverse bases)))
>    :from-end t :count 1))
>
> (format-decomposed-value (time-interval-to-components (remaining-safak))
>                         *time-bases-names*)
> --> "1 month, 5 days, 11 hours, 43 minutes, 9 seconds. "
>
> (define-base-decomposer decode-mayan-date '(60 60 24 20 18 20 20))
> (format-decomposed-value (decode-mayan-date (get-universal-time))
>                          '("second""minute""hour""K'in""Winal""Tun""K'atun""B'ak'tun"))
> --> "5 K'atuns, 10 Tuns, 3 Winals, 9 K'ins, 10 hours, 26 minutes, 8 seconds. "
> (since 19000101T000000)
>
> --
> __Pascal Bourguignon__

I'm always learning from your snippets.

i thought discarding nil values before hand may make format control-
string easier to read,

(defun format-decomposed-value2 (decomposed-values bases)
  (let* ((result-pairs (mapcar (function list)
                               (reverse decomposed-values)
                               (reverse bases)))
         (useful-pairs (remove-if #'null result-pairs :key #'car)))
    (format nil "~{~{~A ~A~2:*~P~*~}~^, ~}."  useful-pairs)))


(format-decomposed-value2 (time-interval-to-components (remaining-
safak))
                          *time-bases-names*)

;; => "1 month, 3 days, 2 hours, 41 minutes, 13 seconds."

and if we wanted 'and' as the last separator, then

(defun format-decomposed-value3 (decomposed-values bases)
  (let* ((result-pairs (mapcar (function list)
                               (reverse decomposed-values)
                               (reverse bases)))
         (useful-pairs (remove-if #'null result-pairs :key #'car)))
    (format nil "~{~{~A ~A~2:*~P~*~}~#[.~; and ~:;, ~]~}"  useful-
pairs)))

(format-decomposed-value3 (time-interval-to-components (remaining-
safak))
                          *time-bases-names*)

;; => "1 month, 3 days, 2 hours, 40 minutes and 47 seconds."

by the way version 3, could be used to implement version2 (hint remove
second clause!)

now the control string:
1- do not deal with nil values.
2- output proper commas and final dot, without extra space at the end.

but i have one question: removing the last ~* after ~p gives an error
of not having enough arguments (almost 2 hours panging my head against
the wall to understand what was going on). why is that? if I'm
correct, what is remaining is the string (month, year, minute, hour
etc...), does this mean we have to discard the remaining values if
nothing left to do?
i tried to wrap my head by assuming that if there is remaining items
the inner ~{ ... ~}, as a whole will be re-used beginning with first
~A.

regards.

cmo,

PS: i want to apologize to Pascal, since i sent initial version of
this reply by mistake directly to him, when i wanted
my response to be under his reply, not under the main root.
From: William James
Subject: Re: Sir, yes Sir!: How many days left to freedom (exercises in CL, 	FORMAT inspired by Haskell)
Date: 
Message-ID: <ba0e5508-74a8-4988-b7e8-3e5efd99cab1@25g2000hsx.googlegroups.com>
On Aug 11, 6:21 am, ····@informatimago.com (Pascal J. Bourguignon)
wrote:
> Emre Sevinc <···········@gmail.com> writes:
> > (defconstant +seconds-a-minute+ 60)
> > (defconstant +seconds-a-hour+ (* 60 +seconds-a-minute+))
> > (defconstant +seconds-a-day+ (* 24 +seconds-a-hour+))
> > (defconstant +seconds-a-month+ (* 30 +seconds-a-day+))
> > (defconstant +seconds-a-year+ (* 12 +seconds-a-month+))
>
> Introduce more abstraction: instead processing them one by one,
> generalize and abstract it aways with a unique vector.
>
> > (defun time-interval-to-components (time-interval)
> >   (multiple-value-bind (years r) (truncate time-interval +seconds-a-
> > year+)
> >     (multiple-value-bind (months r) (truncate r +seconds-a-month+)
> >       (multiple-value-bind (days r) (truncate r +seconds-a-day+)
> >    (multiple-value-bind (hours r) (truncate r +seconds-a-hour+)
> >      (multiple-value-bind (minutes seconds) (truncate r +seconds-a-minute
> > +)
> >        (if (= years 0)   (setf years nil))
> >        (if (= months 0)  (setf months nil))
> >        (if (= days 0) (setf days nil))
> >        (if (= hours 0) (setf hours nil))
> >        (if (= minutes 0) (setf minutes nil))
> >        (if (= seconds 0) (setf seconds nil))
> >        (list years months days hours minutes seconds)))))))
>
> Generalize!  It'll be shorter.
>
> > (defun print-time-interval (interval-list)
> > "Prints the string representing the time interval given as a list."
> >   (format nil ····@[·@(~r~) ~:*~[years~;year,~:;years,~]~]·@[·@(~r~)
> > ~:*~[months~;month~:;months,~]~] ·@[~r ~:*~[days,~;day,~:;days~]~]
> > ·@[~r ~:*~[hours~;hour~:;hours~]~] ·@[~r
> > ~:*~[minutes~;minute~:;minutes~]~] ·@[~r
> > ~:*~[seconds~;second~:;seconds~]~]~}." interval-list))
>
> Study CLHS.  There's ~P for English.
>
> > (defun remaining-safak ()
> > "Return how many days left."
> >   (- (encode-universal-time 0 0 0 16 9 2008)
> >      (get-universal-time)))
>
> > CL-USER> (print-time-interval (time-interval-to-components (remaining-
> > safak)))
> > "One month five days twelve hours four minutes three seconds."
>
> > Not bad I guess and I like the twisted soul of FORMAT's control string
> > (CLHS and PCL to the rescue), but I wonder if it could be done in shorter
> > and more clear way.
>
> Yes.
>
> > Haskell System.Time lib seems to have useful date
> > calculation and conversion functions so I tried
> > to develop some of it in Lisp. I'm still not happy with the current
> > format because it doesn't handle all the cases correctly (e.g. what happens
> > to the fullstop if there are zero seconds, thus a SPACE is printed before it).
>
> > Comments and criticisms are welcome, and I'll reply by saying: Sir,
> > yes Sir! ;-)
>
> (defun remaining-safak ()
>   "Return how many days left."
>   (- (encode-universal-time 0 0 0 16 9 2008)
>      (get-universal-time)))
>
> (defparameter *time-bases*       '(60       60        24    30     12))
> (defparameter *time-bases-names* '("second" "minute" "hour" "day" "month" "year"))
>
> (defmacro define-base-decomposer (name bases)
>   "Note: BASES is evaluated."
>   `(defun ,name (value)
>      (labels ((decompose (value bases result)
>                 (if (null bases)
>                     (reverse (cons (unless (zerop value) value) result))
>                     (multiple-value-bind (q r) (truncate value (car bases))
>                       (decompose q (cdr bases)
>                                  (cons (unless (zerop r) r) result))))))
>        (decompose value ,bases '()))))
>
> (define-base-decomposer time-interval-to-components *time-bases*)
>
> (defun format-decomposed-value (decomposed-values bases)
>   (substitute #\. #\,
>    (format nil "~:{~:[~*~;~:*~A ~A~2:*~P~*, ~]~}"
>            (mapcar (function list)
>                    (reverse decomposed-values)
>                    (reverse bases)))
>    :from-end t :count 1))
>
> (format-decomposed-value (time-interval-to-components (remaining-safak))
>                         *time-bases-names*)
> --> "1 month, 5 days, 11 hours, 43 minutes, 9 seconds. "

Wow!  COBOL-LISP is extremely verbose.  That's very
good when you're paid by the line.

def format_time_span time_span
  unit_seconds = 60, 60, 24, 30, 12
  unit_names = 'second minute hour day month year'.split
  4.times{|i| unit_seconds[i+1] *= unit_seconds[i] }

  units = [] ; time_span = time_span.to_i
  unit_seconds.reverse_each{|u|
    units << time_span / u
    time_span = time_span % u }
  units << time_span

  units.zip( unit_names.reverse ).reject{|n,name| 0==n }.
    map{|n,name| "#{ n } #{ name }#{ 's' if n>1 }" }.
    join( ", " ) + "."
end

p format_time_span( Time::mktime(2008,10,17,20,25,8) - Time.now )

--> "1 month, 1 day, 57 minutes, 12 seconds."