Haskell - リスト - 畳み込み (fold) 関数(左走査(scan left)、右走査(scan right))

関数プログラミング入門
原著

開発環境

• macOS Sierra - Apple (OS)
• Emacs (Text Editor)
• Haskell (プログラミング言語)
• Haskell Platform(ghci)(処理系)

関数プログラミング入門(Richard Bird (著)、山下伸夫 (翻訳)、オーム社)の第4章(リスト)、4.5(畳み込み (fold) 関数)、練習問題4.5.1、4.5.2、4.5.3、4.5.4、4.5.5、4.5.6、4.5.7、4.5.8、4.5.9、4.5.10、4.5.11、4.5.12を取り組んでみる。

練習問題4.5.1、4.5.2、4.5.3、4.5.4、4.5.5、4.5.6、4.5.7、4.5.8、4.5.9、4.5.10、4.5.11、4.5.12

コード(Emacs)

-- 4.5.1
filter' :: (a -> Bool) -> [a] -> [a]
filter' p = foldr f []
  where f x xs = if p x
                 then x:xs
                 else xs

-- 4.5.2
takeWhile' :: (a -> Bool) -> [a] -> [a]
takeWhile' p = foldr f []
  where f x xs = if p x
                 then x:xs
                 else []

dropWhile' :: (a -> Bool) -> [a] -> [a]
dropWhile' p = foldl f []
  where f xs x = if null xs && p x
                 then []
                 else xs ++ [x]
-- 4.5.3
-- 4.5.4
insert :: (Ord a) => a -> [a] -> [a]
insert x xs = takeWhile (<= x) xs ++ [x] ++ dropWhile (<= x) xs

isort :: (Ord a) => [a] -> [a]
isort = foldr insert []

-- 4.5.5
remdups :: (Eq a) => [a] -> [a]
remdups = foldr f []
  where f x [] = [x]
        f x (y:ys) = if x == y
                     then (y:ys)
                     else (x:y:ys)

remdups' :: (Eq a) => [a] -> [a]
remdups' = reverse . foldl f []
  where f [] x = [x]
        f (x:xs) y = if x == y
                     then x:xs
                     else y:x:xs 

-- 4.5.6
ssm :: (Ord a) => [a] -> [a]
ssm (x:xs) = reverse (foldl f [x] (x:xs))
  where f (x:xs) y = if x < y
                     then y:x:xs
                     else x:xs

-- 4.5.7
-- scanl f e []
-- = (map (foldl f e) . inits) []
-- = map (foldl f e) [[]]
-- = ((fold l f e) []):(map (foldl f e) [])
-- = e:[]
-- = [e]

-- 4.5.8
-- 4.5.9
fact 0 = 1
fact 1 = 1
fact n = n * fact (n - 1)

-- 4.5.10
term n = 1 / (fact n)
epsilon = 0.0000001
e = sum (takeWhile (epsilon<=) (map term [0..]))

-- 4.5.11
-- folde f e Nil = e
-- (foldl f e . convert) Nil
-- = foldl f e []
-- = e

-- folde f e (Snoc xs x)
-- f (folde f e xs) x

-- (foldl f e . convert) (Snoc xs x)
-- = foldl f e ((convert xs) ++ [x])
-- = foldl f (foldl f e (convert xs)) [x]
-- = foldl f (foldl f e (convert xs)) (x:[])
-- = foldl f (f (foldl f e (convert xs)) x) []
-- = f (foldl f e (convert xs)) x
-- = f (folde f e xs) x

-- 4.5.12
tails1 :: [a] -> [[a]]
tails1 [x] = [[x]]
tails1 (x:xs) = (x:xs):tails1 xs

-- scanr1 f (x:xs)
-- = map (foldr1 f) (tails1 (x:xs))
-- = map (foldr1 f) ((x:xs):(tails1 xs))
-- = (foldr1 f (x:xs)):(map (foldr1 f) (tails1 xs))
-- = (if null xs then x else f x (foldr1 f xs)):(map (foldr1 f) (tails1 xs))
-- not (null xs)
-- = (f x (foldr1 f xs)):(map (foldr1 f) (tails1 xs))
-- = (f x ((foldr1 f) xs)):(map (foldr1 f) (tails1 xs))
-- = (f x ((foldr1 f) (head (tails1 xs)))):(map (foldr1 f) (tails1 xs))
-- = (f x (head (map (foldr1 f) (tails1 xs)))):(map (foldr1 f) (tails1 xs))
-- = (f x (head (scanr1 f xs))):(scanr1 f xs)
-- = (f x (head ys)):ys where ys = scanr1 f xs

-- scanr1 f (x:[])
-- = map (foldr1 f) (tails1 (x:[]))
-- = map (foldr1 f) (tails1 [x])
-- = map (foldr1 f) [[x]]
-- = map (foldr1 f) ([x]:[])
-- = (foldr1 f [x]):(map (foldr1 f) [])
-- = (foldr1 f (x:[])):[]
-- = x:[]
-- = [x]

scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 _ [] = []
scanr1 _ [x] = [x]
scanr1 f (x:xs) = (f x (head ys)):ys
  where ys = Main.scanr1 f xs

  
main :: IO ()
main = do
  print (filter' even [1..10])
  print (takeWhile' even [2, 4, 6, 8, 10, 1, 2, 3, 4, 5])
  print (dropWhile' even [2, 4, 6, 8, 10, 1, 2, 3, 4, 5])
  print (foldl (-) 10 [1..10] == 10 - sum [1..10])
  print (foldr (-) 10 [1..10] /= 10 - sum [1..10])
  print (isort ([] :: [Integer]))
  print (isort [1])
  print (isort [1..10])
  print (isort (reverse [1..10]))
  print (isort [1, 10, 2, 9, 3, 8, 4, 7, 6, 5])
  print (remdups [1, 2, 2, 3, 3, 3, 1, 1])
  print (remdups' [1, 2, 2, 3, 3, 3, 1, 1])
  print (ssm [3, 1, 3, 4, 9, 2, 10, 7])
  print (scanl (/) 1 [1..10])
  print (map (\n -> 1 / (fact n)) [0..10])
  print ((scanl (/) 1 [1..10]) == (map (\n -> 1 / (fact n)) [0..10]))
  print (map (\(x, y) -> abs (x - y))
             (zip (scanl (/) 1 [1..10])
                  (map (\n -> 1 / (fact n)) [0..10])))
  print e
  print (Main.scanr1 (+) [1..10])

入出力結果(Terminal, ghci, runghc)

$ runghc sample5.hs
[2,4,6,8,10]
[2,4,6,8,10]
[1,2,3,4,5]
True
True
[]
[1]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,1]
[1,2,3,1]
[3,4,9,10]
[1.0,1.0,0.5,0.16666666666666666,4.1666666666666664e-2,8.333333333333333e-3,1.388888888888889e-3,1.984126984126984e-4,2.48015873015873e-5,2.7557319223985893e-6,2.7557319223985894e-7]
[1.0,1.0,0.5,0.16666666666666666,4.1666666666666664e-2,8.333333333333333e-3,1.388888888888889e-3,1.984126984126984e-4,2.48015873015873e-5,2.7557319223985893e-6,2.755731922398589e-7]
False
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,5.293955920339377e-23]
2.7182818011463845
[55,54,52,49,45,40,34,27,19,10]
$