对千人书一些习题的实现(话说haskell的格式好恶心啊= = 虽然没太大限制, 但是一旦出错很难找出到底是哪里的缩进出了问题..老是这个问题, 而且有时候缩进没问题, 弄半天不知道哪里错了, 重新打一遍又好了..

直接安装

brew cask install haskell-platform

配置环境

在sublime中直接安装SublimeHaskell
最后界面如下

funny examples

发现lazy evaluation 太强了….如下, 写个lazy recursion的菲波那切数列

fib = 1 : 1 : [a + b| (a,b) <- zip fib (tail fib)]
take 100 fib
fib300 = fib !! 300
fib

测试如下, take前100项

直接输入fib, 就无限evaluate了

这个情况和

aList = [1,2..]
aList

一致

下面是对haskell-tutorial的一些笔记

import Data.List
import System.IO
List
take 3 list
drop 3 list
[x | x <- [1..500], x <= 100]

zipWith (+) list list
filter (>5) morePrimes
takeWhile (<=20) [2,4..] -- lazy means--
foldl (*) 1 [2,3,4,5]
foldr (*) 1 [2,3,4,5]

pow3List = [3^n | n <- [1..10]]
multTable = [[x * y| y <- [1..10]] | x <- [1..10]] 

randTuple = (1, "Random Tuple")

bobSmith = ("Bob Smith", 52)

bobsName = fst bobSmith

bobsAge = snd bobSmith

names = ["Bob", "Mary", "Tome"]
address = ["123 Main", "234 North", "567 South"]

namesNAdress = zip names address
-- combine them into a tuple --

let num7 = 7
let getTriple x = x * 3
-- function definetion--
getTriple num7

main = do
    putStrLn "What's your name"
    name <- getLine -- function --
    putStrLn ("Hello" ++ name)
-- several sentences --

addMe :: Int -> Int -> Int

-- funcName param1 param2 = 
-- operations(returned value) 
addMe x y = x + y

sumMe x y = x + y
-- work with float also

addTuples :: (Int,Int) -> (Int, Int) -> (Int, Int)

addTuples (x,y) (x2,y2) = (x + x2, y + y2)

whatAge :: Int -> String

whatAge 16 = "you can drive"
whatAge 18 = "you can vote"
whatAge 21 = "you're an adult"
whatAge x = "Nothing Important"

factorial :: Int -> Int

factorial 0 = 1
factorial n = n * factorial (n - 1)

-- 3 * factorial(2)
-- 2 * factorial(1)

isOdd :: Int -> Bool

isOdd n
    | n `mod` 2 == 0 = False
    | otherwise = True

isEven n = n `mod` 2 == 0

whatGrade :: Int -> String

whatGrade age
    | (age >= 5) && (age <= 6) = "Kindergarten"
    | (age > 6) && (age <= 10) = "primary school"
    | (age > 10) && (age <= 14) = "middle school"
    | (age > 14) && (age <= 18) = "High school"
    | otherwise = "Go to college"

batAvgRating :: Double -> Double -> String

batAvgRating hits at atBats
    | avg <= 0.200 = "Terrible Batting Average"
    | avg <= 0.250 = " Average Player"
    | avg <= 0.280 = "Your doing pretty good"
    | otherwise = "You're a superstar"
    where avg = hits / atBats

getListItems :: [Int] -> String

getListItems [] = "your list is empty"
getListItems (x:[]) = "Your list starts with" ++ show x
getListItems (x:y:[]) = "Your list starts with" ++ show x ++ "and" ++ show y
getListItems (x:xs) = "Your list starts with" ++ show x ++ "and" ++ show xs

getFirstItem :: String -> String

getFirstItem [] = "the list is empty"
getFirstItem all@(x:xs) = "The first letter in " ++ all ++ "is" ++ [x]

-- higher order function

times4 :: Int -> Int
times4 x = x * 4

listTimes4 = map times4 [1,2,3,4]

mulBy4 :: [Int] -> [Int]
mulBy4 [] = []
mulBy4 (x:xs) = times4 x : multBy 4 xs

areStringsEq :: [Char] -> [Char] -> Bool
areStringsEq [] [] = True
areStringEq (x:xs) (y:ys) = x == y && areStringEq xs ys
-- areStingsEq "Hello" "Hello You"

doMult :: (Int -> Int) -> Int
doMult func = func 3
num3Times4 = doMult times4

getAddFunc :: Int -> (Int -> Int)
getAddFunc x y = x + y
adds3 = getAddFunc 3
fourPlus = adds3 4
threePlusList = map adds3 [1,2,3,4,5]

-- lambda 
dbl1To10 = map (\x -> x * 2) [1..10]

< > <= >= == /=
&& || not

doubleEvenNumber y =
    if (y `mod` 2 /= 0)
        then y
       else y * 2

getClass :: Int -> String
getClass n = case n of
    5 -> "Go to kindergarten"
    6 -> "Go to elementary school"
    _ -> "Go away"

-- module
module SampFunction (getClass, doubleEvenNumber) where

import SampFunction

-- self-defined data structure
data BaseballPlayer = Pitcher 
                                | cather
                                | Infielder
                                | Outfield
                        deriving Show
print(String)

data Customer = Customer String String Double deriving Show
tomSmith :: Customer
tomSmith = Customer "Tom Smith" " 123 Main " 20.50

getBalance :: Customer -> Double
getBalance (Customer _ _ b) = b

--
data RPS = Rock | Paper | Scissors
shoot :: RPS -> RPS -> String
shoot Paper Rock = "Papers beats Rock"
shoot Rock Scissors = "Rock beats Scissors"
shoot Rock Paper = "Rock beats Paper"
shoot _ _ = "Error"

data Shape = Circle Float Float Float | Rectangle Float Float deriving Show
area :: Shape -> Float 
area (Circle _ _ r) = pi * r ^ 2
area (rectangle x y x2 y2 ) = 

sumValue = putStrLn (show ( 1 + 2))

samValue = putStrLn . show $ 1 + 2


-- type classes
(+) Num :t (+)
data Employee = Employee { name :: String,
                                           position :: String,
                                           idNum :: Int
                                           }deriving (Eq,Show)

data ShirtSize = S | M | L
instance Eq ShirtSize where
        S == S = True
        M == M = True
        L == L = True
        _ == _ = False
instance Show ShirtSize where
        show S = "Small"
        show M = "Medium"
        show L = "Large"
smallAvail = S `elem` [S,M,L]

theSize = show S 

class MyEq a where
    areEqual :: a -> a -> Bool

instance MyEq ShirtSize where    areEqual S S = True
  areEqual M M = True
  areEqual L L = True
  areEqual _ _ = False

newSize = areEqual M M

-- say
sayHello = do
    putStrLn "What's your name"
    name <- getLine
    putStrLn "hello" ++ name

writeToFile = do
    theFile <- openFile "text.txt" WriteMode
    hPutStrLn theFile ("Random line of Text")
    hClose theFile

readFromFile = do
    theFile2 <- openFile "text.txt" ReadMode
    contents <- hGetContents theFile2
    putStr contents
    hClose theFile2

-- fib
fib = 1 : 1 : [a + b | (a,b) <- zip fib (tail fib)]


Hamitower :: Int -> Int -> Int -> String

Hamitower 1 x y = do
    putStrLn ("Moving" ++ x ++ "to" ++ y)
Hamitower x y z = do
    Hamitower x-1 y (6 - y - z)
    putStrLn ("Moving" ++ y ++ "to" ++ z) 
    Hamitower x-1 (6-y-z) z

list one

  • convert dec to binary
dec2bi :: Integer -> String
dec2bi 0 = show 0
dec2bi n = dec2bi (n `div` 2) ++ (show (n `rem` 2))
solveProblemBi n = tail $ dec2bi n
-- convert dec to binary
  • convert dec to rome
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]

