[HackerRank] [haskell]刷题记录

Haskell功力太弱了，刷一下HackerRank上面的Haskell题目(同时在读Haskell函数式编程入门第二版)，都记录在这个博客里面。
链接
目标：满分

---

Easy

List Replication

f :: Int -> [Int] -> [Int]
f n arr  = -- Complete this functio
    case arr of
    (fir:aft) -> (helper n fir) ++ (f n aft)
    _ -> []
    
helper  :: Int -> Int -> [Int] 
helper n fir 
    | n > 0 = fir : helper (n-1) fir
    | n == 0 = []

        
-- This part handles the Input and Output and can be used as it is. Do not modify this part.
main :: IO ()
main = getContents >>=
       mapM_ print. (\(n:arr) -> f n arr). map read. words

Filter Array

f :: Int -> [Int] -> [Int]
f n (fir:aft)  --Fill up this function
    | fir < n = fir : f n aft
    | otherwise = f n aft
f n [] = []
    
-- The Input/Output section. You do not need to change or modify this part
main = do 
    n <- readLn :: IO Int 
    inputdata <- getContents 
    let 
        numbers = map read (lines inputdata) :: [Int] 
    putStrLn . unlines $ (map show . f n) numbers

Filter Positions in a List

f :: [Int] -> [Int]
f [] = []-- Fill up this Function
f (x : (y : ys)) = y : f ys
f (x : xs) = xs

-- This part deals with the Input and Output and can be used as it is. Do not modify it.
main = do
	inputdata <- getContents
	mapM_ (putStrLn. show). f. map read. lines $ inputdata

Array Of N Elements

fn n 
    | n > 0 = 1 : fn (n-1)
    | otherwise = []

main = do
n <- readLn :: IO Int
print (fn(n))

Reverse a List

rev (x : xs) = (rev xs) ++ [x]
rev [] = []

Lambda Calculus - Reductions #1

这是个问答题...
((λx.(x y))(λz.z))
把x替换为(λz.z))
就是(λz.z)y
applicate y，得到y

Lambda Calculus - Reductions #2

((λx.((λy.(x y))x))(λz.w))
((λy.((λz.w) y))(λz.w))
反正往下最左结合，得到w

Lambda Calculus - Evaluating Expressions #1

4

Lambda Calculus - Evaluating Expressions #2

6

Functions or Not?

难度飙升
只需要值域和定义域一一对应即可，但是实现也不简单
值得注意的是
tuple仍然属于Ord的范畴，所以里面嵌套了一个快排的标准实现

quickSort :: Ord a => [a] -> [a]
quickSort [] = []  
quickSort (x:xs) =   
  let smallSort  = quickSort [a | a <- xs, a < x]  
      biggerSort = quickSort [a | a <- xs, a > x]  
   in smallSort ++ [x] ++ biggerSort

isFunc :: [(Int, Int)] -> Bool
isFunc [] = True
isFunc ((x1,x2):xs) 
    | xs == [] = True
    | (x1 == (fst (head xs))) && (x2 /= (snd (head xs)))  = False
    | otherwise = isFunc xs

tuplify :: [Int] -> [(Int, Int)]
tuplify [] = []
tuplify (x:y:xs) = (x,y):(tuplify xs)

solveOne :: [Int] -> String
solveOne xs 
    | isFunc $ quickSort $ tuplify xs = "YES"
    | otherwise = "NO"
    
-- splitAT 分割剩下的数组 splitAt :: Int -> [a] -> ([a], [a])

solve :: [Int] -> [String]
solve [] = []
solve (n:xs) = (solveOne f):(solve s)
            where (f, s) = splitAt (2*n) xs

-- unlines [String] -> String 转换数组为一个String
-- words 则为其反运算     String -> [String]
-- tail 用于去掉不需要的输入
-- read 用于类型转换
-- interact 从标准输入读入，处理后从标准输出写入

main = interact $ unlines . solve . map read . tail . words

-- main =  unlines . solve . map read . tail . words

Sum of Odd Elements

f ::[Int] -> Int
f [] = 0
f arr  -- Fill up this function body
    | odd $ head $ arr = (head arr) + (f $ tail arr)
    | otherwise = f $ tail arr
    
-- This part handles the Input/Output and can be used as it is. Do not change or modify it.
main = do
	inputdata <- getContents
	putStrLn $ show $ f $ map (read :: String -> Int) $ lines inputdata

List Length

