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.lux399
1 files changed, 0 insertions, 399 deletions
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
deleted file mode 100644
index 8c95c63fa..000000000
--- a/stdlib/source/lux/math/random.lux
+++ /dev/null
@@ -1,399 +0,0 @@
-(.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."}
- [lux (#- or and list i64 nat int rev char)
- [abstract
- [hash (#+ Hash)]
- [functor (#+ Functor)]
- [apply (#+ Apply)]
- ["." monad (#+ Monad do)]]
- [data
- ["." text (#+ Char) ("#\." monoid)
- ["." unicode #_
- ["#" set]]]
- [collection
- ["." list ("#\." fold)]
- ["." array (#+ Array)]
- ["." dictionary (#+ Dictionary)]
- ["." queue (#+ Queue)]
- ["." set (#+ Set)]
- ["." stack (#+ Stack)]
- ["." row (#+ Row)]
- [tree
- ["." finger (#+ Tree)]]]]
- [math
- [number (#+ hex)
- ["n" nat]
- ["i" int]
- ["f" frac]
- ["r" ratio]
- ["c" complex]
- ["." i64]]]
- ["." time (#+ Time)
- ["." instant (#+ Instant)]
- ["." date (#+ Date)]
- ["." duration (#+ Duration)]
- ["." month (#+ Month)]
- ["." day (#+ Day)]]
- [type
- [refinement (#+ Refiner Refined)]]])
-
-(type: #export #rec PRNG
- {#.doc "An abstract way to represent any PRNG."}
- (-> Any [PRNG I64]))
-
-(type: #export (Random a)
- {#.doc "A producer of random values based on a PRNG."}
- (-> PRNG [PRNG a]))
-
-(implementation: #export functor
- (Functor Random)
-
- (def: (map f fa)
- (function (_ state)
- (let [[state' a] (fa state)]
- [state' (f a)]))))
-
-(implementation: #export apply
- (Apply Random)
-
- (def: &functor ..functor)
-
- (def: (apply ff fa)
- (function (_ state)
- (let [[state' f] (ff state)
- [state'' a] (fa state')]
- [state'' (f a)]))))
-
-(implementation: #export monad
- (Monad Random)
-
- (def: &functor ..functor)
-
- (def: (wrap a)
- (function (_ state)
- [state a]))
-
- (def: (join ffa)
- (function (_ state)
- (let [[state' fa] (ffa state)]
- (fa state')))))
-
-(def: #export (filter pred gen)
- {#.doc "Retries the generator until the output satisfies a predicate."}
- (All [a] (-> (-> a Bit) (Random a) (Random a)))
- (do ..monad
- [sample gen]
- (if (pred sample)
- (wrap sample)
- (filter pred gen))))
-
-(def: #export (one check random)
- (All [a b]
- (-> (-> a (Maybe b)) (Random a) (Random b)))
- (do ..monad
- [sample random]
- (case (check sample)
- (#.Some output)
- (wrap output)
-
- #.None
- (one check random))))
-
-(def: #export (refine refiner gen)
- {#.doc "Retries the generator until the output can be refined."}
- (All [t r] (-> (Refiner t r) (Random t) (Random (Refined t r))))
- (do ..monad
- [sample gen]
- (case (refiner sample)
- (#.Some refined)
- (wrap refined)
-
- #.None
- (refine refiner gen))))
-
-(def: #export bit
- (Random Bit)
- (function (_ prng)
- (let [[prng output] (prng [])]
- [prng (|> output (i64.and 1) (n.= 1))])))
-
-(def: #export i64
- (Random I64)
- (function (_ prng)
- (let [[prng left] (prng [])
- [prng right] (prng [])]
- [prng (|> left
- (i64.left_shift 32)
- ("lux i64 +" right))])))
-
-(template [<name> <type> <cast>]
- [(def: #export <name>
- (Random <type>)
- (\ ..monad map <cast> ..i64))]
-
- [nat Nat .nat]
- [int Int .int]
- [rev Rev .rev]
- )
-
-(def: #export frac
- (Random Frac)
- (\ ..monad map (|>> .i64 f.from_bits) ..nat))
-
-(def: #export safe_frac
- (Random Frac)
- (let [mantissa_range (.int (i64.left_shift 53 1))
- mantissa_max (i.frac (dec mantissa_range))]
- (\ ..monad map
- (|>> (i.% mantissa_range)
- i.frac
- (f./ mantissa_max))
- ..int)))
-
-(def: #export (char set)
- (-> unicode.Set (Random Char))
- (let [[start end] (unicode.range set)
- size (n.- start end)
- in_range (: (-> Char Char)
- (|>> (n.% size) (n.+ start)))]
- (|> ..nat
- (\ ..monad map in_range)
- (..filter (unicode.member? set)))))
-
-(def: #export (text char_gen size)
- (-> (Random Char) Nat (Random Text))
- (if (n.= 0 size)
- (\ ..monad wrap "")
- (do ..monad
- [x char_gen
- xs (text char_gen (dec size))]
- (wrap (text\compose (text.from_code x) xs)))))
-
-(template [<name> <set>]
- [(def: #export <name>
- (-> Nat (Random Text))
- (..text (..char <set>)))]
-
- [unicode unicode.character]
- [ascii unicode.ascii]
- [ascii/alpha unicode.ascii/alpha]
- [ascii/alpha_num unicode.ascii/alpha_num]
- [ascii/numeric unicode.ascii/numeric]
- [ascii/upper unicode.ascii/upper]
- [ascii/lower unicode.ascii/lower]
- )
-
-(template [<name> <type> <ctor> <gen>]
- [(def: #export <name>
- (Random <type>)
- (do ..monad
- [left <gen>
- right <gen>]
- (wrap (<ctor> left right))))]
-
- [ratio r.Ratio r.ratio ..nat]
- [complex c.Complex c.complex ..safe_frac]
- )
-
-(def: #export (and left right)
- {#.doc "Sequencing combinator."}
- (All [a b] (-> (Random a) (Random b) (Random [a b])))
- (do ..monad
- [=left left
- =right right]
- (wrap [=left =right])))
-
-(def: #export (or left right)
- {#.doc "Heterogeneous alternative combinator."}
- (All [a b] (-> (Random a) (Random b) (Random (| a b))))
- (do {! ..monad}
- [? bit]
- (if ?
- (do !
- [=left left]
- (wrap (0 #0 =left)))
- (do !
- [=right right]
- (wrap (0 #1 =right))))))
-
-(def: #export (either left right)
- {#.doc "Homogeneous alternative combinator."}
- (All [a] (-> (Random a) (Random a) (Random a)))
- (do ..monad
- [? bit]
- (if ?
- left
- right)))
-
-(def: #export (rec gen)
- {#.doc "A combinator for producing recursive random generators."}
- (All [a] (-> (-> (Random a) (Random a)) (Random a)))
- (function (_ state)
- (let [gen' (gen (rec gen))]
- (gen' state))))
-
-(def: #export (maybe value_gen)
- (All [a] (-> (Random a) (Random (Maybe a))))
- (do {! ..monad}
- [some? bit]
- (if some?
- (do !
- [value value_gen]
- (wrap (#.Some value)))
- (wrap #.None))))
-
-(template [<name> <type> <zero> <plus>]
- [(def: #export (<name> size value_gen)
- (All [a] (-> Nat (Random a) (Random (<type> a))))
- (if (n.> 0 size)
- (do ..monad
- [x value_gen
- xs (<name> (dec size) value_gen)]
- (wrap (<plus> x xs)))
- (\ ..monad wrap <zero>)))]
-
- [list List (.list) #.Cons]
- [row Row row.empty row.add]
- )
-
-(template [<name> <type> <ctor>]
- [(def: #export (<name> size value_gen)
- (All [a] (-> Nat (Random a) (Random (<type> a))))
- (do ..monad
- [values (list size value_gen)]
- (wrap (|> values <ctor>))))]
-
- [array Array array.from_list]
- [queue Queue queue.from_list]
- [stack Stack (list\fold stack.push stack.empty)]
- )
-
-(def: #export (set Hash<a> size value_gen)
- (All [a] (-> (Hash a) Nat (Random a) (Random (Set a))))
- (if (n.> 0 size)
- (do {! ..monad}
- [xs (set Hash<a> (dec size) value_gen)]
- (loop [_ []]
- (do !
- [x value_gen
- #let [xs+ (set.add x xs)]]
- (if (n.= size (set.size xs+))
- (wrap xs+)
- (recur [])))))
- (\ ..monad wrap (set.new Hash<a>))))
-
-(def: #export (dictionary Hash<a> size key_gen value_gen)
- (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v))))
- (if (n.> 0 size)
- (do {! ..monad}
- [kv (dictionary Hash<a> (dec size) key_gen value_gen)]
- (loop [_ []]
- (do !
- [k key_gen
- v value_gen
- #let [kv+ (dictionary.put k v kv)]]
- (if (n.= size (dictionary.size kv+))
- (wrap kv+)
- (recur [])))))
- (\ ..monad wrap (dictionary.new Hash<a>))))
-
-(def: #export instant
- (Random Instant)
- (\ ..monad map instant.from_millis ..int))
-
-(def: #export date
- (Random Date)
- (\ ..monad map instant.date ..instant))
-
-(def: #export time
- (Random Time)
- (\ ..monad map instant.time ..instant))
-
-(def: #export duration
- (Random Duration)
- (\ ..monad map duration.from_millis ..int))
-
-(def: #export month
- (Random Month)
- (let [(^open "\.") ..monad]
- (..either (..either (..either (\wrap #month.January)
- (..either (\wrap #month.February)
- (\wrap #month.March)))
- (..either (\wrap #month.April)
- (..either (\wrap #month.May)
- (\wrap #month.June))))
- (..either (..either (\wrap #month.July)
- (..either (\wrap #month.August)
- (\wrap #month.September)))
- (..either (\wrap #month.October)
- (..either (\wrap #month.November)
- (\wrap #month.December)))))))
-
-(def: #export day
- (Random Day)
- (let [(^open "\.") ..monad]
- (..either (..either (\wrap #day.Sunday)
- (..either (\wrap #day.Monday)
- (\wrap #day.Tuesday)))
- (..either (..either (\wrap #day.Wednesday)
- (\wrap #day.Thursday))
- (..either (\wrap #day.Friday)
- (\wrap #day.Saturday))))))
-
-(def: #export (run prng calc)
- (All [a] (-> PRNG (Random a) [PRNG a]))
- (calc prng))
-
-(def: #export (prng update return)
- (All [a] (-> (-> a a) (-> a I64) (-> a PRNG)))
- (function (recur state)
- (function (_ _)
- [(recur (update state))
- (return state)])))
-
-(def: #export (pcg32 [increase seed])
- {#.doc (doc "An implementation of the PCG32 algorithm."
- "For more information, please see: http://www.pcg-random.org/")}
- (-> [(I64 Any) (I64 Any)] PRNG)
- (let [magic 6364136223846793005]
- (function (_ _)
- [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg32)
- (let [rot (|> seed .i64 (i64.right_shift 59))]
- (|> seed
- (i64.right_shift 18)
- (i64.xor seed)
- (i64.right_shift 27)
- (i64.rotate_right rot)
- .i64))])))
-
-(def: #export (xoroshiro_128+ [s0 s1])
- {#.doc (doc "An implementation of the Xoroshiro128+ algorithm."
- "For more information, please see: http://xoroshiro.di.unimi.it/")}
- (-> [(I64 Any) (I64 Any)] PRNG)
- (function (_ _)
- [(let [s01 (i64.xor s0 s1)]
- (xoroshiro_128+ [(|> s0
- (i64.rotate_left 55)
- (i64.xor s01)
- (i64.xor (i64.left_shift 14 s01)))
- (i64.rotate_left 36 s01)]))
- ("lux i64 +" s0 s1)]))
-
-## https://en.wikipedia.org/wiki/Xorshift#Initialization
-## http://xorshift.di.unimi.it/splitmix64.c
-(def: #export split_mix_64
- {#.doc (doc "An implementation of the SplitMix64 algorithm.")}
- (-> Nat PRNG)
- (let [twist (: (-> Nat Nat Nat)
- (function (_ shift value)
- (i64.xor (i64.right_shift shift value)
- value)))
- mix n.*]
- (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15"))
- (|>> (twist 30)
- (mix (hex "BF,58,47,6D,1C,E4,E5,B9"))
-
- (twist 27)
- (mix (hex "94,D0,49,BB,13,31,11,EB"))
-
- (twist 31)
- .i64))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 22:15:19 +0000