icyrock.com

Home

PureScript experiments - permutations

2017-Feb-25 11:51
purescript-experimentspurescript

Bottom-up permutation generation by inserting elements:

1
2
3
4
5
6
7
8
9
10
11
12
-- Bottom-up
inse1 :: forall a. a -> Array a -> Array (Array a)
inse1 e [] = [[e]]
inse1 e a = [(e : a)] <> map (cons h) (inse1 e t)
  where h = unsafePartial head a
        t = unsafePartial tail a
 
inse :: forall a. a -> Array (Array a) -> Array (Array a)
inse e a = concatMap (inse1 e) a
 
permsi :: forall a. Array a -> Array (Array a)
permsi a = foldr (\e r -> inse e r) [[]] a

Sample run:

1
2
> permsi [1,2,3,4]
[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[1,3,2,4],[3,1,2,4],[3,2,1,4],[3,2,4,1],[1,3,4,2],[3,1,4,2],[3,4,1,2],[3,4,2,1],[1,2,4,3],[2,1,4,3],[2,4,1,3],[2,4,3,1],[1,4,2,3],[4,1,2,3],[4,2,1,3],[4,2,3,1],[1,4,3,2],[4,1,3,2],[4,3,1,2],[4,3,2,1]]

Top-down permutation generation by selecting elements:

1
2
3
4
5
6
7
8
9
10
11
12
-- Top-down
picks :: forall a. Array a -> Array (Tuple a (Array a))
picks [] = []
picks a = Tuple h t : map hadd (picks t)
  where h = unsafePartial head a
        t = unsafePartial tail a
        hadd (Tuple e r) = Tuple e (h : r)
 
permss :: forall a. Array a -> Array (Array a)
permss [e] = [[e]]
permss a = foldl f [] (picks a)
  where f s (Tuple e r) = s <> map (cons e) (permss r)

Sample run:

1
2
> permss [1,2,3,4]
[[1,2,3,4],[1,2,4,3],[1,3,2,4],[1,3,4,2],[1,4,2,3],[1,4,3,2],[2,1,3,4],[2,1,4,3],[2,3,1,4],[2,3,4,1],[2,4,1,3],[2,4,3,1],[3,1,2,4],[3,1,4,2],[3,2,1,4],[3,2,4,1],[3,4,1,2],[3,4,2,1],[4,1,2,3],[4,1,3,2],[4,2,1,3],[4,2,3,1],[4,3,1,2],[4,3,2,1]]