len :: [a] -> Int
len lst = length lst

Update List

-- Enter your code here. Read input from STDIN. Print output to STDOUT
f [] = []
f (x:xs)  -- Complete this function here
    | x < 0 = (-x):(f xs)
    | otherwise = x : (f xs)
-- This section handles the Input/Output and can be used as it is. Do not modify it.
main = do
	inputdata <- getContents
	mapM_ putStrLn $ map show $ f $ map (read :: String -> Int) $ lines inputdata

Area Under Curves and Volume of Revolving a Curve

import Text.Printf (printf)

-- This function should return a list [area, volume].
solve :: Double -> Double -> [Double] -> [Double] -> [Double]
solve left right coeffs expnts = [area, volume]
    where
        step = 0.001
        domain = [left, left+step..right]
        bigF x = sum $ zipWith (\c e -> c*x**e) coeffs expnts
        area = sum . map (*step) . map bigF $ domain
        volume = sum . map (*step) . map (\r -> pi*r**2) . map bigF $ domain
--Input/Output.
main :: IO ()
main = getContents >>= mapM_ (printf "%.1f\n"). (\[a, b, [l, r]] -> solve l r a b). map (map read. words). lines

Compute the Perimeter of a Polygon

-- Enter your code here. Read input from STDIN. Print output to STDOUT

solvehandler (a:b:xs) = solve ([a,b] ++ xs ++ [a,b])

solve :: [Int] -> Double
solve [] = 0.0
solve [a,b] = 0.0
solve (a:b:c:d:xs) = (solve $ c:d:xs) +  (sqrt $ fromIntegral $ x'*x' + y'*y')
    where
      x' = c - a
      y' = d - b


main = interact $ show . solvehandler . map read . tail . words

Compute the Area of a Polygon

多边形计算面积 —— 但是是函数式
本来想的是通过外面的四边形的面积减去每个小三角形，没想到这种只适合凸多边形。。。

-- 适合凸多边形的面积计算
-- Enter your code here. Read input from STDIN. Print output to STDOUT
import Data.List
import Data.Ord
solvehandler (a:b:xs) = solve ([a,b] ++ xs ++ [a,b])

abs a
    | a > 0 = a
    | otherwise = -a

intToTuple :: [Int] -> [(Int, Int)]
intToTuple [] = []
intToTuple [a,b] = [(a,b)]
intToTuple (a:b:c) = (a,b):(intToTuple c)

calcuteBlankArea :: [Int] -> Double
calcuteBlankArea [] = 0.0
calcuteBlankArea [a,b] = 0.0
calcuteBlankArea (a:b:c:d:xs) = (calcuteBlankArea $ c:d:xs) +  (Main.abs $ fromIntegral $ (div (x*y)  2))
    where
      x = c - a
      y = d - b


solve :: [Int] -> Double
solve [] = 0.0
solve ls =  (fromIntegral total) - (calcuteBlankArea ls)
    where
      transTuple = intToTuple ls
      minx = snd $ (maximumBy (comparing snd) transTuple)
      maxx = snd $ minimumBy (comparing snd) transTuple
      miny = fst $ maximumBy (comparing fst) transTuple
      maxy = fst $ minimumBy (comparing fst) transTuple
      total = ((maxx - minx) * (maxy - miny))


main = interact $ show . solvehandler . map read . tail . words

正确答案：

main = interact $ show . solve . lines

solve :: [String] -> Double
solve (x:xs) = abs . fst $ foldl accFun (0, last points) points
    where
        n = read x :: Int
        points = map ((\[a,b] -> (read a, read b)) . words ) $ take n xs :: [(Double, Double)]
        
        areaUnder (a,b) (c,d) = (a-c) * abs (b+d) / 2

        accFun = \(accVal, lastPoint) currPoint -> (accVal + (areaUnder lastPoint currPoint), currPoint)

Fibonacci Numbers

--Contributed by Ron Watkins
module Main where


fib n  -- Enter your code here to complete this function
 | n == 1 = 0
 | n == 2 = 1
 | otherwise = fib(n-1) + fib(n-2)

-- This part is related to the Input/Output and can be used as it is
-- Do not modify it
main = do
    input <- getLine
    print . fib . (read :: String -> Int) $ input

Pascal’s Triangle

杨辉三角的下一行输出可以表示为
0：上一行
上一行：0
的加和

