Haskell 笔记2

Haskell 笔记2

《haskell 趣学指南》 代码

-- helloworld.hs
main = putStrLn "Hello, World!"

-- applytwice.hs
applyTwice :: (a->a) -> a ->a
applyTwice f x = f (f x)

-- avg.hs
import Data.List(genericLength)
avg xs = sum xs / genericLength xs

-- baby.hs
doubleMe x = x+x
doubleUs x y = doubleMe x + doubleMe y
doubleSmallNumber x = if x>100
                        then x
                        else x*2
doubleSmallNumber' x = (if x > 100 then x else x*2)+1
doubleSmallNumber'' x = if x > 100 then x else x*2 + 1
conan0'Brien = "It's a-me,Conan 0'Brien!"

-- boolean.hs
import PreLude hiding ((/=),(==),not,and,or,(&&),(||))
(==)::Bool->Bool->Bool
(==) True True = True
(==)False False = True
(==) __ = False
not :: Bool->Bool
not True = False
not _ = True
not' = (==False)

-- calcBmis.hs
clacBmis ::(RealFloat a) => [(a,a)]->[a]
clacbmis xs = [bmi |(w,h)<- xs,let bmi = w/h ^2,bmi >=25.0]

-- calender.hs
type Weekday = Int
type Year = Int
type Month = Int
type Day = Int
week'::Year->Day->Weekday
week' y d = let y1 = y -1 in (y1+(div y1 4)-(div y1 100)+(div y1 400)+d) `mod` 7
isLeapYear:: Int->Bool
isLeapYear y = (mod y 4 ==0) && (mod y 100 /= 0) || (mod y 400 == 0)
monthDays :: Year -> Month -> Int
monthDays y m | m ==2 = if not $ isLeapYear y then 28 else 29
              |elem m [1,3,5,7,8,10,12] = 31
              |elem m [4,6,9,11] = 30
              |otherwise = error "invaid month"
accDays :: Year->Month->Day->Int
accDays y m d |  d > monthDays y m  = error "invalid days"
              |otherwise = (sum $ take (m-1)(map(monthDays y)[1..12]))+d

-- case.hs
head' :: [a] -> a
head' [] = error "No head for empty lists!"
head' (x:_) = x

-- case1.hs
head' :: [a] -> a
head' xs = case xs of [] -> error "No head for empty lists!" (x:_) -> x

-- case2.hs
describeList :: [a] -> String
describeList xs = "The list is" ++ case xs of []->"empty."
                                        [x]->"a singleton list."
                                        xs->"a longer list."

-- case3.hs
describeList:: [a] -> String
describrList xs = "This list is" ++ what xs
    where what [] = "empty."
          what [x] = "a singleton list."
          what xs = "a longer list."

-- chain.hs
chain :: (Integral a) => a->[a]
chain 1 = [1]
chain n
      | even n = n : chain(n `div` 2)
      | odd n = n: chain (3 * n + 1)
numLongChains :: Int
numLongChains = length (filter isLong(map chain [1..100]))
                  where isLong xs = length xs > 15

-- compareWithHundered.hs
compareWithHundred :: (Num a,Ord a) => a -> Ordering
compareWithHundred  = compare 100

-- contains6'.hs
contains6' :: [Int]
contains6' = map (\str->read str:: Int) $ filter (elem '6') (map show [1..100])

-- contains6.hs
contains6::[String]
contains6 = filter(elem '6')(map show [1..100])

-- divideByTen.hs
divideByTen :: (Floating a) => a -> a
divideByTen = (/10)

-- doas.hs
capital :: String -> String
capital "" = "Empty string,whoops!"
capital all@(x:xs) = "The first letter of" ++ all ++ "is" ++ [x]

-- elem.hs
elem' :: (Eq a) => a -> [a] -> Bool
elem' a [] = False
elem' a (x:xs)
    | a == x = True
    |ohterwise = a `elem'` xs

-- elem2.hs
--左折叠实现 elem 函数
elem2 :: (Eq a) => a->[a] -> Bool
elem2 y ys = foldl(\acc x -> if x==y then True else acc) False ys

-- error
a = error "a is an error"

-- fact.hs
factorial :: (Integral a) => a -> a
factorial 0 = 0
factorial 1 = 1
factorial x = factorial (x-1) * x

-- factorial.hs
factorial :: Integer -> Integer
factorial n  | n < 0 = error "i is less than 0"
             | n == 0 = 1
             | otherwise = n*factorial(n-1)

