関数プログラミングの気分（『多段階選抜』問題を題材にして） ref: http://qiita.com/nobsun/items/4562b728ecd560557bd2

file10.txt

(*)   は \ p -> (\ q -> p * q) と同じ
(p *) は \ q -> p * q          と同じ
(* q) は \ p -> p * q          と同じ

file11.txt

type Selector = [Int] -> [Int]

file12.txt

selector :: [Char] -> Selector
selector = undefined

file13.txt

selector :: [Char] -> Selector
selector = undefined

file14.txt

(f ∘ g) xs = g (f xs)

file15.txt

f ∘ g = g . f

file16.txt

type Table = [(Char, Selector)]

table :: Table
table = undefined

lookup' :: Table -> (Char -> Maybe Selector)
lookup' = undefined

file17.txt

lookup' = flip lookup

file18.txt

primSelector = maybe id id      -- 2. Mabye Selector を Selector に変換
             . lookup' table    -- 1. 選抜関数検索表 table を検索

file19.txt

primSelector = maybe id id      -- 2. Mabye Selector を Selector に変換
             . lookup' table    -- 1. 選抜関数検索表 table を検索

file2.txt

f :: A -> B

file20.txt

type Predicate a = a -> Bool
type Condition   = Pred Int

file21.txt

rmNext :: Condition -> Selector
rmNext p (x:xs) = x : (if p x then tail else id) (rmNext p xs)

file22.txt

rmPrev :: Condition -> Selector
rmPrev p (x:xs@(x':_)) = (if p x' then id else (x:)) (rmPrev p xs)

file23.txt

isSquare :: Condition
isSquare i = round (fromIntegral i ** (1/2)) ^ 2 == i

isCube :: Condition
isCube i = round (fromIntegral i ** (1/3)) ^ 3 == i

file24.txt

isPowers :: Int -> Condition
isPowers n i = round (i' ** recip n') ^ n == i
  where
    n' = fromIntegral n
    i' = fromIntegral i

isSquare :: Condition
isSquare = isPowers 2

isCube :: Condition
isCube = isPowers 3

file25.txt

entries1and2 :: Table
entries1and2 = [('S', rmNext isSquare)
               ,('s', rmPrev isSquare)
               ,('C', rmNext isCube)
               ,('c', rmPrev isCube)
               ]

file26.txt

entries1and2 :: Table
entries1and2 = [('S', rmNext isSquare)
               ,('s', rmPrev isSquare)
               ,('C', rmNext isCube)
               ,('c', rmPrev isCube)
               ]

file27.txt

rmEvery :: Int -> Selector
rmEvery n xs = case splitAt (n-1) of
  (ys,_:zs) -> ys ++ rmEvery n zs

file28.txt

entries3 :: Table
entries3 = map entry "23456789"
  where
    entry c = (c, rmEvery (digitToInt c))

file29.txt

rmFirst :: Int -> Selector
rmFirst = drop

file3.txt

f :: Int -> Int
f x = 2 * x + 1

file30.txt

entries4 :: Table 
entries4 = [('h', rmFirst 100)]

file31.txt

entries4 :: Table 
entries4 = [('h', rmFirst 100)]

file32.txt

λ. doctest O24.hs
Examples: 51  Tried: 51  Errors: 0  Failures: 0

file33.txt

λ. doctest O24.hs
Examples: 51  Tried: 51  Errors: 0  Failures: 0

file34.txt

rmNext p (x:xs) = x : (if p x then tail else id) (rmNext p xs)
~~~~~~~~  ~ ~~    ~         ~                     ~~~~~~~~ ~~

file35.txt

rmNext p = foldr f []
  where
    f x y = x : bool id tail (p x) y

file36.txt

bool :: a -> a -> Bool -> a

file37.txt

rmPrev p (x:xs) = (if p (head xs) then id else (x:)) (rmPrev p xs)
~~~~~~~~  ~ ~~                ~~                ~     ~~~~~~~~ ~~

file38.txt

paraL :: b -> (a -> ([a],b) -> b) -> [a] -> b)
paraL b f []     = b
paraL b f (x:xs) = f x (xs, paraL b f xs)

file39.txt

rmPrev p = paraL [] f
  where
    f x (xs,y) = bool (x:) id (p $ head xs) y

file4.txt