solve :: Int -> [[Int]]
solve 1 = [[1]]
solve 2 = solve 1 ++ [[1,1]]
solve n = solve (n-1) ++ [zipWith (+) (0:(last . solve $ (n-1))) ((last . solve $ (n-1)) ++ [0])]

main = interact $ unlines . map unwords . map (\xs -> [ show x | x <- xs ]) . solve . read

String Mingling

-- Enter your code here. Read input from STDIN. Print output to STDOUT

solve :: [String] ->  [String]
solve [f,s] = 
    zipWith (\a b ->  [a,b]) f s
    
main = interact $ filter (\a -> a/=' ') . unwords . solve  . words

String Compression

-- Enter your code here. Read input from STDIN. Print output to STDOUT

import Data.List

solve :: [String] ->  String
solve  []  = [] 
solve  (x:xs) 
    | length x > 1 =  [head x] ++ (show (length x)) ++ solve xs
    | otherwise = [head x]  ++ solve xs
    
main = interact $  solve . group

String-o-Permute

-- Enter your code here. Read input from STDIN. Print output to STDOUT


solve :: String -> String
solve [] = []
solve (x:y:xs) = [y,x] ++ solve xs

main = interact $  unlines . map solve . tail . words

prefix compression

showLen :: [Char] -> String
showLen = unwords . sequence [show . length, id]

prefixLength :: Eq a => ([a], [a]) -> Int
prefixLength = length . takeWhile id . uncurry (zipWith (==))

prefixCompression :: Eq a => [a] -> [a] -> ([a], [a], [a])
prefixCompression xs ys = let p = prefixLength (xs, ys) in (take p xs, drop p xs, drop p ys)

main = do
    x <- getLine
    y <- getLine
    let (p, x', y') = prefixCompression x y in do
        putStrLn $ showLen p
        putStrLn $ showLen x'
        putStrLn $ showLen y'

Medium

先是练习α β η 规约的几道题目（貌似没η）η就是point-free了

Lambda Calculus - Reductions #3

beta规约下式：
((λx.(x x))(λx.(x x))) 
一眼顶针，鉴定为不动点
CAN'T REDUCE

Lambda Calculus - Reductions #4

规约这个
(λg.((λf.((λx.(f (x x)))(λx.(f (x x))))) g)) 
得到
λg.(((((g (λx.(g (x x) λx.(g (x x)))))))
一眼顶针，鉴定为不动点
CAN'T REDUCE

Lambda Calculus - Evaluating Expressions #3

此题询问丘奇编码下下列数的值
λx.λy.x47y
这是个丘奇数表示的基本问题
Church数0, 1, 2, ...在lambda演算中被定义如下：
0 ≡ λf.λx. x
1 ≡ λf.λx. f x
2 ≡ λf.λx. f (f x)
3 ≡ λf.λx. f (f (f x))

所以这题是47

Lambda Calculus - Evaluating Expressions #4

Compute the value of λx.λy.x(xy).
2

Lambda Calculus - Evaluating Expressions #5

Compute the value of λx.λy.x(xy).
0
这几个题都是丘奇数的入门

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

Hard

List Replication

f :: Int -> [Int] -> [Int]
f n arr  = -- Complete this functio
    case arr of
    (fir:aft) -> (helper n fir) ++ (f n aft)
    _ -> []
    
helper  :: Int -> Int -> [Int] 
helper n fir 
    | n > 0 = fir : helper (n-1) fir
    | n == 0 = []

        
-- This part handles the Input and Output and can be used as it is. Do not modify this part.
main :: IO ()
main = getContents >>=
       mapM_ print. (\(n:arr) -> f n arr). map read. words

Filter Array

f :: Int -> [Int] -> [Int]
f n (fir:aft)  --Fill up this function
    | fir < n = fir : f n aft
    | otherwise = f n aft
f n [] = []
    
-- The Input/Output section. You do not need to change or modify this part
main = do 
    n <- readLn :: IO Int 
    inputdata <- getContents 
    let 
        numbers = map read (lines inputdata) :: [Int] 
    putStrLn . unlines $ (map show . f n) numbers

Filter Positions in a List

f :: [Int] -> [Int]
f [] = []-- Fill up this Function
f (x : (y : ys)) = y : f ys
f (x : xs) = xs

-- This part deals with the Input and Output and can be used as it is. Do not modify it.
main = do
	inputdata <- getContents
	mapM_ (putStrLn. show). f. map read. lines $ inputdata

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication

List Replication