Failed State

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
import Data.Set (Set)
import qualified Data.Set as Set
import Data.List
import Control.List               -- http://lpaste.net/107211
import Data.Peano                 -- http://lpaste.net/107204
import Control.Monad
import Control.Monad.State.Lazy

-- http://lpaste.net/107411

data Buddy = Alexandra | Beth | Carla | Da5id | Elie
           | Franny | Graeme | Henry | Isaac
   deriving (Eq, Ord, Enum, Show, Read)

buddies :: Set Buddy
buddies = Set.fromList [Alexandra .. Isaac]

-- given takeout from Control.List, bunch takes out an element
-- from buddies for each member of each clique. Easy!

rawbunch :: (Eq a, Ord a, Enum a) => Set a -> [Int] -> [[[a]]] -- [[([a], [a])]]
rawbunch buddies cliques = 
   let lbuds = Set.toList buddies
       pclix = map (fromInt . toInteger) cliques
   in   -- first go: mapM (popClique lbuds alexandra []) pclix
        -- the problem above is that lbuds is reset for each popClique
        -- whereas we need it reduced by each clique for each application
        -- is this a state-transformer, then? We need state inside the list ...
        -- execState (popCliques pclix alexandra []) lbuds
        mapM (popClique alexandra [] lbuds) pclix >>= return . map fst >>=
        \cliques -> guard (uniqueness cliques) >> return cliques
        -- return . fst . partition uniqueness . map fst
      where alexandra = toEnum 0

-- from a base set of buddies, populate a clique, yielding it and
-- the reduced base pool

popClique :: (Eq a, Ord a, Enum a) => a -> [a] -> [a] -> Peano -> [([a], [a])]
popClique _ accum base Z = return (accum, base)
popClique first accum base (S n) =
   takeout base >>= \(bud, rest) ->
   guard (bud >= first) >> popClique bud (bud : accum) rest n

uniqueness :: Eq a => [[a]] -> Bool
uniqueness [] = True
uniqueness (clique : cliques) = u' clique (join cliques) && uniqueness cliques
   where u' [] _ = True
         u' (bud : buddies) cliques = not (elem bud cliques)
                                      && u' buddies cliques

bunch :: (Eq a, Ord a, Enum a) => Set a -> [Int] -> Set (Set (Set a))
bunch buds = sfl . msfl (msfl id) . rawbunch buds
   where sfl = Set.fromList
         msfl f = map (Set.fromList . f)

brady :: [(Set (Set Buddy))] -- geddit? the 'brady bunch'? geddit? ;)
brady = Set.toList $ bunch buddies [2,3,4]

-- length brady ~> 1260 because 9c2 * 7*3 * 4c4 == 1260
-- ... but it takes forEVAH to return because of my eh-algorithm :(

{--

bunch buds cliques = msfl (msfl fst) . rawbunch buds
   where msfl f list = map (sfl . f) list
         sfl = Set.fromList

popCliques :: (Eq a, Ord a, Enum a) => [Peano] -> a -> [[a]] -> State [a] [a]
popCliques [] _ accum = get
popCliques (cliqueSz:clix) first accum = popClique first [] cliqueSz >>=
   \clique -> popCliques clix first (clique:accum)
 --}

{--
popClique :: (Eq a, Ord a, Enum a) => a -> [a] -> Peano -> State [a] [a]
popClique first clique Z = return clique
popClique first accum (S n) = get >>= return . takeout >>= 
-- so, at this point we want to select one of the options from takeout
-- something like [(bud, rest)] ... how to do that? mapM?
   -- mapM (\(bud, rest) ->
   -- guard (bud >= first) >> put rest >> popClique first (bud:accum) n)
-- nope, that screws up the type, so either the type is wrong, or
-- we need to reduce here to (bud, rest) then return the result
   pickOne >>= \(bud, rest) -> putOne (bud, rest) >>
   guard (bud >= first) >> put rest >> popClique first (bud:accum) n

-- Mr. Photographer, make sure you get my best side ...
pickOne :: [(a, [a])] -> State [a] (a, [a])
pickOne choices = return $ head choices -- yeah, yeah, expediency; I know

putOne :: (a, [a]) -> State [a] [a]
putOne (_, rest) = return rest
 --}

{--

Note the original signature of popClique ::

a -> [a] -> Peano -> [a] -> [([a], [a])]

The last two parameters signify a State s -> (a, s) where s is [a] and a is [a]
This is the State transformer, right? because the wrapping monad, itself, is
a list as well!

 --}

{--

So, given those definitions...

length $ bunch buddies [2,3,4] ~> 381024

and bunch of any sets of any size is already defined by bunch

proof that bunch buddies [2,3,4] ~> 381024

length buddies ~> 9

9c2 * 7c3 * 4c4
9c2 ~> 36
7c3 ~> 35
5c5 ~>  1
                ~> 1260

So, that means my original implementation of rawbunch does not extract
the choices from the pool between cliques.

 --}
30:9: Warning: Use liftM
Found:
mapM (popClique alexandra [] lbuds) pclix >>= return . map fst
Why not:
liftM (map fst) (mapM (popClique alexandra [] lbuds) pclix)
48:39: Error: Use notElem
Found:
not (elem bud cliques)
Why not:
notElem bud cliques
48:44: Warning: Use infix
Found:
elem bud cliques
Why not:
bud `elem` cliques
56:10: Warning: Redundant bracket
Found:
[(Set (Set Buddy))]
Why not:
[Set (Set Buddy)]