-- fastFlib.hs
fastFib = fst $ fibPair

-- fibonacci.hs
fibonacci :: (Num a) => a -> a
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- flip2.hs
flip' :: (a->b->c) ->b->a->c
flip' f = \x y -> f y x

-- function.hs
f:: Num a=> a->a
f x = 4*x+1

-- function1.hs
f' :: Num a => a->a->a
f' x y = 4*x+5*y+1

-- function2.hs
f'' :: Num a => a->a
f'' y = 4 *5+5 *y +1

-- hailun.hs
s::Double -> Double -> Double ->Double
s a b c = let p = (a+b+c)/2 in sqrt (p*(p-a)*(p-b)*(p-c))

-- hailun1.hs
s' :: Double->Double->Double->Double
s' a b c = sqrt(p*(p-a)*(p-b)*(p-c))
         where p = (a+b+c) /2

-- if.hs
isTwo :: Int->Bool
isTwo n = if n==2 then True else False

-- isUpperAlphanum.hs
isUpperAlphaum :: Char -> Bool
isUpperAlphaum = (`elem` ['A'..'Z'])

-- Lambda.hs
addThree :: (Num a) => a->a->a->a
addThree = \x -> \y -> \z -> x+y+z

-- largestDivisible.hs
largestDivisible:: (Integral a) =>a
largestDivisible = head (filter p [100000,99999..])
                 where p x = x `mod` 3829 == 0

-- listCom.hs
boomBangs xs = [if x<10 then "BOOM!" else "BANG!"| x<-xs,odd x]

-- lucky.hs
lucky::(Integral a) => a-> String
lucky 7 = "LUCKY NUMBER SEVEN"
lucky x = "Sorry,you're out of luck,pal!"

-- maximum.hs
maximum' :: (Ord a) => [a] -> a
maximum' [] = error "maximum of empty list"
maximum' [x] = x
maximum' (x:xs)
        | x > maxTail = x
        | otherwise = maxTail
        where maxTail = maximum' xs

-- maximum1.hs
maximum' :: (Ord a) => [a] -> a
maximum' [] = error "maximum of empty list"
maximum' [x] = x
maximum' (x:xs) = max x  (maximum' xs)

-- mcf.hs
mc n | n> 100 = n - 10
     | otherwise = mc (mc(n+11))

-- multiThree.hs
multThree :: (Num a) => a->a->a->a
multThree x y z = x * y * z

-- myCompare.hs
myCompare :: (Ord a) => a-> a->Ordering
a `myCompare` b
    | a > b = GT
    | a == b = EQ
    | otherwise = LT

-- mygcd.hs
mygcd :: Int -> Int ->Int
mygcd x y = if y == 0 then x else mygcd y (mod x y)

-- mylen.hs
length' xs = sum [1|_ <-xs]

-- numLongChains.hs
numLongChains::Int
numLongChains = length(filter (\xs -> length xs > 15)(map chain[1..100]))

-- pmatch.hs
charName :: Char -> String
charName 'a' = "Albert"
charName 'b' = "Broseph"
charName 'c' = "Cecil"

-- power.hs
power :: Int -> Int -> Int
power _ 0 = 1
power x n = x * power x (n-1)

-- power1.hs
power1 :: Int -> Int -> Int
power1 _ 0 =1
power1 x n | odd n = let p = power x ((n-1) `div` 2) in x * p * p
           | otherwise = let p = power x (n `div` 2) in p * p

-- quicksort.hs
quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
  let smallerSorted = quicksort [a|a <- xs,a <= x]
      biggerSorted = quicksort [a|a<-xs,a > x]
  in smallerSorted ++ [x] ++ biggerSorted

-- reNoUpper.hs
removeNonUppercase :: [Char] -> [Char]
removeNonUppercase st = [c|c <- st,c `elem` ['A'..'Z']]

-- repeat.hs
repeat' :: a-> [a]
repeat' x = x:repeat' x

-- replicate.hs
replicate' :: (Num i, Ord i) => i -> a -> [a]
replicate' n x
    | n <= 0 = []
    | otherwise = x:replicate' (n-1) x

-- reverse.hs
reverse' :: [a] -> [a]
reverse' [] = []
reverse' (x:xs) = reverse' xs ++ [x]

-- reverseSentence
reverseSentence::String->String
--reverseSentence str = unwords (reverse (words str))--
--reverseSentence str = unwords $ reverse $ words str--
reverseSentence = unwords $ reverse $ words