f :: Int -> Int
f = \ x -> 2 * x + 1

file40.txt

cataL :: b -> (a -> b -> b) -> [a] -> b
cataL = flip foldr

file5.txt

f :: Int -> Int
f = inc . double

file6.txt

f x = inc (double x)

file7.txt

add = (+)

file8.txt

add :: Int -> (Int -> Int)

file9.txt

inc :: Int -> Int
inc = add 1

mul :: Int -> (Int -> Int)
mul = (*)

double :: Int -> Int
double = mul 2

O24.hs

module O24 where

import Data.Char (digitToInt)
import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 文字列のリストを "," を挟んで連結する
    . map show                    -- 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = foldl (∘) id     -- 選抜関数列を合成して1つの選抜関数へ変換
         . map primSelector -- 文字列から選抜関数列へ変換

(∘) :: Selector -> Selector -> Selector
f ∘ g = g . f

primSelector :: Char -> Selector
primSelector = maybe id id      -- Mabye Selector を Selector に変換
             . lookup' table    -- 選抜関数検索表 table を検索

type Table = [(Char, Selector)]

table :: Table
table = entries1and2 ++ entries3 ++ entries4

lookup' :: Table -> (Char -> Maybe Selector)
lookup' = flip lookup

type Predicate a = a -> Bool
type Condition   = Predicate Int

rmNext :: Condition -> Selector
rmNext p (x:xs) = x : (if p x then tail else id) (rmNext p xs)

