... and the winner is ...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
import System.Random
import Data.List
import Control.Monad
import Data.Time.Clock

{-- 

A set of solutions to today's 1HaskellADay problem 
at http://lpaste.net/107104 about lotto 

--}

{-- NAIVE SOLUTION --}

-- takeout grabs an element from a list and returns it and the rest of the
-- list

takeout :: Eq a => [a] -> [(a, [a])]
takeout [] = []
takeout list@(_:_) = [ (elt, rest) | elt <- list, let rest = delete elt list ]

-- takeout is very 'State-y'

data Peano = Z | S Peano
   deriving (Eq, Show)

fromInt :: Integer -> Peano
fromInt n | n <= 0 = Z
          | otherwise = S $ fromInt $ pred n

toInt :: Peano -> Int
toInt Z = 0
toInt (S n) = succ $ toInt n

instance Num Peano where
   fromInteger = fromInt
   abs p = p
   signum Z = Z
   signum (S _) = S Z
   p + Z = p
   Z + p = p
   (S n) + (S m) = S (S (n + m))
   Z * _ = Z
   _ * Z = Z
   (S n) * (S m) = sum (replicate (toInt $ S n) (S m))


{--
  toInteger Z = 0
  toInteger (S n) = succ $ toInteger n
 --}

-- choose chooses choosily n elements of list giving all combinations of same

choose :: (Ord a, Num a) => Integer -> [a] -> [[a]]
choose _ [] = []
choose n list@(_:_) = [a | a <- c' (fromInt n) 0 [] list]
   where c' Z _ accum _ = return accum
         c' (S n) min accum seed = takeout seed >>= \(a, s) ->
              guard (a > min) >> c' n a (a : accum) s

-- not properly choose, as it allows duplicates, see, for example
-- choose 3 [1..3] ~> [[3,2,1],[2,3,1],[3,1,2],[1,3,2],[2,1,3],[1,2,3]]
-- but ... eh.

-- On second thought, eventually added 'guard (a > min)' to enforce ordering.
-- This cut out the redundances, and even then lotto 6 49 is taking forever!
-- lotto 6 35 took a 47.4s on my laptop and choose 6 x time increases
-- exponentially with succ x

-- So, with choose, lotto becomes trivial:

lotto :: Integer -> Integer -> IO [Integer]

-- in Idris: lotto : (sz : Fin n) -> Nat -> IO (Vect sz Int), but so it goes

lotto n max = let picks = choose n [1..max]
                  sz    = pred $ length picks
              in  getStdRandom (randomR (0, sz)) >>=
                  return . reverse . ((!!) picks)

{--
  some stats:

getCurrentTime >>= \t1 -> putStrLn (show (length $ choose 6 [1..35])) >> getCurrentTime >>= return . diffUTCTime t1
1623160
-24.033821s

getCurrentTime >>= \t1 -> putStrLn (show (length $ choose 6 [1..36])) >> getCurrentTime >>= return . diffUTCTime t1
1947792
-29.20856s

 --}

{-- The first improvement --}

{--

length list 

requires the entire list be computed to calculate its length, so we
can pick one of its elements. This is all rather a waste if the random
number picked is near the beginning of the list!

But the thing is, we know the length of the list, a priori. n C len is
a computable function, so, for this case, we'll simply compute the length
of the list and defer the computation of the list's elements to just the
selected member.

 --}

lenChoose :: Integer -> Integer -> Integer
lenChoose n k = fac n `div` (fac k * (fac (n-k)))
   where fac x = product [1..x]

{-- 

TODO: implement complete mapping

lenChoose 10 6 = 210
lenChoose 35 6 = 1623160
lenChoose 36 6 = 1947792

TO-DONE

 --}

lotto' :: Integer -> Integer -> IO [Integer]
lotto' k n = let picks = choose n [1..n]
                 sz    = pred $ lenChoose n k
             in  getStdRandom (randomR (0, sz)) >>=
                 return . reverse . ((!!) picks) . fromInteger

timePicks :: Num a => (a -> a -> IO [a]) -> a -> a -> IO NominalDiffTime
timePicks fn n k =
   getCurrentTime >>= \tStart -> fn n k >>=
   putStrLn . show >> getCurrentTime >>= return . flip diffUTCTime tStart

{--

some more stats:

getCurrentTime >>= \t1 -> lotto' 6 35 >>= putStrLn . show >> getCurrentTime >>= return . diffUTCTime t1
[1,4,9,16,22,27]
-0.897794s

EEP!

But still:

getCurrentTime >>= \t1 -> lotto' 6 35 >>= putStrLn . show >> getCurrentTime >>= return . diffUTCTime t1
[2,5,16,23,30,31]
-4.255863s

... still, verses the above these are pretty good times.

 --}

{-- Another Improvement --}

{--

Another improvement is that we know, a priori, what each sequence of the
choice list is, even before we generate it, or the previous one, or the
previous one, etc. It's all algorithmic, and that algorithm has actually
been reduced to a computable function for ache elemsne of the list in
constant time!

So, instead of computing x of the sequences, where x is the random number
we generate, we need only generate one sequence: the xth one.

--}

-- TODO: put my definition where my mouth is... was ... whatever.

{-- Simple and fast solution --}

{--

So, for those of us not so mathematically-inclined, there is another, obvious,
improvement, and that is: simply generate n disjoint 'random' numbers from the
domain d 1..k. ... So, let's do that.

--}

lotto'' :: Int -> Int -> IO [Int]
lotto'' n k = l' (fromInt $ toInteger n) 1 (k-n) []
   where l' Z _ _ ans = return $ reverse ans
         l' (S n) min max accum =
            getStdRandom (randomR (min, max)) >>= \val ->
            l' n (succ val) (succ max) (val : accum)

{--

Okay, check this out:

timePicks lotto'' 6 49
[28,29,34,46,46,48]
0.001729s

Good enough, eh?

The ... 'problem' with the above definition is that is 'right'-leaning,
that is, that if it picks high early, it stays in the high range.

--}
57:23: Warning: Redundant list comprehension
Found:
[a | a <- c' (fromInt n) 0 [] list]
Why not:
c' (fromInt n) 0 [] list
79:19: Warning: Use liftM
Found:
getStdRandom (randomR (0, sz)) >>= return . reverse . ((!!) picks)
Why not:
liftM (reverse . ((!!) picks)) (getStdRandom (randomR (0, sz)))
80:28: Warning: Redundant bracket
Found:
reverse . ((!!) picks)
Why not:
reverse . (!!) picks
80:38: Warning: Use section
Found:
((!!) picks)
Why not:
(picks !!)
113:30: Warning: Redundant bracket
Found:
fac k * (fac (n - k))
Why not:
fac k * fac (n - k)
131:18: Warning: Use liftM
Found:
getStdRandom (randomR (0, sz)) >>=
return . reverse . ((!!) picks) . fromInteger
Why not:
liftM (reverse . ((!!) picks) . fromInteger)
(getStdRandom (randomR (0, sz)))
132:37: Warning: Use section
Found:
((!!) picks)
Why not:
(picks !!)
132:37: Warning: Redundant bracket
Found:
((!!) picks) . fromInteger
Why not:
(!!) picks . fromInteger
136:34: Warning: Use liftM
Found:
fn n k >>= putStrLn . show >> getCurrentTime >>=
return . flip diffUTCTime tStart
Why not:
liftM (flip diffUTCTime tStart)
(fn n k >>= putStrLn . show >> getCurrentTime)
137:4: Error: Use print
Found:
putStrLn . show
Why not:
print