-- romeNatation.hs
romeNotation :: [String]
romeNotation =  ["M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"]
romeAmount :: [Int]
romeAmount = [1000,900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
pair:: [(Int,String)]
pair = zip romeAmount romeNotation
subtrahend :: Int -> (Int,String)
subtrahend n = head (dropWhile(\(a,_)->a >n)pair)
convert :: Int -> (Int,String)
convert 0 = (0,"")
convert n = let (i,st) = subtrahend n in
    let (i',st') = convert(n-i) in (i',st++st')

-- selfcylinder.hs
cylinder :: (RealFloat a) => a->a->a
cylinder r h =
    let sideArea = 2 * pi * r * h
        topArea = pi *r ^ 2
    in sideArea + 2 * topArea

-- selffst.hs
first :: (a,b,c) ->a
first (x,_,_) = x

second :: (a,b,c) -> b
second (_,y,_) = y

third :: (a,b,c) -> c
third (_,_,z) = z

-- selfguard.hs
bmiTell :: (RealFloat a) => a -> String
bmiTell bmi
    | bmi <= 18.5 = "a"
    | bmi <= 25.0 = "b"
    | bmi <= 30.0 = "c"
    | otherwise = "d"

-- selfinit.hs
initials :: String -> String -> String
initials a b = (show a) ++ (show b)

-- selflen.hs
length' xs = sum[1 |_ <- xs]
removeNonUppercase st = [c|c<-st,c `elem` ['A'..'Z']]

-- selfeng.hs
length' :: (Num b) => [a] -> b
length' [] = 0
length' (_:xs) = 1 + length' xs

-- selfsum.hs
sum' :: (Num a) => [a] -> a
sum' [] = 0
sum' (x:xs) = x + sum' xs

-- selftanhao.hs
tanhao ::(Int a) => [a]->a->b
tanhao [xs] a = take a+1 [xs]

-- selfwhere.hs
bmiTell :: (RealFloat a) => a->a->String
bmiTell weight height
    | bmi <= skinny = "a"
    | bmi <= normal = "b"
    | bmi <= fat = "c"
    | otherwise = "d"
    where bmi = weight / height ^ 2
          skinny = 18.5
          normal = 25.0
          fat = 30.0

-- selfwherefun.hs
calBmis :: (RealFloat a) => [(a,a)] -> [a]
calBmis xs = [bmi w h|(w,h)<-xs]
    where bmi weight height = weight / height ^ 2

-- sieve.hs
{-shaixuanfa-}
sieve :: (Integral a) => [a] -> [a]
sieve (p:xs) = p:sieve[x|x<-xs,x `mod` p /= 0]
primes = sieve [2..]

-- sum2.hs
sum2:: (Num a) => [a] -> a
sum2 xs = foldl(\acc x -> acc + x) 0 xs

-- tailre.hs
total' [] n = n
total' (x:xs) n = total' xs (n+x)
total' xs = total' xs 0

-- take.hs
take' :: (Num i,Ord i) => i -> [a] -> [a]
take' n _
      | n <= 0 = []
take' _ [] = []
take' n (x:xs) = x: take' (n-1) xs

-- tellfirst.hs
tell :: (Show a) => [a] ->String
tell [] = "This list is empty"
tell (x:[]) = "This list has one element: " ++ show x
tell (x:y:[]) = "This list has two elements: "++ show x ++ "and" ++ show y
tell (x:y:_) = "This list is long.the first two elements are:" ++ show x ++ "and" ++ show y

-- types.hs
removeNonUppercase :: [Char] -> [Char]
removeNonUppercase st = [c|c <- st,c `elem` ['A'..'Z']]
addThree :: Int -> Int -> Int -> Int
addThree x y z = x+y+z
factorial :: Integer -> Integer
factorial n = product [1..n]
circumference :: Float -> Float
circumference r = 2 *pi *r
circumference' :: Double -> Double
circumference' r = 2*pi*r

-- undefined.hs
undefined :: a
undefined = error "Prelude;undefined"

-- values.hs
a::Int
a = 5
b:: Bool
b = False

-- zip.hs
zip' :: [a] -> [b] -> [(a,b)]
zip' _ [] = []
zip' [] _ = []
zip' (x:xs)(y:ys) = (x,y):zip' xs ys

-- zipWith.hs
zipWith' :: (a->b->c) -> [a] -> [b] -> [c]
zipWith' _ [] _ []
zipWith' _ _ [] = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys