引数の置換（permutation） ref: http://qiita.com/items/d05735d37b2111eefb39

AdventCalendar2012.hs

{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module AdventCalendar2012 where

import Data.Array
import Unsafe.Coerce

permutation :: [Int] -> [a] -> [a]
permutation pat = elems . array (1,len) . zip (elems $ array (1,len) $ zip pat [1..])
  where  len = length pat

uncurrying f = unsafeCoerce $ foldl (unsafeCoerce ($)) f

permute3 :: [Int] -> (a -> a -> a -> b) -> (a -> a -> a -> b)
permute3 pat f x y z = uncurrying f (currying n3 (permutation pat) x y z)
permute4 :: [Int] -> (a -> a -> a -> a -> b) -> (a -> a -> a -> a -> b)
permute4 pat f w x y z = uncurrying f (currying n4 (permutation pat) w x y z)
permute5 :: [Int] -> (a -> a -> a -> a -> b) -> (a -> a -> a -> a -> a -> b)
permute5 pat f v w x y z = uncurrying f (currying n5 (permutation pat) v w x y z)

list3 :: a -> a -> a -> [a]
list3 x y z = [x,y,z]
list4 :: a -> a -> a -> a -> [a]
list4 w x y z = [w,x,y,z]
list5 :: a -> a -> a -> a -> a -> [a]
list5 v w x y z = [v,w,x,y,z]

-- Natural Number

class Nat n where
  suc   :: n -> Succ n

data Zero
data Succ a

instance Nat Zero where
  suc    = suc

instance Nat n => Nat (Succ n) where
  suc    = suc

-- Positive Number

type family Fun n a b
type instance Fun Zero     a b = b
type instance Fun (Succ n) a b = a -> Fun n a b

class Nat n => Positive n where
  type Pred a
  pre :: n -> Pred n
  currying :: n -> ([a] -> b) -> Fun n a b

instance Positive (Succ Zero) where
  type Pred (Succ Zero) = Zero
  pre = pre
  currying _ f x = f [x]

instance Positive n => Positive (Succ n) where
  type Pred (Succ n) = n
  pre = pre
  currying n f x = currying (pre n) (g f x) where g h y = h . (y:)

-- Natural Number values

n0 :: Zero
n0 = n0
n1 :: One
n1 = suc n0
n2 :: Two
n2 = suc n1
n3 :: Three
n3 = suc n2
n4 :: Four
n4 = suc n3
n5 :: Five
n5 = suc n4
n6 :: Six
n6 = suc n5
n7 :: Seven
n7 = suc n6
n8 :: Eight
n8 = suc n7
n9 :: Nine
n9 = suc n8

type One   = Succ Zero
type Two   = Succ One
type Three = Succ Two
type Four  = Succ Three
type Five  = Succ Four
type Six   = Succ Five
type Seven = Succ Six
type Eight = Succ Seven
type Nine  = Succ Eight
type Ten   = Succ Nine
'''

file0.txt

permutation :: [Int] -> [a] -> [a]
permutation pat = elems . array (1,len) . zip (elems $ array (1,len) $ zip pat [1..])
  where  len = length pat

file1.txt

ghci> permutation [3,1,2] "abc"
"cab"

file2.txt

currying3 f x y z       = f [x,y,z]
uncurrying3 f (x:y:z:_) = f x y z

file3.txt

permute3 pat f x y z = uncurrying3 f (currying3 (permutation pat) x y z)

file4.txt

uncurrying 2 :: (a -> a -> b)      -> ([a] -> b)
uncurrying 3 :: (a -> a -> a -> b) -> ([a] -> b)