bug#71572: [PATCH] seconds-to-string-approximate

[JD Smith <jdtsmith@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 5121 bytes --]



> On Jul 6, 2024, at 5:09 PM, Paul Eggert <eggert@cs.ucla.edu> wrote:
> 
> On 7/6/24 21:29, JD Smith wrote:
>> do we universally avoid unicode in core files?
> 
> Not in comments, but even today it's wise to be cautious about generating user-visible Unicode characters like "½" when there's a simple ASCII substitute like ".5". Plus, why stop with ½? Why not also do ¼ and ¾?
> 
> It might be better to have an optional precision argument, defaulting to 0, specifying the number of digits of precision after the decimal point. Or something like that.

Thanks for the feedback.  Attached find an updated patch:

- HALF is dropped.
- PRECISION can now be specified as a whole-number of digits or a float <1.0 (e.g. 0.5)
- NEWS and doc entries.

Users who want ½ can always use precision=0.5 and edit the string after the fact.

Another attached file includes commands to produce and display a simple benchmark, as well as the example output (below).  

I see about a 10x performance difference between the standard seconds-to-string and the "bells and whistles" readable version.  It's still <35µs per delay for me, so formatting thousands of strings at once should be no problem.  Happy to take performance improvement ideas.

Current example:

     Delay (s)        s2s       s2s-r  s2s-ra  s2s-ra1  s2s-rah                  s2s-e   s2s-ea    s2s-ea1      s2s-ea3    s2s-eah
         0.000         0s   0 seconds      0s       0s       0s              0 seconds       0s         0s           0s         0s
         0.450   450.00ms   0 seconds      0s     0.4s     0.5s              0 seconds       0s       0.4s       0.450s       0.5s
         1.035      1.03s    1 second      1s       1s       1s               1 second       1s         1s       1.035s         1s
         2.380      2.38s   2 seconds      2s     2.4s     2.5s              2 seconds       2s       2.4s       2.380s       2.5s
         5.475      5.48s   5 seconds      5s     5.5s     5.5s              5 seconds       5s       5.5s       5.475s       5.5s
        12.593     12.59s  13 seconds     13s    12.6s    12.5s             13 seconds      13s      12.6s      12.593s      12.5s
        28.964     28.96s  29 seconds     29s      29s      29s             29 seconds      29s        29s      28.964s        29s
        66.616     66.62s    1 minute      1m     1.1m       1m     1 minute 7 seconds    1m 7s    1m 6.6s    1m 6.616s    1m 6.5s
       153.217      2.55m   3 minutes      3m     2.6m     2.5m   2 minutes 33 seconds   2m 33s   2m 33.2s   2m 33.217s     2m 33s
       352.399      5.87m   6 minutes      6m     5.9m       6m   5 minutes 52 seconds   5m 52s   5m 52.4s   5m 52.399s   5m 52.5s
       810.519     13.51m  14 minutes     14m    13.5m    13.5m  13 minutes 31 seconds  13m 31s  13m 30.5s  13m 30.519s  13m 30.5s
      1864.193     31.07m  31 minutes     31m    31.1m      31m   31 minutes 4 seconds   31m 4s   31m 4.2s   31m 4.193s     31m 4s
      4287.644     71.46m      1 hour      1h     1.2h       1h      1 hour 11 minutes   1h 11m   1h 11.5m   1h 11.461m   1h 11.5m
      9861.581      2.74h     3 hours      3h     2.7h     2.5h     2 hours 44 minutes   2h 44m   2h 44.4m   2h 44.360m   2h 44.5m
     22681.636      6.30h     6 hours      6h     6.3h     6.5h     6 hours 18 minutes   6h 18m     6h 18m   6h 18.027m     6h 18m
     52167.763     14.49h    14 hours     14h    14.5h    14.5h    14 hours 29 minutes  14h 29m  14h 29.5m  14h 29.463m  14h 29.5m
    119985.856      1.39d       1 day      1d     1.4d     1.5d          1 day 9 hours    1d 9h    1d 9.3h    1d 9.329h    1d 9.5h
    275967.469      3.19d      3 days      3d     3.2d       3d         3 days 5 hours    3d 5h    3d 4.7h    3d 4.658h    3d 4.5h
    634725.178      7.35d      1 week      1w       1w       1w                 1 week       1w    1w 0.3d    1w 0.346d    1w 0.5d
   1459867.909     16.90d     2 weeks      2w     2.4w     2.5w         2 weeks 3 days    2w 3d    2w 2.9d    2w 2.897d      2w 3d
   3357696.192     38.86d     1 month      1M     1.3M     1.5M         1 month 1 week    1M 1w    1M 1.2w    1M 1.204w      1M 1w
   7722701.241     89.38d    3 months      3M     2.9M       3M       2 months 4 weeks    2M 4w    2M 4.1w    2M 4.073w      2M 4w
  17762212.854    205.58d    7 months      7M     6.8M       7M       6 months 3 weeks    6M 3w    6M 3.3w    6M 3.280w    6M 3.5w
  40853089.565      1.29y      1 year      1Y     1.3Y     1.5Y        1 year 4 months    1Y 4M    1Y 3.5M    1Y 3.535M    1Y 3.5M
  93962105.999      2.98y     3 years      3Y       3Y       3Y      2 years 12 months   2Y 12M   2Y 11.7M   2Y 11.730M   2Y 11.5M
 216112843.798      6.85y     7 years      7Y     6.8Y       7Y      6 years 10 months   6Y 10M   6Y 10.2M   6Y 10.180M     6Y 10M
 497059540.736     15.75y    16 years     16Y    15.8Y      16Y      15 years 9 months   15Y 9M     15Y 9M   15Y 9.014M     15Y 9M
