List operations

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
module Control.List where

import Control.Monad

import Data.List

import System.Random

import Data.Peano                       -- http://lpaste.net/107204

-- A set of operations not included in the standard library of Data.List

-- constructs a list of length n ... I find I need this all the time.

peanoList :: Int -> [Peano]
peanoList = p . fromInteger . toInteger
   where p Z = []
         p q@(S n) = q : p n

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

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

-- takeout is very 'State-y'

-- permute

permute :: Eq a => [a] -> [[a]]
permute [] = [[]]
{--

Explanation for permute [] = [[]] (n.b.: NOT permute [] = []) is at
http://stackoverflow.com/questions/6627721/recursive-permutation-function-always-returns-empty-list

Side note: the number of permutations for list of length n is n!
 --}

permute list@(_:_) = -- [h:t | (h, rest) <- takeout list, t <- permute rest]
   takeout list >>= \(h, rest) -> map (h :) (permute rest)

-- to compute _A_ permutation in linear time (instead of computing all
-- permutations in O(N*N!) time), we do the following:

perm :: [a] -> IO [a]
perm list@(_:_) = p' list (pred $ length list)
   where p' list 1 = return list
         p' list@(h:t) n = getStdRandom (randomR (0,n)) >>= \idx ->
            let (pre, s, post) = select idx list
            in  p' (wtail pre h ++ post) (pred n) >>= return . (s :)

-- wtail consumes an element, even if it's from the next list

wtail :: [a] -> a -> [a]
wtail [] h = []
wtail (h:t) x = t ++ [x]

-- select separates a list to (pre, selected element, post)
select :: Int -> [a] -> ([a], a, [a])
select 0 (h:t) = ([], h, t)
select n list = let (h:t) = drop n list in (take n list, h, t)

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

choose :: (Enum a, Ord a) => Int -> [a] -> [[a]]
choose _ [] = []
choose n list@(_:_) = c' (fromInt n) (toEnum 0) [] list
   where c' Z _ accum _ = return $ reverse accum
         c' (S n) min accum seed = takeout seed >>= \(a, s) ->
              guard (a > min) >> c' n a (a : accum) s

-- if we wish to know our commitment of nCk we can precompute its length:

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

-- determines that a list of lists have all unique elements
-- (this has come up more than once)

allUniqElems :: Eq a => [[a]] -> Bool
allUniqElems [] = True
allUniqElems ((e:es):lists) = 
   a' e es && a' e (join lists) && allUniqElems lists
      where a' element list = element `notElem` list

-- consList proves list has (at least one) element(s)

consList :: [a] -> Bool
consList (_:_) = True
consList _     = False

-- take the number of rows request, OR, if we cannot, then just give
-- the first row as an answer (the default value).

mbtake :: (Enum n, Num n) => [a] -> n -> Either [a] a
mbtake (h:t) x = takeThis t (pred x) [h] -- good thing order is unimportant!
   where takeThis _     0 ans = Left ans
         takeThis []    x _   = Right h
         takeThis (h:t) x ans = takeThis t (pred x) (h:ans)
51:17: Warning: Use liftM
Found:
p' (wtail pre h ++ post) (pred n) >>= return . (s :)
Why not:
liftM (s :) (p' (wtail pre h ++ post) (pred n))