;
; random.scm - Random utilities
;
(define rand-state-fluid (make-fluid))
(define-public (random-string str-length)
"
random-string -- Returns a random string of length 'str-length'.
This is now thread-safe. I think. Its missing a unit test,
and tends to not actually be random when hit hard from multiple
threads. Ick. This and everything that touches this needs
review/redesign.
"
(define alphanumeric "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
(define alphlen (string-length alphanumeric))
(define str (format #f "~A-" (get-internal-real-time)))
; Attempt to make this thread-safe by giving each thread it's own
; random state.
(if (not (fluid-ref rand-state-fluid))
(fluid-set! rand-state-fluid
(seed->random-state (get-internal-real-time))))
; Build random part by collecting chars into a list
(define rs (fluid-ref rand-state-fluid))
(let loop ((n str-length) (chars '()))
(if (zero? n)
(string-append str (list->string chars))
(loop (- n 1)
(cons (string-ref alphanumeric (random alphlen rs)) chars))))
)
(define-public (random-node-name node-type random-length prefix)
"
random-node-name TYPE LENGTH PREFIX - create a unique node.
Create a random string, consisting of `PREFIX` followed by
a random string of length `LENGTH`. The string is checked, so
that no node of type `TYPE` exists in the atomspace at the time
of this call. Thus, the name is almost unique -- there still is
a tiny window in which a race can occur.
"
(define node-name (random-string random-length))
(define prefix-length (string-length prefix))
(if (> prefix-length 0)
(set! node-name (string-append prefix node-name))
)
(while (cog-node node-type node-name)
(if (> prefix-length 0)
(set! node-name (string-append prefix (random-string random-length)))
(set! node-name (random-string random-length))
)
)
node-name
)
(define-public (uniquely-named-variable)
"
uniquely-named-variable -- Creates a new uniquely-named VariableNode.
"
(Variable (random-node-name 'VariableNode 24 "$"))
)