git.haldean.org ubik / 5b4d39d
less-dumb name for pokemon.uk Haldean Brown 4 years ago
2 changed file(s) with 71 addition(s) and 71 deletion(s). Raw diff Collapse all Expand all
0 ~ ubik-tests/iv-example
1 ` *list
2 ` math
3
4 ^ IV = Good = Bad
5
6 ^ Bag
7 = BagC Number Number
8
9 # accessors for members, to give them names
10 : n ^ Bag -> Number = \x -> ? x { . BagC n * => n }
11 : good ^ Bag -> Number = \x -> ? x { . BagC * good => good }
12
13 # make new bags with a good or a bad value removed
14 : sub-good ^ Bag -> Bag
15 = \x -> BagC (- (n x) 1) (- (good x) 1)
16 : sub-bad ^ Bag -> Bag
17 = \x -> BagC (- (n x) 1) (good x)
18
19 # this should be a tuple...
20 ^ TreePair = TreePairC IV Tree
21 : tree ^ TreePair -> Tree = \tp -> ? tp { . TreePairC * t => t }
22
23 # ...and this should be an alias
24 ^ Tree = TreeC (List TreePair)
25 # accessor for children
26 : children ^ Tree -> List TreePair = \tree -> ? tree { . TreeC l => l }
27
28 # create a tree by choosing k IVs out of bag b
29 : make ^ Number -> Bag -> Tree
30 = \k b -> ? {
31 . eq k 0 => TreeC Nil
32 . => TreeC ({
33 : ivs = map (\num -> ? {
34 . math:lt num (good b) => Good
35 . => Bad
36 }) (range 0 (n b))
37 ! map (\iv -> ? iv {
38 . Good => TreePairC Good (make (- k 1) (sub-good b))
39 . Bad => TreePairC Bad (make (- k 1) (sub-bad b))
40 }) ivs
41 })
42 }
43 ?: make 0 (BagC 1 1) = TreeC Nil
44 ?: make 1 (BagC 1 1) = TreeC (Cons (TreePairC Good (TreeC Nil)) Nil)
45 ?: make 1 (BagC 2 1) = TreeC (Cons (TreePairC Good (TreeC Nil))
46 (Cons (TreePairC Bad (TreeC Nil)) Nil))
47
48 # the probability that you would get i good IVs when drawing from the tree.
49 : prob ^ Tree -> Number -> Number
50 = \tree i -> {
51 : c = children tree
52 : nc = length c
53 ! (? c {
54 . Nil => ? { . eq i 0 => 1 . => 0 }
55 . Cons * * =>
56 reduce + 0 (map
57 (\child -> * (/ 1 nc) (prob (tree child) (? child {
58 . TreePairC * iv => ? iv {
59 . Good => (- i 1)
60 . Bad => i
61 }
62 })))
63 c)
64 })
65 }
66
67 ! {
68 : t = make 2 (BagC 2 1)
69 ! emit (humanize (prob t 1))
70 }
+0
-71
test/prog/pokemon.uk less more
0 ~ ubik-tests/pokemon
1 ` *list
2 ` math
3
4 ^ IV = Good = Bad
5
6 ^ Bag
7 = BagC Number Number
8
9 # accessors for members, to give them names
10 : n ^ Bag -> Number = \x -> ? x { . BagC n * => n }
11 : good ^ Bag -> Number = \x -> ? x { . BagC * good => good }
12
13 # make new bags with a good or a bad value removed
14 : sub-good ^ Bag -> Bag
15 = \x -> BagC (- (n x) 1) (- (good x) 1)
16 : sub-bad ^ Bag -> Bag
17 = \x -> BagC (- (n x) 1) (good x)
18
19 # this should be a tuple...
20 ^ TreePair = TreePairC IV Tree
21 : tree ^ TreePair -> Tree = \tp -> ? tp { . TreePairC * t => t }
22
23 # ...and this should be an alias
24 ^ Tree = TreeC (List TreePair)
25 # accessor for children
26 : children ^ Tree -> List TreePair = \tree -> ? tree { . TreeC l => l }
27
28 # create a tree by choosing k IVs out of bag b
29 : make ^ Number -> Bag -> Tree
30 = \k b -> ? {
31 . eq k 0 => TreeC Nil
32 . => TreeC ({
33 : ivs = map (\num -> ? {
34 . math:lt num (good b) => Good
35 . => Bad
36 }) (range 0 (n b))
37 ! map (\iv -> ? iv {
38 . Good => TreePairC Good (make (- k 1) (sub-good b))
39 . Bad => TreePairC Bad (make (- k 1) (sub-bad b))
40 }) ivs
41 })
42 }
43 ?: make 0 (BagC 1 1) = TreeC Nil
44 ?: make 1 (BagC 1 1) = TreeC (Cons (TreePairC Good (TreeC Nil)) Nil)
45 ?: make 1 (BagC 2 1) = TreeC (Cons (TreePairC Good (TreeC Nil))
46 (Cons (TreePairC Bad (TreeC Nil)) Nil))
47
48 # the probability that you would get i good IVs when drawing from the tree.
49 : prob ^ Tree -> Number -> Number
50 = \tree i -> {
51 : c = children tree
52 : nc = length c
53 ! (? c {
54 . Nil => ? { . eq i 0 => 1 . => 0 }
55 . Cons * * =>
56 reduce + 0 (map
57 (\child -> * (/ 1 nc) (prob (tree child) (? child {
58 . TreePairC * iv => ? iv {
59 . Good => (- i 1)
60 . Bad => i
61 }
62 })))
63 c)
64 })
65 }
66
67 ! {
68 : t = make 2 (BagC 2 1)
69 ! emit (humanize (prob t 1))
70 }