2017年2月25日土曜日

開発環境

関数プログラミング入門(Richard Bird (著)、山下伸夫 (翻訳)、オーム社)の第4章(リスト)、4.2(リスト演算)、練習問題4.2.1、4.2.2、4.2.3、4.2.4、4.2.5、4.2.6、4.2.7、4.2.8、4.2.9、4.2.10、4.2.11、4.2.12、4.2.13を取り組んでみる。

練習問題4.2.1、4.2.2、4.2.3、4.2.4、4.2.5、4.2.6、4.2.7、4.2.8、4.2.9、4.2.10、4.2.11、4.2.12、4.2.13

コード(Emacs)

-- 4.2.1
-- xs:[] = [xs]

-- 4.2.2
-- [[]] ++ [xs] = [[]. xs]
-- [xs] ++ [] = [xs]
-- [xs] ++ [xs] = [xs, xs]

-- 4.2.3
-- [] ++ [] = []

-- (x:xs) ++ []
-- = x:(xs ++ [])
-- = x:xs

-- 4.2.4
-- concat ([] ++ yss)
-- = concat yss
-- = [] ++ (concat ysss)
-- = (concat []) ++ (concat yss)

-- concat ((xs:xss) ++ yss)
-- = concat (xs:(xss ++ yss))
-- = xs ++ (concat (xss ++ yss))
-- = xs ++ ((concat xss) ++ (concat yss))
-- = (xs ++ (concat xss)) ++ (concat yss)
-- = (concat (xs:xss)) ++ (concat yss)

-- 4.2.5
-- length ([] ++ ys)
-- = length ys
-- = 0 + (length ys)
-- = (length []) ++ (length ys)

-- length ((x:xs) ++ ys)
-- = length (x:(xs ++ ys))
-- = 1 + (length (xs ++ ys))
-- = 1 + ((length xs) + (length ys))
-- = (1 + (length xs)) + (length ys)
-- = length (x:xs) ++ length ys

-- 4.2.6
-- reverse undefined = undefined

-- reverse (x:xs)
-- = reverse xs ++ [x]
-- = undefined ++ [x]
-- = undefined


-- init undefined = undefined

-- init (x:xs)
-- = reverse . tail . reverse (x:xs)
-- = reverse . tail (x ++ reverse xs)
-- = reverse . tail undefined
-- = undefined

-- 4.2.7
-- reverse (reverse undefined)
-- = reverse (reverse undefined)
-- = undefined

-- reverse (reverse [])
-- = reverse []
-- = []

-- reverse (reverse (x:xs))
-- = (reverse xs) ++ [x]
-- ...

-- 4.2.8
rev2 :: [a] -> [a]
rev2 [] = []
rev2 [x] = [x]
rev2 (x:y:[]) = [y, x]
rev2 (x:y:z:xs) = x:y:z:xs

xs1, xs2, xs3, xs4 :: [Integer]
xs1 = []
xs2 = [1]
xs3 = [1,2]
xs4 = [1,2,3]

-- 4.2.9
xs = [1, 2, 1, 2]
ys = [1, 2]

-- 4.2.10
-- [undefined] ++ undefined = undefined

-- 4.2.11
-- (drop 0 xs) !! n
-- = xs !! n
-- = xs !! (0 + n)

-- (drop (m + 1) []) !! n
-- = [] !! n
-- = undefined
-- = [] !! ((m + 1) + n)

-- (drop (m + 1) (x:xs)) !! n
-- = (drop m xs) !! n
-- = xs !! (m + n)
-- = (x:xs) !! (m + n + 1)
-- = (x:xs) !! ((m + 1) + n)


-- 4.2.12
-- ([] ++ ys) !! k
-- = ys !! k
-- = ys !! (k - 0)
-- = if k < n then !! k else ys !! (k - 0) where n = length []


-- ((x:xs) ++ ys) !! 0
-- = (x:(xs ++ ys)) !! 0
-- = x
-- if k < n then (x:xs) !! k else ys !! (k - n) where n = length (x:xs)
-- = (x:xs) !! 0
-- = x

-- ((x:xs) ++ ys) !! (k + 1)
-- = (x:(xs ++ ys)) !! (k + 1)
-- = (xs ++ ys) !! k
-- = if k < n then xs !! k else ys !! (k - n) where n = length xs

-- if (k + 1) < n then (x:xs) !! (k + 1) else ys !! ((k + 1) - n)
--   where n = length (x:xs)
-- = if (k + 1) < 1 + (length xs)
--   then xs !! k
--   else ys !! (k + 1 - (1 + (length xs) + 1))
-- = if k < (length xs)
--   then xs !! k
--   else ys !! (k - (length xs))
-- = if k < n then xs !! k else ys !! (k - n) where n = length xs


-- 4.2.13
data CatList a = Nil | Wrap a | Cat (CatList a) (CatList a)
  deriving (Show)

cat2list :: CatList a -> [a]
cat2list Nil = []
cat2list (Wrap x) = [x]
cat2list (Cat Nil c) = cat2list c
cat2list (Cat (Wrap x) c) = x:(cat2list c)
cat2list (Cat (Cat x y) c) = (cat2list x) ++ cat2list (Cat y c)
  

instance (Eq a) => Eq (CatList a) where
  (==) x y = (cat2list x) == (cat2list y)

instance (Ord a) => Ord (CatList a) where
  (<=) x y = (cat2list x) <= (cat2list y)

cl1 :: CatList Integer
cl1 = Nil
cl2 = Wrap 1
cl3 = Wrap 2
cl4 = Cat cl1 cl2
cl5 = Cat cl2 cl3
cl6 = Cat cl3 cl2

main :: IO ()
main = do
  print (rev2 xs1)
  print (rev2 xs2)
  print (rev2 xs3)
  print (rev2 xs4)
  print (xs ++ ys == ys ++ xs)
  print cl1
  print cl2
  print cl3
  print cl4
  print cl5
  print cl6
  print (cl1 <= cl1)
  print (cl1 < cl2)
  print (cl2 < cl1)
  print (cl1 < cl4)
  print (cl4 < cl1)
  print (cl2 < cl3)
  print (cl3 < cl4)
  print (cl4 < cl3)

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

$ runghc sample2.hs
[]
[1]
[2,1]
[1,2,3]
True
Nil
Wrap 1
Wrap 2
Cat Nil (Wrap 1)
Cat (Wrap 1) (Wrap 2)
Cat (Wrap 2) (Wrap 1)
True
True
False
True
False
True
False
True
$

0 コメント:

コメントを投稿