第2回スタートHaskell宿題

start_haskell.homework2.hs

import Data.Char

-- homework 2.1

type Bit = Int
bin2int :: [Bit] -> Int
bin2int = foldr (\x y -> x + 2 * y) 0

int2bin :: Int -> [Bit]
int2bin n 
  | n < 0  = error "int2bin: invalid arg"
  | n == 0 = [0]
  | otherwise = int2bin' n
    where
      int2bin' 0 = []
      int2bin' n = (n `mod` 2) : int2bin' (n `div` 2)

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

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

xor :: [Bit] -> [Bit] -> [Bit]
xor = zipWith xor_bit
  where
    xor_bit x y | x == y = 0
                | otherwise = 1

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

bin2string :: [Bit] -> String
bin2string bits = map (chr . bin2int) (chop8 bits)

encode :: String -> String -> [Bit]
encode key text = xor ((cycle . string2bin) key) (string2bin text)

decode :: String -> [Bit] -> String
decode key bits = bin2string  (xor ((cycle .string2bin) key) bits)

transmit :: String -> String -> String
transmit key = (decode key) . channel . (encode key)

channel :: [Bit] -> [Bit]
channel = id

-- homework 2.2

relFiltLC _ [] = []
relFiltLC isSatisfied xs = (head xs) : [xs!!i | i <- [1 .. ((length xs) -1)], 
                                          isSatisfied (xs!!i) (xs!!(i - 1))] 

relFiltER _ [] = []
relFiltER isSatisfied xs = (head xs) : (relFiltER' xs)
  where
    relFiltER' []  = []
    relFiltER' (x:y:z)
      | null z = if (isSatisfied y x)  then [y] else []
      | isSatisfied y x = y : (relFiltER' (y:z))
      | otherwise = relFiltER' (y:z)

relFiltHO isSatisfied xs = (head xs) : foldl f [] [1 .. ((length xs) - 1)]
  where
    f es i | isSatisfied (xs!!i) (xs!!(i - 1)) = es ++ [xs!!i]
           | otherwise = es


-- homework 2.3

int2Hex :: Int -> [Int]
int2Hex n | n < 16 = [n `mod` 16]
          | otherwise = (n `mod` 16) : int2Hex (n `div` 16)

adler32 str = reverse (map intToDigit (int2Hex output))
  where
    d = (map ord str)
    n = length d
    a = (1 + sum d) `mod` 65521
    b = (n + sum [ (n - i) * (d!!i) | i <- [0 .. (n -1)]]) `mod` 65521
    output = b * 65536 + a

-- homework 2.4

derivation f x = ((f x') - (f x)) / dx
  where
    dx = 0.000000001
    x' = x + dx

newtonMethod precision f xinit = repeat xinit
  where
    f' = derivation f
    isZero x = (abs x) < precision
    repeat x0 | isZero (x1 - x0) = x1
              | otherwise = repeat x1
      where
        x1 = x0 - ((f x0) / (f' x0))

nroot :: Double -> Double -> Int -> Double
nroot precision a b 
  | ((a < 0) && (even b)) = error "even root of negative"
  | otherwise = newtonMethod precision f 22.0
    where 
      f x = x ^ b - a