rome :: [(Int, String)]
rome = zip romeAmount romeNotation

romeString :: Int -> (Int, String)
romeString n = head $ dropWhile (\(a,_) -> a > n) rome


toRome :: Int -> String
toRome 0 = "" 
toRome n = let (n1,s1) = romeString n in 
           let      s  = toRome (n-n1) in (s1 ++ s)
  • convert rome to dec
toDec :: String -> Int
toDec s = fst $ (filter (\(_,s1) -> s1 == s) rome) !! 0

--romeToDec :: String -> Int
--romeToDec "" = 0
--romeToDec (s1:s2:ss) = romeToDec ss + fst $ ((break (\(_,a) -> a == s1 || a == (s1:s2)) rome) !! 1) !! 0
  • hanio
hanioHelper :: Int -> Int -> Int -> Int -> [(Int,Int)]
hanioHelper 0 from to via = []
hanioHelper n from to via = hanioHelper (n-1) from via to ++ [(from,to)] 
                            ++ hanioHelper (n-1)  via to from 

hanio n = hanioHelper n 1 2 3
  • fastFib
fastFib :: Int -> [Int]
fastFib n = take n $ map fst $ iterate (\(a,b) -> (b,a+b)) (0,1)
  • fib converge to golden number??
toGolden :: Int -> [Double]
toGolden n = take n $ map (\(a,b) -> a/b) $ iterate (\(a,b) -> (b,a+b)) (0,1)

