第2回スタートHaskell演習問題

supplement2.hs

import Data.Char
import Prelude hiding (maximum, minimum, splitAt)

-- ex 5.9
pyths :: Int -> [(Int,Int,Int)]
pyths x | x <= 0 = [(0,0,0)]
        | otherwise = [(a,b,c) | a <- [1..x],
                                 b <- [a..x],
                                 c <- [b..x],
                                 c * c == (a * a) + (b * b)]

-- ex 5.10
vowelPositions :: String -> [Int] 
vowelPositions = reverse . vowelPositions' [] 1
  where
    isVowel :: Char -> Bool
    isVowel c = not (null [v | v <- ['a', 'i', 'u', 'e', 'o'], (toLower c) == v])
    vowelPositions' :: [Int] -> Int -> String ->  [Int]
    vowelPositions' indexes i [] = indexes
    vowelPositions' indexes i (c:cs) | isVowel c = vowelPositions' (i:indexes) (1 + i) cs
                                     | otherwise = vowelPositions' indexes (1 + i) cs

-- ex 5.11

stddev :: [Double] -> Double
stddev es = sqrt ub
  where
    avrg = (sum es) / n
    n = fromInteger (toInteger (length es)) 
    ub = (sum [(x - avrg) * (x - avrg) | x <- es]) / (n - 1)

stddev' :: Real a => [a] -> Double
stddev' es = sqrt (fromRational ub)
   where
    arg = [(toRational x) / n | x <- es]
    avrg = fromRational (sum arg) 
    n = toRational (length es)
    ub = (sum [((toRational x) - avrg) * ((toRational x) - avrg) | x <- es]) / (n - 1)

-- ex 6.7
everyOther :: [a] -> [a]
everyOther [] = []
everyOther (x:xs) = x : (everyOther' xs)
  where
    everyOther' :: [a] -> [a]
    everyOther' [] = []
    everyOther' (x:xs) = everyOther xs

-- ex 6.8
maximum :: Ord a => [a] -> a
maximum [] = error "maximum of empty list"
maximum (x:[]) = x
maximum (x:xs) = if x > maxOfRest then x else maxOfRest
  where
    maxOfRest = maximum xs

minimum:: Ord a => [a] -> a
minimum [] = error "minimum of empty list"
minimum (x:[]) = x
minimum (x:xs) = if x < minOfRest then x else minOfRest
  where
    minOfRest = minimum xs

-- ex 6.9
splitAt :: Int -> [a] -> ([a],[a])
splitAt _ [] = ([], [])
splitAt n (x:xs) | n < 1 = ([], x:xs)
                 | otherwise  = (x:ls, rs)
  where
    (ls,rs) = splitAt (n - 1) xs

-- ex6.10
slide :: Int -> [a] -> [[a]]
slide _ [] = []
slide n xs = (take n xs) : (slide n (tail xs))

-- ex 7.10
hoge :: String -> [Int]
hoge xs = [ord x' + c | x <- xs, let x' = toUpper x, isAsciiUpper x']
  where
    c = 1 - ord 'A' 

asciiUpperIndex :: String -> [Int]
asciiUpperIndex str = map (\x' -> ord x' + c) (filter isAsciiUpper (map toUpper str))
  where
    c = 1 - ord 'A'

-- ex 7.11
luhncheck :: String -> Bool
luhncheck [] = False
luhncheck str = (sumOfElems `mod` 10) == 0
  where
    sumOfElems = (sum . tensPlaceSplit . monoTwice . reverse) [digitToInt c | c <- str, isDigit c]
    monoTwice :: [Int] -> [Int]
    monoTwice [] = []
    monoTwice (x:xs) = x:(twiceMono xs)
    twiceMono ::  [Int] -> [Int]
    twiceMono [] = []
    twiceMono (x:xs) = (2 * x):(monoTwice xs)
    tensPlaceSplit :: [Int] -> [Int]
    tensPlaceSplit [] = []
    tensPlaceSplit (x:xs) | (x < 0) || (x > 100) = error "tensPlaceSplit: invalid arg"
                          | x < 10 = x:(tensPlaceSplit xs)
                          | otherwise = (x `div` 10) : (x `mod` 10) : (tensPlaceSplit xs)

-- ex 7.12
concatR :: [[a]] -> [a]
concatR = foldr (++) [] 

concatL :: [[a]] -> [a]
concatL [] = []
concatL (l:ls) = foldl (++) l ls

-- concatR ではリストの先頭の値を評価するためにリスト全体を評価しなければならない。
-- concatL ではリストの先頭の値は先頭だけを評価するだけで得られる。
-- したがってconcatLの方が効率がよい。


-- ex 7.13
nmerge :: Ord a => [[a]] -> [a]
nmerge [] = []
nmerge (l:ls) = merge' l (nmerge ls)
  where
    merge' :: Ord a => [a] -> [a] -> [a]
    merge' [] xs = xs
    merge' xs [] = xs
    merge' (x:xs) (y:ys) | x < y = x:(merge' xs (y:ys))
                         | otherwise = y:(merge' (x:xs) ys)

-- ex 7.14
count :: (a -> Bool) -> [a] -> Int
count isSatisfied (x:xs) = f (foldl f (f 0 x) xs)
  where
    f num headElem | isSatisfied headElem = num + 1
                   | otherwise = num