Re: Is there something wrong with random function?

Hello Pascal,

That is nice to see, beautiful.

I have just modified it little so that I can get 6
digits, as I actually just need a string of
digits to construct web slugs with strings and
avoid having same slugs.

(defun random-number (&key (digits 6))
  "Returns the random number with 6 digits by default"
  (setf *random-state* (make-random-state))
  (let ((fstr (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)))
    (with-output-to-string (s fstr)
      (dotimes (ti digits fstr)
        (format s "~A" (random 10))))))

Jean

On Thu, Nov 16, 2017 at 02:45:22PM +0100, Pascal Bourguignon wrote:
> 
> 
> > On 16 Nov 2017, at 14:16, <[email protected]> <[email protected]> wrote:
> > 
> > Jean Louis wrote:
> > 
> > (defun random-number (&key (digits 6))
> >  "Returns the random number with 6 digits by default"
> >  (setf *random-state* (make-random-state))
> >  (let ((fstr (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)))
> >    (with-output-to-string (s fstr)
> >      (dotimes (ti digits)
> >        (princ (character (write-to-string (random 10))) s)))
> >    (read-from-string fstr)))
> > 
> > Don already found the bug, but nobody commented about style.
> > This function is overly convoluted. Think again about what you want to achieve.
> > What you're doing above is
> > Number -> print -> string -> character -> print -> collecting-stream -> adjustable-string -> number
> > Ouch. Just go straight to your goal.
> 
> 
> 
> (defun random-number (&key (digits 6))
>   "Returns the random number with 6 digits by default"
>   (random (expt 10 6)))
> 
> However, this is wrong!  For example:
> 
> (setf *print-base* 3)
> (random-number)
> ;; --> 102222200011  ;; NOT 6 digits!!!
> 
> Instead, let's add a base parameter (and take *print-base* by default):
> 
> (defun random-number (&key (digits 6) (base *print-base*))
>   "Returns the random number with 6 digits by default"
>   (random (expt base 6)))
> 
> (random-number)
> ;; --> 112101
> 
> (loop repeat 10 collect (random-number))
> ;; --> (879023 606819 686060 963306 143047 550980 621150 144785 90563 830616)
> 
> 
> (defun replength (n &key (base *print-base*))
>   (ceiling (log n base)))
> 
> (defun subrep (num start end &key (base *print-base*))
>   "Digits are indexed from least significant."
>   (check-type num integer)
>   (check-type start (integer 0))
>   (check-type end (integer 0))
>   (check-type base (integer 2))
>   (if (< start end)
>       (rem (truncate num (expt base start))
>            (expt base (- end start)))
>       0))
> 
> (loop for start below 10
>       collect (subrep 123456789 start (+ start 3)))
> ;; --> (789 678 567 456 345 234 123 12 1 0)
> 
> (loop for start below 10
>       collect (subrep -123456789 start (+ start 3)))
> ;; --> (-789 -678 -567 -456 -345 -234 -123 -12 -1 0)
> 
> 
> (defun sign (n)
>   (check-type n real)
>   (cond ((minusp n) -1)
>         ((plusp  n) +1)
>         (t           0)))
> 
> (defun concatrep (a b &key (base *print-base*) length2)
>   (check-type a integer)
>   (check-type b integer)
>   (check-type base (integer 2))
>   (check-type length2 (or null (integer 0)))
>   (let* ((length2 (or length2 (replength b)))
>          (factor  (expt base length2)))
>     (* (sign a)
>        (+ (* (abs a) factor)
>           (mod (abs b) factor)))))
> 
> (concatrep -123 456)
> ;; --> -123456
> (concatrep -123 12 :length2 3)
> ;; --> -123012
> (concatrep 123 -3 :length2 3)
> ;; --> 123003
> 
> (let ((*print-base* 5))
>   (prin1-to-string (subrep (concatrep #5r1234 #5r4321) 2 6)))
> ;; --> "3443"
> 
> 
> 
> 
> -- 
> __Pascal J. Bourguignon__
> Try the IBM Flex font: IBM has freed itself from the tyranny of Helvetica https://qz.com/1124664/ibm-plex-with-its-first-ever-custom-corporate-font-ibm-is-freeing-itself-from-the-tyranny-of-helvetica/
> 

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
clisp-list mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/clisp-list