fibGoldenEx :: Int -> [Double]
fibGoldenEx n = map (\a -> (golden-a)/golden) $ take n $ map (\(a,b) -> a/b) $ iterate (\(a,b) -> (b,a+b)) (0,1) where
             golden = abs $ (1 - sqrt 5)/2
  • hamming number
merge :: [Int] -> [Int]
merge [] = []
merge (x:xs) | x `elem` xs = merge xs 
             | otherwise   = x : merge xs

hamming :: [Int]
hamming = 1 : merge ham
          where ham1 = map (*2) hamming
                ham2 = map (*3) hamming
                ham3 = map (*5) hamming 
                ham  = ham1 ++ ham2 ++ ham3
  • quick sort
qSort :: [Int] -> [Int]
qSort [] = []
qSort (x:xs) = qSort mini ++ [x] ++ qSort maxi
  where mini = filter (<x) xs
        maxi = filter (>=x) xs
  • insert sort
insert :: Int -> [Int] -> [Int]
insert x [] = [x] 
insert x (x1:xs) | x < x1    = x:x1:xs
                 | otherwise = x1 : insert x xs 

insertSort :: [Int] -> [Int]
insertSort x = foldr insert [] x
  • pop sort
pop :: [Int] -> [Int]
pop [] = []
pop [x] = [x]
pop (x1:x2:xs) | x1 < x2   = x1 : pop (x2:xs)
               | otherwise = x2 : pop (x1:xs)

popSort :: [Int] -> [Int]
popSort [] = []
popSort x = pop delLast ++ [lastOne]
    where poped   = pop x
          lastOne = last poped
          delLast = init poped
------

list two

  • tree generation
data Tree = Leaf | Node Tree Tree deriving Show

trees :: Int -> [Tree]
trees 0 = [Leaf]
trees n = [Node lr ll | l <- [0..n-1], lr <- trees l, ll <- trees (n-1-l)]

--catalan number

treesLength :: Int -> Int
treesLength = length . trees

-- tree array
treegroup n = map treesLength [0..n-1] 

-- brace tree
brace :: Tree -> String
brace Leaf = ""
brace (Node l r) = '(' : brace l ++ ")" ++ brace r
  • bottle solve
bottle :: Int -> Int -> Int
bottle x y | resX >= 1 = resX + bottle (x - resX ) (y + resX)
           | resY >= 1 = resY + bottle (x + resY ) (y - resY * 3)
           | otherwise = 0
           where  resX = x `div` 2
                  resY = y `div` 4

bottleSolve :: Int -> Int                   
bottleSolve n = nx + bottle nx ny 
           where nx = n `div` 2
                 ny = n `div` 2   

bottleList :: Int -> [Int]
bottleList n = map bottleSolve [0,2..n]
  • huffman tree
-- huffTree

data Htree a = Leaf1 a | Branch (Htree a) (Htree a) deriving Show

a = [(0.4,'a'),(0.1,'b'),(0.2,'c'),(0.3,'d')]

-- construct the tree
htree [(_,t)] = t
htree ((w1,t1):(w2,t2):ws) = htree $ insertBy (comparing fst) (w1+w2, Branch t1 t2) ws

-- decode the tree
serize (Leaf1 a) = [(a, "")]
serize (Branch l r) =  [(char, '1' : code ) | (char, code) <- serize r  ] ++
                    [(char, '0' : code ) | (char, code) <- serize l  ]

--sovle the huffman

huffman ws = sortBy (comparing $ length . snd) $ 
             serize $ htree $ map (\(x1,y1) -> (x1, Leaf1 y1)) $
             sortBy (comparing fst) ws