aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/math/random.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/math/random.lux')
-rw-r--r--stdlib/source/lux/math/random.lux104
1 files changed, 50 insertions, 54 deletions
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 90ee2c97b..e8b552b1c 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -69,7 +69,7 @@
(function [prng]
(let [[prng left] (prng [])
[prng right] (prng [])]
- [prng (n.+ (bit;shift-left +32 left)
+ [prng (n/+ (bit;shift-left +32 left)
right)])))
(def: #export int
@@ -77,20 +77,20 @@
(function [prng]
(let [[prng left] (prng [])
[prng right] (prng [])]
- [prng (nat-to-int (n.+ (bit;shift-left +32 left)
+ [prng (nat-to-int (n/+ (bit;shift-left +32 left)
right))])))
(def: #export bool
(Random Bool)
(function [prng]
(let [[prng output] (prng [])]
- [prng (|> output (bit;and +1) (n.= +1))])))
+ [prng (|> output (bit;and +1) (n/= +1))])))
(def: (bits n)
(-> Nat (Random Nat))
(function [prng]
(let [[prng output] (prng [])]
- [prng (bit;shift-right (n.- n +64) output)])))
+ [prng (bit;shift-right (n/- n +64) output)])))
(def: #export frac
(Random Frac)
@@ -98,10 +98,10 @@
[left (bits +26)
right (bits +27)]
(wrap (|> right
- (n.+ (bit;shift-left +27 left))
+ (n/+ (bit;shift-left +27 left))
nat-to-int
int-to-frac
- (f./ (|> +1 (bit;shift-left +53) nat-to-int int-to-frac))))))
+ (f// (|> +1 (bit;shift-left +53) nat-to-int int-to-frac))))))
(def: #export deg
(Random Deg)
@@ -109,11 +109,11 @@
(def: #export (text' char-gen size)
(-> (Random Nat) Nat (Random Text))
- (if (n.= +0 size)
+ (if (n/= +0 size)
(:: Monad<Random> wrap "")
(do Monad<Random>
[x char-gen
- xs (text' char-gen (n.dec size))]
+ xs (text' char-gen (n/dec size))]
(wrap (text/compose (text;from-code x) xs)))))
(type: Char-Range [Nat Nat])
@@ -135,61 +135,61 @@
(def: (within? [from to] char)
(-> Char-Range Nat Bool)
- (and (n.>= from char) (n.<= to char)))
+ (and (n/>= from char) (n/<= to char)))
-(def: unicode-ceiling (n.inc (product;right CJK-Compatibility-Ideographs-Supplement)))
+(def: unicode-ceiling (n/inc (product;right CJK-Compatibility-Ideographs-Supplement)))
(def: #export unicode
(Random Nat)
(|> ;;nat
- (:: Monad<Random> map (n.% unicode-ceiling))
+ (:: Monad<Random> map (n/% unicode-ceiling))
(;;filter (function [raw]
## From "Basic Latin" to "Syriac"
- (or (n.<= (hex "+074F") raw)
+ (or (n/<= (hex "+074F") raw)
(within? Thaana raw)
## From "Devanagari" to "Ethiopic"
- (and (n.>= (hex "+0900") raw)
- (n.<= (hex "+137F") raw))
+ (and (n/>= (hex "+0900") raw)
+ (n/<= (hex "+137F") raw))
## From "Cherokee" to "Mongolian"
- (and (n.>= (hex "+13A0") raw)
- (n.<= (hex "+18AF") raw))
+ (and (n/>= (hex "+13A0") raw)
+ (n/<= (hex "+18AF") raw))
## From "Limbu" to "Tai Le"
- (and (n.>= (hex "+1900") raw)
- (n.<= (hex "+197F") raw))
+ (and (n/>= (hex "+1900") raw)
+ (n/<= (hex "+197F") raw))
(within? Khmer-Symbols raw)
(within? Phonetic-Extensions raw)
## From "Latin Extended Additional" to "Miscellaneous Symbols and Arrows"
- (and (n.>= (hex "+1E00") raw)
- (n.<= (hex "+2BFF") raw))
+ (and (n/>= (hex "+1E00") raw)
+ (n/<= (hex "+2BFF") raw))
## From "CJK Radicals Supplement" to "Kangxi Radicals"
- (and (n.>= (hex "+2E80") raw)
- (n.<= (hex "+2FDF") raw))
+ (and (n/>= (hex "+2E80") raw)
+ (n/<= (hex "+2FDF") raw))
## From "Ideographic Description Characters" to "Bopomofo Extended"
- (and (n.>= (hex "+2FF0") raw)
- (n.<= (hex "+31BF") raw))
+ (and (n/>= (hex "+2FF0") raw)
+ (n/<= (hex "+31BF") raw))
## From "Katakana Phonetic Extensions" to "CJK Unified Ideographs"
- (and (n.>= (hex "+31F0") raw)
- (n.<= (hex "+9FAF") raw))
+ (and (n/>= (hex "+31F0") raw)
+ (n/<= (hex "+9FAF") raw))
## From "Yi Syllables" to "Yi Radicals"
- (and (n.>= (hex "+A000") raw)
- (n.<= (hex "+A4CF") raw))
+ (and (n/>= (hex "+A000") raw)
+ (n/<= (hex "+A4CF") raw))
(within? Hangul-Syllables raw)
## From "CJK Compatibility Ideographs" to "Arabic Presentation Forms-A"
- (and (n.>= (hex "+F900") raw)
- (n.<= (hex "+FDFF") raw))
+ (and (n/>= (hex "+F900") raw)
+ (n/<= (hex "+FDFF") raw))
## From "Combining Half Marks" to "Halfwidth and Fullwidth Forms"
- (and (n.>= (hex "+FE20") raw)
- (n.<= (hex "+FFEF") raw))
+ (and (n/>= (hex "+FE20") raw)
+ (n/<= (hex "+FFEF") raw))
## From "Linear B Syllabary" to "Aegean Numbers"
- (and (n.>= (hex "+10000") raw)
- (n.<= (hex "+1013F") raw))
+ (and (n/>= (hex "+10000") raw)
+ (n/<= (hex "+1013F") raw))
## From "Old Italic" to "Osmanya"
- (and (n.>= (hex "+10300") raw)
- (n.<= (hex "+104AF") raw))
+ (and (n/>= (hex "+10300") raw)
+ (n/<= (hex "+104AF") raw))
(within? Cypriot-Syllabary raw)
## From "Byzantine Musical Symbols" to "Musical Symbols"
- (and (n.>= (hex "+1D000") raw)
- (n.<= (hex "+1D1FF") raw))
+ (and (n/>= (hex "+1D000") raw)
+ (n/<= (hex "+1D1FF") raw))
(within? Tai-Xuan-Jing-Symbols raw)
(within? Mathematical-Alphanumeric-Symbols raw)
(within? CJK-Unified-Ideographs-Extension-B raw)
@@ -262,10 +262,10 @@
(do-template [<name> <type> <zero> <plus>]
[(def: #export (<name> size value-gen)
(All [a] (-> Nat (Random a) (Random (<type> a))))
- (if (n.> +0 size)
+ (if (n/> +0 size)
(do Monad<Random>
[x value-gen
- xs (<name> (n.dec size) value-gen)]
+ xs (<name> (n/dec size) value-gen)]
(wrap (<plus> x xs)))
(:: Monad<Random> wrap <zero>)))]
@@ -287,29 +287,29 @@
(def: #export (set Hash<a> size value-gen)
(All [a] (-> (Hash a) Nat (Random a) (Random (Set a))))
- (if (n.> +0 size)
+ (if (n/> +0 size)
(do Monad<Random>
- [xs (set Hash<a> (n.dec size) value-gen)]
+ [xs (set Hash<a> (n/dec size) value-gen)]
(loop [_ []]
(do @
[x value-gen
#let [xs+ (set;add x xs)]]
- (if (n.= size (set;size xs+))
+ (if (n/= size (set;size xs+))
(wrap xs+)
(recur [])))))
(:: Monad<Random> wrap (set;new Hash<a>))))
(def: #export (dict Hash<a> size key-gen value-gen)
(All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dict k v))))
- (if (n.> +0 size)
+ (if (n/> +0 size)
(do Monad<Random>
- [kv (dict Hash<a> (n.dec size) key-gen value-gen)]
+ [kv (dict Hash<a> (n/dec size) key-gen value-gen)]
(loop [_ []]
(do @
[k key-gen
v value-gen
#let [kv+ (dict;put k v kv)]]
- (if (n.= size (dict;size kv+))
+ (if (n/= size (dict;size kv+))
(wrap kv+)
(recur [])))))
(:: Monad<Random> wrap (dict;new Hash<a>))))
@@ -318,9 +318,6 @@
(All [a] (-> PRNG (Random a) [PRNG a]))
(calc prng))
-## PCG32 http://www.pcg-random.org/
-## Based on this Java implementation: https://github.com/alexeyr/pcg-java
-
(def: pcg-32-magic-mult Nat +6364136223846793005)
(def: #export (pcg-32 [inc seed])
@@ -329,20 +326,19 @@
For more information, please see: http://www.pcg-random.org/"}
(-> [Nat Nat] PRNG)
(function [_]
- (let [seed' (|> seed (n.* pcg-32-magic-mult) (n.+ inc))
+ (let [seed' (|> seed (n/* pcg-32-magic-mult) (n/+ inc))
xor-shifted (|> seed (bit;shift-right +18) (bit;xor seed) (bit;shift-right +27))
rot (|> seed (bit;shift-right +59))]
[(pcg-32 [inc seed']) (bit;rotate-right rot xor-shifted)]
)))
-## Xoroshiro128+ http://xoroshiro.di.unimi.it/
(def: #export (xoroshiro-128+ [s0 s1])
{#;doc "An implementation of the Xoroshiro128+ algorithm.
For more information, please see: http://xoroshiro.di.unimi.it/"}
(-> [Nat Nat] PRNG)
(function [_]
- (let [result (n.+ s0 s1)
+ (let [result (n/+ s0 s1)
s01 (bit;xor s0 s1)
s0' (|> (bit;rotate-left +55 s0)
(bit;xor s01)
@@ -365,9 +361,9 @@
(function [idx vec]
(do Monad<Random>
[rand nat]
- (wrap (swap idx (n.% _size rand) vec))))
+ (wrap (swap idx (n/% _size rand) vec))))
sequence
- (list;n.range +0 (n.dec _size)))]
+ (list;n/range +0 (n/dec _size)))]
(|> _shuffle
(run (pcg-32 [+123 seed]))
product;right)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-17 23:46:34 +0000