# Permutations with constraints – magic square

Starting from my previous post, I add code to apply constraints as permutations are being generated.

```type Constraints a = [(Int->Bool, [[a]->Bool])]

permute::Constraints a->[a]->[[a]]
permute cs xs = map fst \$ permute' cs (length xs) [([],xs)]

-- The elements of the tuples are partial permutation and unallocated elements
permute'::Constraints a->Int->[([a],[a])] -> [([a],[a])]
permute' _ 0 xs = xs
permute' cs level xs =
permute' cs (level - 1) \$
filter ((constraints cs level).fst) \$
concat \$ map permute'' xs

-- generate the next level of permutation of a single item
permute''::([a],[a])->[([a],[a])]
permute'' (xs,ys) = map (\(y,y')->((y:xs),y')) \$ picks ys

-- generate all the ways to pick one item from a list
picks::[a]->[(a,[a])]
picks xs = map picks' \$ splits xs

picks'::([a],[a]) -> (a,[a])
picks' (xs, ys) = ((head ys),(xs ++ tail ys))

-- generate all the ways to split a list
splits::[a]->[([a],[a])]
splits [] = []
splits (x:xs) = ([],x:xs):[(x:ls,rs) | (ls,rs)<-splits xs]

newtype Predicate a = Predicate {getPredicate::(a->Bool)} -- works as data or newtype

{- Before GHC 8.4, mappend (<>) was declared in Monoid. Semigroup is now a superclass of Monoid and the instances have to be declared separately. -}
instance Semigroup (Predicate a) where
(Predicate f) <> (Predicate g) = Predicate (\x->((f x) && (g x)))

instance Monoid (Predicate a) where
mempty = Predicate (\_->True)

-- combine all the constraints for this level
constraints :: Constraints a -> Int -> ([a]->Bool)
constraints cs level =
getPredicate \$
foldMap Predicate \$
concat \$ map snd \$
filter (\x -> (fst x) level) cs

-- constraints for magic square
-- note that permutations are built in reverse order, so most recently added element is first (x!!0)
-- and levels are built in descending order
msconstraints :: Constraints Int
msconstraints = [
((\x->elem x [7,4,1]),[\x->x!!0 == 15 - x!!1 - x!!2]),  -- rows
((\x->elem x [3,2,1]),[\x->x!!0 == 15 - x!!3 - x!!6]),  -- columns
((== 3),              [\x->x!!0 == 15 - x!!2 - x!!4]),  -- diagonal 1
((== 1),              [\x->x!!0 == 15 - x!!4 - x!!8]),  -- diagonal 2

-- redundant constraints included for efficiency
((== 5),             [(\x->(5 == x!!0))]),
((== 9),             [(\x->(even (x!!0)))]),
((\x->elem x [6,8]), [\x->(odd (x!!0)),
\x->(x!!0 /= 5)])
]

magicsquares = map (chop 3) \$ permute msconstraints [1..9]
-- with redundant constraints    (0.01 secs, 1,175,040 bytes)
-- without redundant constraints (0.08 secs, 16,050,864 bytes)

chop::Int->[a]->[[a]]
chop _ [] = []
chop n xs = (take n xs):(chop n \$ drop n xs)

main :: IO ()
main = mapM_ (putStrLn . show) \$ magicsquares

```

This is still faster than Tsoder’s brute force method, but slower than my list comprehension methods.

I like the way permutations and constraints are separated

I dislike the way the constraints are based on the recursion depth, which keeps changing. Perhaps a helper method to generate constraints from a more intuitive description would help.

Abstracting `Predicates` out as a monoid does not simplify this program, but it is reusable. I think it could be better named, particularly as there could be similar monoids with the other boolean operators, by analogy with All and Any for simple booleans.

I called the method permute (a verb betraying my imperative background) which does not clash with Data.List.permutations, but perhaps the name should be closer.