math: add count-digits

code/math/count-digits.lisp

@@ -0,0 +1,59 @@
+(in-package #:quaviver.math)
+
+(declaim (ftype (function ((integer 2 36) unsigned-byte) (unsigned-byte 22))
+                count-digits)
+         (inline count-digits))
+
+(defvar *count-digits-table*
+  (compute-count-digits +min-base+ +max-base+
+                        (quaviver:arithmetic-size #+quaviver/long-float
+                                                  'long-float
+                                                  #-quaviver/long-float
+                                                  'double-float)))
+
+(defun count-digits (base value)
+  (declare (optimize speed))
+  (cond ((zerop value)
+         1)
+        ((eql base 2)
+         (integer-length value))
+        ((= (logcount base) 1)
+         (values (ceiling (integer-length value)
+                          (1- (integer-length base)))))
+        (t
+         (let* ((value-length (integer-length value))
+                (lower (ceiling-log-expt base 2 (1- value-length)))
+                (upper (ceiling-log-expt base 2 value-length)))
+           (if (or (= lower upper)
+                   (< value
+                      (let ((table (svref *count-digits-table* (- base +min-base+))))
+                        (if (< lower (length table))
+                            (svref table lower)
+                            (cl:expt base lower)))))
+               lower
+               upper)))))
+
+(define-compiler-macro count-digits (&whole whole base value)
+  (cond ((not (constantp base))
+         whole)
+        ((eql base 2)
+         `(integer-length ,value))
+        ((= (logcount base) 1)
+         `(values (ceiling (integer-length ,value)
+                           ,(1- (integer-length base)))))
+        (t
+         `(let ((value ,value))
+            (declare (optimize speed))
+            (if (zerop value)
+                1
+                (let* ((value-length (integer-length value))
+                       (lower (ceiling-log-expt ,base 2 (1- value-length)))
+                       (upper (ceiling-log-expt ,base 2 value-length)))
+                  (if (or (= lower upper)
+                          (< value
+                             (let ((table ,(svref *count-digits-table* (- base +min-base+))))
+                               (if (< lower (length table))
+                                   (svref table lower)
+                                   (cl:expt ,base lower)))))
+                      lower
+                      upper)))))))

code/math/utility.lisp

@@ -47,3 +47,13 @@
         do (setf (getf tables arithmetic-size)
                  (max (getf tables arithmetic-size 0)
                       bound))))
+
+(defun compute-count-digits (min-base max-base width)
+  (make-array (- max-base min-base -1)
+              :initial-contents
+              (loop for base from min-base upto max-base
+                    for max-power = (floor (log (ash 1 (1- width)) base))
+                    collect (make-array (1+ max-power)
+                                        :initial-contents
+                                        (loop for power from 0 upto max-power
+                                              collect (cl:expt base power))))))

code/packages.lisp

@@ -69,7 +69,8 @@
            #:floor-multiply/64-128q128
            #:floor-multiply/evenp/64-128q128
            #:floor-log-expt
-           #:ceiling-log-expt))
+           #:ceiling-log-expt
+           #:count-digits))
 
 #+sbcl
 (pushnew :quaviver.math/smallnum *features*)

quaviver.asd

@@ -27,6 +27,7 @@
                               :serial t
                               :components ((:file "log-expt")
                                            (:file "utility")
+                                           (:file "count-digits")
                                            (:file "implementation")
                                            (:file "expt")
                                            (:file "round-to-odd")))