とりとめのないことを書いております。
by tempurature
カテゴリ
全体
プログラミング
scheme
verilog
未分類
以前の記事
2016年 04月
2016年 03月
2016年 02月
2016年 01月
2015年 12月
2015年 11月
2015年 10月
2015年 09月
2015年 08月
2015年 07月
2015年 06月
2015年 03月
お気に入りブログ
PHPで競技プログラミング
メモ帳
最新のトラックバック
ライフログ
検索
タグ
その他のジャンル
ブログパーツ
最新の記事
情報処理技術者試験 お疲れ様..
at 2016-04-17 18:55
基本情報技術者試験 平成27..
at 2016-04-14 04:48
基本情報技術者試験 平成27..
at 2016-04-13 23:03
苦い薬(ハーブ、サプリメント..
at 2016-04-09 14:03
「おバカ度チェックリスト」を..
at 2016-03-24 09:54
外部リンク
ファン
記事ランキング
ブログジャンル
画像一覧
Graham hutton著「プログラミングHaskell」7.8 練習問題を解答
-- ch7.hs

import Data.Char

type Bit = Int

-- 1.

func1a p f xs = [f x | x <- xs, p x]
func1b p f xs = map f (filter p xs)

test1 =
  and [comp even (*2) [1..10]]
  where
   comp p f xs = (func1a p f xs) == (func1b p f xs)

-- 2.

all' :: (a -> Bool) -> [a] -> Bool
all' p xs = foldl (\ prev x -> (prev && (p x))) True xs

any' :: (a -> Bool) -> [a] -> Bool
any' p xs = foldl (\ prev x -> (prev || (p x))) False xs

takeWhile' :: (a -> Bool) -> [a] -> [a]
takeWhile' p xs
  = foldr (\ x prev -> if (p x) then x:prev else []) [] xs

takeDrop' :: (a -> Bool) -> [a] -> [a]
takeDrop' p xs
  = foldl (\ prev x -> if (p x) then [] else (prev++[x])) [] xs

-- 3.

map' :: (a -> b) -> [a] -> [b]
map' f = foldl (\ xs x -> (xs++[f x])) []

filter' :: (a -> Bool) -> [a] -> [a]
filter' p = foldl (\ xs x -> (if (p x) then (xs++[x]) else xs)) []

-- 4.

dec2int :: [Int] -> Int
dec2int = foldl (\ sum n -> 10*sum+n) 0

-- 5.

{-
(filter even)関数と(map (^2))関数の型は[a]->[a],
sum関数の型は[a]->aであり、同じリストの要素とできない。
-}

-- 6.

curry' :: ((a, b) -> c) -> a -> b -> c
curry' f = (\ x y -> f (x, y))

uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' f = (\ (x, y) -> f x y)

-- 7.

--   int2bin 11
-- = unfold (==0) (`mod`2) (`div`2) 11
-- = (11`mod`2) : int2bin 5
-- = 1 : (5`mod`2) : int2bin 2
-- = 1 : 1 : (2`mod`2) : int2bin 1
-- = 1 : 1 : 0 : (1`mod`2) : int2bin 0
-- = 1 : 1 : 0 : 1 : []
-- = [1,1,0,1]

unfold :: (a -> Bool) -> (a -> b) -> (a -> a) -> a -> [b]
unfold p h t x | p x = []
               | otherwise = h x : unfold p h t (t x)

chop8 :: [Bit] -> [[Bit]]
chop8 = unfold null (take 8) (drop 8)

map'' :: (a -> b) -> [a] -> [b]
map'' f = unfold null (f.head) tail

iterate' :: (a -> a) -> a -> [a]
iterate' f = unfold (const False) id f

-- 8.

bin2int :: [Bit] -> Int
bin2int bits = sum [w*b | (w,b) <- zip weights bits]
               where weights = iterate (*2) 1

int2bin :: Int -> [Bit]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)

make8 :: [Bit] -> [Bit]
make8 bits = take 8 (bits ++ repeat 0)

addparity :: [Bit] -> [Bit]
addparity = (\xs->xs++[(sum xs) `mod` 2])

encode :: String -> [Bit]
encode = concat . map (addparity.make8.int2bin.ord)

chop9 :: [Bit] -> [[Bit]]
chop9 [] = []
chop9 bits = (take 9 bits) : (chop9 (drop 9 bits) )

checkparity :: [Bit] -> [Bit]
checkparity xs = if ((sum (init xs)) `mod` 2) == (last xs)
                 then (init xs)
                 else error "PARITY ERROR!!"

decode :: [Bit] -> String
decode = map (chr.bin2int.checkparity) . chop9

-- 9.

test9 = decode . tail . encode


[PR]
by tempurature | 2016-01-02 02:06 | プログラミング
<< プログラミングHaskellの... Graham hutton著「... >>