Download
(eval-when-compile (require 'cl))
(unless (and (intern-soft "*IS-MON-OBARRAY*")
(bound-and-true-p *IS-MON-OBARRAY*))
(setq *IS-MON-OBARRAY* (make-vector 17 nil)))
(declare-function mon-nshuffle-vector "mon-macs" (mixup-vector))
(defun mon-next-almost-prime (w-integer)
"From W-INTEGER return either a prime or a number nearer the next prime.\n
Return a value I where (>= I w-integer) and (>= W-INTEGER 0).\n
Useful for generating a reasonable arg for `make-hash-table's :size keyword.\n
:EXAMPLE\n\n\(let* \(\(prms-lt-100 '\(2 3 5 7 11 13 17 19 23 29 31 37 41
43 47 53 59 61 67 71 73 79 83 89 97\)\)
\(n->100 \(number-sequence 1 99 1\)\)
next-almost\)
\(mapc #'\(lambda \(nx-ap\)
\(let \(\(non-prime \(unless \(memq nx-ap prms-lt-100\)
nx-ap\)\)\)
\(when non-prime
\(push `\(,nx-ap . ,\(mon-next-almost-prime non-prime\)\)
next-almost\)\)\)\)
n->100\)
\(setq next-almost \(nreverse next-almost\)\)\)\n
\(let \(\(n->100 \(number-sequence 100 300 1\)\)
next-almost\)
\(mapc #'\(lambda \(nx-ap\)
\(push `\(,nx-ap . ,\(mon-next-almost-prime nx-ap\)\)
next-almost\)\)
n->100\)
\(setq next-almost \(nreverse next-almost\)\)\)\n
:NOTE The original C definition:\n
,----
| int
| next_almost_prime (int n)
| {
| if (n % 2 == 0)
| n += 1;
| if (n % 3 == 0)
| n += 2;
| if (n % 7 == 0)
| n += 4;
| return n;
| }
`----\n
:ALIASED-BY `mon-get-next-almost-prime'
:ALIASED-BY `next-almost-prime'\n
:SEE-ALSO `mon-gensym-counter-randomizer', `mon-make-random-state',
`mon-generate-prand-seed', `mon-generate-WPA-key', `mon-generate-prand-id',
`mon-string-wonkify', `random', `math-primes-table'.\n►►►"
(let ((mnapN w-integer))
(when (= (% mnapN 2) 0) (setq mnapN (1+ mnapN)))
(when (= (% mnapN 3) 0) (setq mnapN (+ mnapN 2)))
(when (= (% mnapN 7) 0) (setq mnapN (+ mnapN 4)))
mnapN))
(defun mon-gensym-counter-randomizer (randomize-sym/str)
"Generate a semi-randomized integer from RANDOMIZE-SYM/STR.\n
Helper function for `mon-with-gensyms'.\n
:EXAMPLE\n\n\(mon-gensym-counter-randomizer-TEST \"bubba\" 10000\)\n
\(mon-gensym-counter-randomizer-TEST 'bu 10000\)\n
:NOTE On average this function will return ~45-60 duplicates per 10,000
invocations per seed symbol. IOW one might create an average of ~9948 unique
`bubba's if we batched inside a procedure capable of accounting for collisions.\n
:SEE-ALSO `mon-gensym', `mon-gensym-counter-randomizer-TEST'.\n►►►"
(let ((mgcr-pr1
[37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131
137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227
229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317
331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431
433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541])
(mgcr-pr2 (make-vector 6 0))
(mgcr-pr3 (make-vector 6 0))
(mgcr-merp [3 5 7 13 17 19])
(mgcr-rtn randomize-sym/str))
(dolist (mgcr-shfv '(mgcr-pr2 mgcr-pr3))
(mon-nshuffle-vector mgcr-pr1)
(dotimes (mgcr-mkv 5)
(aset (symbol-value mgcr-shfv) mgcr-mkv (aref mgcr-pr1 mgcr-mkv))))
(let* ((mgcr-rndmz-sym/str (or (and (stringp mgcr-rtn) mgcr-rtn)
(format "%s" mgcr-rtn)))
(mgcr-rndmz-len (length mgcr-rndmz-sym/str))
(mgcr-rndmz-trunc-len (- mgcr-rndmz-len 6))
(mgcr-subv1 (if (or (zerop mgcr-rndmz-trunc-len) (natnump mgcr-rndmz-trunc-len))
(random 87)
(+ 88 mgcr-rndmz-trunc-len)))
(mgcr-subv2 (if (or (zerop mgcr-rndmz-trunc-len) (natnump mgcr-rndmz-trunc-len))
(1+ mgcr-subv1)
(- mgcr-subv1 mgcr-rndmz-trunc-len))))
(aset mgcr-pr2 5 mgcr-rndmz-len)
(aset mgcr-pr3 5 (string-bytes mgcr-rndmz-sym/str))
(setq mgcr-pr1
(vconcat
(substring
(concat
(substring (concat (mon-nshuffle-vector mgcr-pr1) "") mgcr-subv1 mgcr-subv2)
(if (zerop mgcr-rndmz-trunc-len)
(substring mgcr-rndmz-sym/str 0 5)
mgcr-rndmz-sym/str))
-6))))
(mon-nshuffle-vector mgcr-pr1)
(setq mgcr-rtn
(mapcar #'(lambda (mgcr-stl-char)
(mon-nshuffle-vector mgcr-pr2)
(mon-nshuffle-vector mgcr-pr3)
(mon-nshuffle-vector mgcr-merp)
(let (mgcr-gthr)
(dotimes (i 5
(setq mgcr-gthr (lsh (apply '+ mgcr-gthr)
(- (aref mgcr-merp 0) (aref mgcr-merp 1)))))
(push (* (aref mgcr-pr2 i) (aref mgcr-pr3 i) mgcr-stl-char) mgcr-gthr))))
mgcr-pr1))
(setq mgcr-rtn (apply '+ mgcr-rtn))
(setq mgcr-rtn (abs (ash mgcr-rtn (- (aref mgcr-merp 2) (aref mgcr-merp 3)))))
(if (or (null mgcr-rtn)
(< mgcr-rtn 10000)
(= mgcr-rtn 0))
(mon-gensym-counter-randomizer randomize-sym/str)
mgcr-rtn)))
(defun mon-mix-fields (mmf-x mmf-y)
"
:EXAMPLE\n\n\(mon-mix-fields 37 41\)\n
:SEE-ALSO `mon-make-random-state', `mon-gensym-counter-randomizer'.\n►►►"
(let ((mmf-xy (+ (* mmf-x 3) mmf-y)))
(logand most-positive-fixnum
(logxor 441516657
(ash (- mmf-xy (* mmf-y 13) 8738747) 9)
(ash (+ mmf-xy (* mmf-x 23) 7882763) -9)
(ash mmf-xy -5)))))
(defun mon-make-random-state ()
"Return an integer with some randomness.\n
:EXAMPLE\n\n\(mon-make-random-state\)\n
:SEE-ALSO `mon-next-almost-prime', `mon-gensym-counter-randomizer', `mon-make-random-state',
`mon-generate-prand-seed', `mon-generate-WPA-key', `mon-generate-prand-id',
`mon-string-wonkify', `random'.\n►►►"
(let ((mmrst8
(lsh (+ cons-cells-consed
floats-consed
vector-cells-consed
symbols-consed
string-chars-consed
misc-objects-consed
intervals-consed
strings-consed
pure-bytes-used
num-nonmacro-input-events
(floor (* gcs-done (sqrt gcs-done)) 1)
(floor gc-elapsed 1))
(aref (mon-nshuffle-vector [17 13 5 19 11 7 3 23]) 0))))
(logxor
(if (not (zerop mmrst8)) mmrst8 (mon-make-random-state))
(random))))
(defun mon-generate-prand-id (&optional cnt)
"Return a pseudo-rand UID.\n
Return value is a 40 char hex string generated as sha1 sum from seed
`mon-generate-prand-seed'. When > CNT 1 return N UID's.\n
:EXAMPLE\n\n\(mon-generate-prand-id 6\)\n
Only the first sum has random qualities and subsequent sha1 sums are taken from
sum calculated in previous iteration.\n
Thus, if CNT is 4 then the sha1 of sum1 -> sum2 -> sum3 -> sum4.\n
This means:\n
a) the return value of all elts after car are _not_ random at all;\n
b) where UID assignment occurs in parallel with time-stamping we can infer
when the UID was generated relative the index of previous/subsequent elts.
Item b is a Featured-Bug®.\n
:SEE-ALSO `mon-string-to-hex-string', `mon-generate-WPA-key', `mon-string-wonkify',
`url-hexify-string', `url-unhex-string', `url-unhex'.\n►►►"
(eval-when-compile (require 'sha1))
(let ((mgpi-cnt (if cnt cnt 1))
mgpi-gthr)
(do* ((mgpi-i 1 (1+ mgpi-i))
(mgpi-j (sha1 (mon-generate-prand-seed)) (sha1 (car mgpi-gthr)))
(mgpi-k (push mgpi-j mgpi-gthr) (push mgpi-j mgpi-gthr)))
((>= mgpi-i mgpi-cnt) mgpi-k))
(nreverse mgpi-gthr)))
(defun mon-generate-prand-seed ()
"Generate a seed for 'unique random identifier' a 32 character hex string.
Seed is only pseudo random/unique but it will suffice for our needs.
Don't call this function in a loop it won't work b/c TIME is slow as hell.
Instead, use as a seed for `mon-generate-prand-id'.
On MON system min. 0.85 seconds is needed between calls to produce unique id's.\n
:EXAMPLE\n(mon-generate-prand-id)\n
\(let \(\(i 11\) \(k\)\)
\(while \(/= i 0\)
\(sleep-for 0.85\)
\(setq k \(cons `\(,\(mon-generate-prand-id\)\) k\)\)
\(setq i \(1- i\)\)\)
\(prin1 k\)\)\n
:SEE-ALSO `mon-generate-WPA-key', `mon-string-wonkify', `mon-list-nshuffle',
`mon-nshuffle-vector', `url-cache-create-filename-using-md5'.\n►►►"
(let* ((mgrs-pseudo-r #'(lambda ()
(mon-string-to-sequence
(number-to-string (abs (random t))))))
(mgrs-seq->v #'(lambda (mgrs-L-1) (apply 'vector mgrs-L-1)))
(mgrs-shufv #'(lambda (mgrs-L-2)
(mon-nshuffle-vector mgrs-L-2))))
(md5
(mon-string-from-sequence
(funcall mgrs-shufv
(funcall mgrs-seq->v
(mon-string-to-sequence
(md5
(mon-string-from-sequence
(funcall mgrs-shufv
(vconcat
(funcall mgrs-seq->v
(mon-string-to-sequence
(md5
(mon-string-from-sequence
(funcall mgrs-shufv
(funcall mgrs-seq->v
(nreverse
(funcall mgrs-pseudo-r))))))))
(funcall mgrs-shufv
(funcall mgrs-seq->v
(funcall mgrs-pseudo-r))))))))))))))
(defun mon-string-wonkify (wonk-words wonkify-n-times)
"Wonkify the string WONK-WORDS.\n
:EXAMPLE\n\n\(mon-string-wonkify \"These are some wonky words\" 10\)\n
\(mon-string-wonkify \"These are some wonky words\" 3\)\n
:ALIASED-BY `mon-generate-wonky'\n
:SEE-ALSO `mon-zippify-region', `mon-generate-prand-seed', `mon-generate-prand-id',
`mon-generate-WPA-key', `mon-nshuffle-vector', `mon-list-nshuffle'\n►►►"
(let* ((mswnky-wrds wonk-words)
(wonk-USR #'(lambda (wnkusr-L-1 wnkusr-L-2)
(let (wnkusr-lt-0)
(dolist (wnkusr-D-1 wnkusr-L-1)
(let ((wnkusr-lt-1 wnkusr-D-1))
(dotimes (wnkusr-D-2 (random (length wnkusr-lt-1)))
(let ((wnkusr-lt-2 (random (length wnkusr-lt-1))))
(setf (nth wnkusr-lt-2 wnkusr-lt-1)
(if wnkusr-L-2
(upcase (nth wnkusr-lt-2 wnkusr-lt-1))
(downcase (nth wnkusr-lt-2 wnkusr-lt-1))))))
(push (apply 'string wnkusr-lt-1) wnkusr-lt-0)))
(setq mswnky-wrds wnkusr-lt-0))))
(mswnky-seqify #'(lambda (sqfy-L-1)
(let (sqfy-lt-1)
(mapc #'(lambda (sqfy-L-2)
(push (string-to-list sqfy-L-2) sqfy-lt-1))
(cond ((listp sqfy-L-1) sqfy-L-1)
((stringp sqfy-L-1) (list sqfy-L-1))))
sqfy-lt-1)))
(mswnky-GCD #'(lambda (&rest lcgc-L-1)
(let ((lcgc-lt-1 (abs (or (pop lcgc-L-1) 0))))
(while lcgc-L-1
(let ((lcgc-lt-2 (abs (pop lcgc-L-1))))
(while (> lcgc-lt-2 0)
(setq lcgc-lt-2
(% lcgc-lt-1
(setq lcgc-lt-1 lcgc-lt-2))))))
lcgc-lt-1))))
(setq mswnky-wrds (make-list wonkify-n-times (car (funcall mswnky-seqify mswnky-wrds))))
(do ((mswnky-D-1 wonkify-n-times))
((< mswnky-D-1 0) mswnky-wrds)
(setq mswnky-D-1 (1- mswnky-D-1))
(setq mswnky-wrds (apply 'vector mswnky-wrds))
(setq mswnky-wrds (mon-nshuffle-vector mswnky-wrds))
(setq mswnky-wrds (append mswnky-wrds nil))
(when (stringp (car mswnky-wrds))
(setq mswnky-wrds (funcall mswnky-seqify mswnky-wrds)))
(funcall wonk-USR mswnky-wrds
(if (eq (apply mswnky-GCD `(,mswnky-D-1 2)) 2) t)))))
(defun mon-generate-WPA-key (&optional insrtp intrp)
"Return a 64 char pseudo-random hex-string.\n
When INSRTP is non-nil or called-interactively insert string at point.
Does not move point.\n
:EXAMPLE\n\n\(mon-generate-WPA-key\)\n
:SEE-ALSO `mon-generate-prand-id', `mon-generate-prand-seed',
`mon-string-wonkify', `mon-string-from-hex-list', `mon-string-to-hex-list',
`mon-string-to-hex-string', `mon-make-random-state'.\n►►►"
(interactive "i\np")
(let ((mgWk-hex-str (mon-string-to-hex-string :prand-hex-len 64)))
(if (or insrtp intrp)
(save-excursion (princ (format " \"%s\" " mgWk-hex-str) (current-buffer)))
mgWk-hex-str)))
(provide 'mon-randomize-utils)