rmPrev :: Condition -> Selector
rmPrev p (x:xs@(x':_)) = (if p x' then id else (x:)) (rmPrev p xs)

isPowers :: Int -> Condition
isPowers n i = round (i' ** recip n') ^ n == i
  where
    n' = fromIntegral n
    i' = fromIntegral i

isSquare :: Condition
isSquare = isPowers 2

isCube :: Condition
isCube = isPowers 3

entries1and2 :: Table
entries1and2 = [('S', rmNext isSquare)
               ,('s', rmPrev isSquare)
               ,('C', rmNext isCube)
               ,('c', rmPrev isCube)
               ]

rmEvery :: Int -> Selector
rmEvery n xs = case splitAt (n-1) xs of
  (ys,_:zs) -> ys ++ rmEvery n zs

entries3 :: Table
entries3 = map entry "23456789"
  where
    entry c = (c, rmEvery (digitToInt c))

rmFirst :: Int -> Selector
rmFirst = drop

entries4 :: Table
entries4 = [('h', rmFirst 100)]

type Test = (Problem, Answer)

{- |
>>> test ( "ss6cc24S", "1,9,21,30,33,37,42,44,49,56" )
True
>>> test ( "h", "101,102,103,104,105,106,107,108,109,110" )
True
>>> test ( "hh", "201,202,203,204,205,206,207,208,209,210" )
True
>>> test ( "hhh", "301,302,303,304,305,306,307,308,309,310" )
True
>>> test ( "2", "1,3,5,7,9,11,13,15,17,19" )
True
>>> test ( "22", "1,5,9,13,17,21,25,29,33,37" )
True
>>> test ( "222", "1,9,17,25,33,41,49,57,65,73" )
True
>>> test ( "3", "1,2,4,5,7,8,10,11,13,14" )
True
>>> test ( "33", "1,2,5,7,10,11,14,16,19,20" )
True    
>>> test ( "333", "1,2,7,10,14,16,20,23,28,29" )
True    
>>> test ( "s", "1,2,4,5,6,7,9,10,11,12" )
True    
>>> test ( "ss", "1,4,5,6,9,10,11,12,13,16" )
True    
>>> test ( "sss", "4,5,9,10,11,12,16,17,18,19" )
True    
>>> test ( "S", "1,3,4,6,7,8,9,11,12,13" )
True    
>>> test ( "SS", "1,4,7,8,9,12,13,14,15,16" )
True    
>>> test ( "SSS", "1,8,9,13,14,15,16,20,21,22" )
True    
>>> test ( "c", "1,2,3,4,5,6,8,9,10,11" )
True    
>>> test ( "cc", "1,2,3,4,5,8,9,10,11,12" )
True    
>>> test ( "ccc", "1,2,3,4,8,9,10,11,12,13" )
True    
>>> test ( "C", "1,3,4,5,6,7,8,10,11,12" )
True    
>>> test ( "CC", "1,4,5,6,7,8,11,12,13,14" )
True    
>>> test ( "CCC", "1,5,6,7,8,12,13,14,15,16" )
True    
>>> test ( "23", "1,3,7,9,13,15,19,21,25,27" )
True    
>>> test ( "32", "1,4,7,10,13,16,19,22,25,28" )
True    
>>> test ( "2h", "201,203,205,207,209,211,213,215,217,219" )
True    
>>> test ( "h2", "101,103,105,107,109,111,113,115,117,119" )
True    
>>> test ( "sC", "1,4,5,6,7,9,10,11,12,13" )
True    
>>> test ( "Cs", "1,4,5,6,7,8,10,11,12,13" )
True    
>>> test ( "s468", "1,2,4,6,7,11,12,16,17,20" )
True    
>>> test ( "S468", "1,3,4,7,8,12,13,16,18,21" )
True    
>>> test ( "cc579", "1,2,3,4,8,9,11,13,15,16" )
True    
>>> test ( "CC579", "1,4,5,6,8,11,13,15,17,18" )
True    
>>> test ( "85", "1,2,3,4,6,7,9,10,12,13" )
True    
>>> test ( "sh", "110,111,112,113,114,115,116,117,118,119" )
True    
>>> test ( "94h", "150,151,154,155,156,158,159,160,163,164" )
True    
>>> test ( "h9c8", "101,102,103,104,105,106,107,110,111,112" )
True    
>>> test ( "Cc3s", "1,3,5,6,10,11,13,16,17,19" )
True    
>>> test ( "cs4h6", "149,150,152,153,154,157,158,160,161,162" )
True    
>>> test ( "84523c", "1,3,11,15,23,26,34,38,46,49" )
True    
>>> test ( "54C78hS", "228,231,232,233,236,241,242,243,246,247" )
True    
>>> test ( "65h7ccs", "151,152,153,154,157,158,160,163,164,165" )
True    
>>> test ( "c95hSc2C", "145,147,151,153,156,159,162,164,168,171" )
True    
>>> test ( "c5h3Ss794", "130,131,133,137,138,142,148,150,152,157" )
True    
>>> test ( "7ShscC846", "129,130,131,134,135,139,141,142,146,148" )
True    
>>> test ( "cshSCCS7ch", "253,254,256,259,260,261,263,264,265,266" )
True    
>>> test ( "hhC7849Ss6C", "201,202,203,205,206,211,212,216,220,225" )
True    
>>> test ( "hhsc3C987Ccs", "201,202,204,205,207,208,214,217,218,220" )
True    
>>> test ( "SC7S8hc59ss2", "162,169,174,178,182,185,188,194,199,203" )
True    
>>> test ( "s7S6c35C9CShc", "367,371,377,379,380,385,387,388,392,395" )
True    
>>> test ( "4scC3hh982Cc5s", "422,426,430,434,447,451,459,463,471,479" )
True    
>>> test ( "23h465Ssc9CchC", "1027,1033,1045,1047,1057,1069,1071,1075,1081,1093" )
True
-}
test :: Test -> Bool
test (p,a) = o24 p == a

O24v01.hs

module O24v01 where

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = undefined

O24v02.hs

module O24v01 where

import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 5. 文字列のリストを "," を挟んで連結する
    . map show                    -- 4. 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 3. 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 2. 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 1. 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = undefined

O24v03.hs

module O24v03 where

import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 文字列のリストを "," を挟んで連結する
    . map show                    -- 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = foldl (∘) id     -- 2. 選抜関数列を合成して1つの選抜関数へ変換
         . map primSelector -- 1. 文字列から選抜関数列へ変換

(∘) :: Selector -> Selector -> Selector
(∘) = undefined

primSelector :: Char -> Selector
primSelector = undefined

O24v04.hs

module O24v04 where

import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 文字列のリストを "," を挟んで連結する
    . map show                    -- 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = foldl (∘) id -- 選抜関数列を合成して1つの選抜関数へ変換
         . map primSelector -- 文字列から選抜関数列へ変換

(∘) :: Selector -> Selector -> Selector
f ∘ g = g . f

primSelector :: Char -> Selector
primSelector = maybe id id      -- 2. Mabye Selector を Selector に変換
             . lookup' table    -- 1. 選抜関数検索表 table を検索

type Table = [(Char, Selector)]

table :: Table
table = undefined

lookup' :: Table -> (Char -> Maybe Selector)
lookup' = flip lookup

O24v05.hs

module O24v05 where

import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 文字列のリストを "," を挟んで連結する
    . map show                    -- 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = foldl (∘) id     -- 選抜関数列を合成して1つの選抜関数へ変換
         . map primSelector -- 文字列から選抜関数列へ変換

(∘) :: (a -> b) -> (b -> c) -> (a -> c)
f ∘ g = g . f

primSelector :: Char -> Selector
primSelector = maybe id id      -- Mabye Selector を Selector に変換
             . lookup' table    -- 選抜関数検索表 table を検索

type Table = [(Char, Selector)]

table :: Table
table = entries1and2 ++ undefined

lookup' :: Table -> (Char -> Maybe Selector)
lookup' = flip lookup

type Predicate a = a -> Bool
type Condition   = Predicate Int

rmNext :: Condition -> Selector
rmNext p (x:xs) = x : (if p x then tail else id) (rmNext p xs)

rmPrev :: Condition -> Selector
rmPrev p (x:xs@(x':_)) = (if p x' then id else (x:)) (rmPrev p xs)

isPowers :: Int -> Condition
isPowers n i = round (i' ** recip n') ^ n == i
  where
    n' = fromIntegral n
    i' = fromIntegral i

isSquare :: Condition
isSquare = isPowers 2

isCube :: Condition
isCube = isPowers 3

entries1and2 :: Table
entries1and2 = [('S', rmNext isSquare)
               ,('s', rmPrev isSquare)
               ,('C', rmNext isCube)
               ,('c', rmPrev isCube)
               ]

O24v06.hs

module O24v06 where

import Data.Char (digitToInt)
import Data.List (intercalate)

type Problem = String
type Answer = String

o24 :: Problem -> Answer
o24 = intercalate ","             -- 文字列のリストを "," を挟んで連結する
    . map show                    -- 適用結果の整数列を表示用文字列の列に変換する
    . take 10                     -- 選抜結果を先頭から10個だけにする
    . ($ [1..])                   -- 選抜関数をすべての正整数を小さいほうから並べたリストに適用する
    . selector                    -- 記号列から選抜関数を構成する

type Selector = [Int] -> [Int]

selector :: [Char] -> Selector
selector = foldl (∘) id     -- 選抜関数列を合成して1つの選抜関数へ変換
         . map primSelector -- 文字列から選抜関数列へ変換

(∘) :: Selector -> Selector -> Selector
f ∘ g = g . f

primSelector :: Char -> Selector
primSelector = maybe id id      -- Mabye Selector を Selector に変換
             . lookup' table    -- 選抜関数検索表 table を検索

type Table = [(Char, Selector)]

table :: Table
table = entries1and2 ++ entries3 ++ entries4

lookup' :: Table -> (Char -> Maybe Selector)
lookup' = flip lookup

type Predicate a = a -> Bool
type Condition   = Predicate Int

rmNext :: Condition -> Selector
rmNext p (x:xs) = x : (if p x then tail else id) (rmNext p xs)

rmPrev :: Condition -> Selector
rmPrev p (x:xs@(x':_)) = (if p x' then id else (x:)) (rmPrev p xs)

isPowers :: Int -> Condition
isPowers n i = round (i' ** recip n') ^ n == i
  where
    n' = fromIntegral n
    i' = fromIntegral i

isSquare :: Condition
isSquare = isPowers 2

isCube :: Condition
isCube = isPowers 3

entries1and2 :: Table
entries1and2 = [('S', rmNext isSquare)
               ,('s', rmPrev isSquare)
               ,('C', rmNext isCube)
               ,('c', rmPrev isCube)
               ]

rmEvery :: Int -> Selector
rmEvery n xs = case splitAt (n-1) xs of
  (ys,_:zs) -> ys ++ rmEvery n zs

entries3 :: Table
entries3 = map entry "23456789"
  where
    entry c = (c, rmEvery (digitToInt c))

rmFirst :: Int -> Selector
rmFirst = drop

entries4 :: Table
entries4 = [('h', rmFirst 100)]