1143236943.694     36.23y    36 years     36Y    36.2Y      36Y      36 years 3 months   36Y 3M   36Y 2.7M   36Y 2.733M   36Y 2.5M





[-- Attachment #2.1: Type: text/html, Size: 10907 bytes --]

[-- Attachment #2.2: s2s_test.el --]
[-- Type: application/octet-stream, Size: 1794 bytes --]

(require 'cl-lib)

(defun s2s/example ()
  (interactive)
  (with-temp-buffer-window "s2s/example" nil nil
    (princ
     (concat
      (format "%14s %10s  %10s  %6s  %7s  %7s  %21s  %7s  %9s  %11s  %9s\n"
	      "Delay (s)" "s2s" "s2s-r" "s2s-ra" "s2s-ra1" "s2s-rah" "s2s-e" "s2s-ea" "s2s-ea1"
	      "s2s-ea3" "s2s-eah")
      (cl-loop for s = 0.0 then (if (zerop s) 0.45 (* s 2.3))
	       while (< s (* 365.25 24 3600 40))
	       concat (format "%14.3f %10s  %10s  %6s  %7s  %7s  %21s  %7s  %9s  %11s  %9s\n" s
			      (seconds-to-string s)
			      (seconds-to-string s 'readable)
			      (seconds-to-string s 'readable 'abbrev)
			      (seconds-to-string s 'readable 'abbrev 1)
			      (seconds-to-string s 'readable 'abbrev 0.5)
			      (seconds-to-string s 'expanded)
			      (seconds-to-string s 'expanded 'abbrev)
			      (seconds-to-string s 'expanded 'abbrev 1)
			      (seconds-to-string s 'expanded 'abbrev 3)
			      (seconds-to-string s 'expanded 'abbrev 0.5)))))))

(defun s2s/benchmark ()
  (interactive)
  (let* ((ndelays 100000)
	 (delays (cl-loop for i from 1 to ndelays
			  with max = (* 365.25 24 3600 40)
			  collect (cl-random max)))
	 (bsmpl (benchmark-run nil
		  (cl-loop for d in delays
			   do (seconds-to-string d))))
	 (brdbl (benchmark-run nil
		  (cl-loop for d in delays
			   do (seconds-to-string d t t 0.1)))))
    (with-temp-buffer-window "s2s/benchmarks" nil nil
      (princ "seconds-to-string benchmarks\n")
      (princ (format "  default timing: %0.2fµs\n\t%S\n"
		     (/ (car bsmpl) ndelays 1e-6) bsmpl))
      (princ (format " readable timing: %0.2fµs\n\t%S\n\n"
		     (/ (car brdbl) ndelays 1e-6) brdbl))
      (princ (format "readable/default: %0.2f\n" (/ (car brdbl) (car bsmpl)))))))

[-- Attachment #2.3: Type: text/html, Size: 289 bytes --]

[-- Attachment #2.4: 0001-seconds-to-string-new-optional-arguments-for-readabl.patch --]
[-- Type: application/octet-stream, Size: 5345 bytes --]

From 4767735197fba78672e076737a033921637db1a2 Mon Sep 17 00:00:00 2001
From: JD Smith <93749+jdtsmith@users.noreply.github.com>
Date: Thu, 11 Jul 2024 16:24:17 -0400
Subject: [PATCH] seconds-to-string: new optional arguments for readable
 strings

---
 doc/lispref/os.texi        |  6 +++
 etc/NEWS                   |  7 ++++
 lisp/calendar/time-date.el | 75 ++++++++++++++++++++++++++++++++++++--
 3 files changed, 84 insertions(+), 4 deletions(-)

diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 3ba3da459bf..1e26c83de6a 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2155,6 +2155,12 @@ Time Calculations
 structure.  For instance, the 120th day in 2004 is April 29th.
 @end defun
 
+@defun seconds-to-string delay &optional readable abbrev precision
+Return a string describing a given @var{delay} (in seconds).  Optional
+arguments can be used to configure a human readable delay using various
+formats.  For example, a delay of 9861.5 seconds with @var{readable} set
+to the symbol @code{expanded} returns "2 hours 44 minutes".
+
 @node Timers
 @section Timers for Delayed Execution
 @cindex timers
diff --git a/etc/NEWS b/etc/NEWS
index f10f9ae4d65..38ab21288a3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -30,6 +30,13 @@ applies, and please also update docstrings as needed.
 \f
 * Changes in Emacs 31.1
 
+** Time & Date
+
++++
+*** 'seconds-to-string' includes new arguments to produce human-readable
+delay strings in a variety of formats, for example "6 months 3 weeks" or
+"5m 52.5s".
+
 \f
 * Editing Changes in Emacs 31.1
 
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index eca80f1e8b6..f80aa2f980d 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -409,11 +409,78 @@ seconds-to-string
         (list (* 3600 24 400) "d" (* 3600.0 24.0))
         (list nil "y" (* 365.25 24 3600)))
   "Formatting used by the function `seconds-to-string'.")
+
+(defvar seconds-to-string-readable
+  `(("Y" "year"   "years"   ,(round (* 60 60 24 365.2425)))
+    ("M" "month"  "months"  ,(round (* 60 60 24 30.436875)))
+    ("w" "week"   "weeks"   ,(* 60 60 24 7))
+    ("d" "day"    "days"    ,(* 60 60 24))
+    ("h" "hour"   "hours"   ,(* 60 60))
+    ("m" "minute" "minutes" 60)
+    ("s" "second" "seconds" 1))
+  "Formatting used by the function `seconds-to-string' with READABLE set.")
+
 ;;;###autoload
-(defun seconds-to-string (delay)
-  ;; FIXME: There's a similar (tho fancier) function in mastodon.el!
-  "Convert the time interval in seconds to a short string."
-  (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay))))
+(defun seconds-to-string (delay &optional readable abbrev precision)
+  "Convert time interval DELAY (in seconds) to a short string.
+By default, the returned string has two decimal precision in the
+smallest unit that is larger than DELAY from the variable
+`seconds-to-string'.  If READABLE is non-nil, convert DELAY into
+a readable string, using the information in the variable
+`seconds-to-string-readable'.  If it is the symbol `expanded',
+use two units to describe DELAY, if appropriate.  E.g. \"1 hour
+32 minutes\".  If ABBREV is non-nil, abbreviate the readable
+units.  If PRECISION is a whole number, round the value
+associated with the smallest displayed unit to that many digits
+after the decimal.  If it a non-negative float less than 1.0,
+round to that value."
+  (cond ((< delay 0)
+	 (concat "-" (seconds-to-string (- delay) readable precision)))
+        (readable
+         (let* ((stsa seconds-to-string-readable)
+		(expanded (eq readable 'expanded))
+		digits
+		(round-to (cond ((wholenump precision)
+				 (setq digits precision)
+				 (expt 10 (- precision)))
+				((and (floatp precision) (< precision 1.))
+				 (setq digits (- (floor (log precision 10))))
+				 precision)
+				(t (setq digits 0) 1)))
+		(dformat (if (> digits 0) (format "%%0.%df" digits)))
+		(padding (if abbrev "" " "))
+		here cnt cnt-pre here-pre cnt-val)
+	   (if (= (round delay round-to) 0)
+	       (format "0%s" (if abbrev "s" " seconds"))
+	     (while (and (setq here (pop stsa)) stsa
+			 (< (/ delay (nth 3 here)) 1)))
+	     (or (and
+		  expanded stsa 	; smaller unit remains
+		  (progn
+		    (setq
+		     here-pre here here (car stsa)
+		     cnt-pre (floor (/ (float delay) (nth 3 here-pre)))
+		     cnt (round
+			  (/ (- (float delay) (* cnt-pre (nth 3 here-pre)))
+			     (nth 3 here))
+			  round-to))
+		    (if (> cnt 0) t (setq cnt cnt-pre here here-pre here-pre nil))))
+		 (setq cnt (round (/ (float delay) (nth 3 here)) round-to)))
+	     (setq cnt-val (* cnt round-to))
+	     (cl-labels
+		 ((unit (val here)
+		    (cond (abbrev (car here))
+			  ((<= (floor val) 1) (nth 1 here))
+			  (t (nth 2 here)))))
+	       (concat
+		(when here-pre
+		  (concat (number-to-string cnt-pre) padding
+			  (unit (* cnt-pre round-to) here-pre) " "))
+		(if (and (> digits 0)
+			 (> (- cnt-val (floor cnt-val)) 0.))
+		    (format dformat cnt-val)
+		  (number-to-string (floor cnt-val)))
+		padding (unit cnt-val here))))))
         ((= 0 delay) "0s")
         (t (let ((sts seconds-to-string) here)
              (while (and (car (setq here (pop sts)))
-- 
2.43.0


[-- Attachment #2.5: Type: text/html, Size: 457 bytes --]