Difference between revisions of "FP Solution"

From Marek Běhálek Wiki
Jump to navigation Jump to search
 
(14 intermediate revisions by the same user not shown)
Line 1: Line 1:
 
<syntaxhighlight lang="Haskell">
 
<syntaxhighlight lang="Haskell">
import Data.Char
 
 
 
fact1 :: Int -> Int
 
fact1 :: Int -> Int
 
fact1 0 = 1
 
fact1 0 = 1
 
fact1 n = n * fact1 (n-1)
 
fact1 n = n * fact1 (n-1)
  
fact2 :: Int -> Int
+
</syntaxhighlight>
fact2 n | n==0 = 1
 
        | otherwise = n * fact2 (n-1)
 
  
fact3 :: Int -> Int       
 
fact3 n = if n==0 then 1 else n * fact3 (n-1)
 
  
fib :: Int -> Int
+
<div class="mw-collapsible mw-collapsed" data-collapsetext="Hide solution" data-expandtext="Show solution">
fib 0 = 0
+
Some text in the div here.
fib 1 = 1
+
<syntaxhighlight lang="Haskell">
fib n = tmp n 0 1 where
+
fact1 :: Int -> Int
  tmp 1 _ b = b
+
fact1 0 = 1
  tmp x a b = tmp (x-1) b (a+b)
+
fact1 n = n * fact1 (n-1)
  
gcd' :: Int -> Int -> Int
+
</syntaxhighlight>
gcd' a b | a > b = gcd' (a-b) b
+
Some more text in the div.
        | a < b = gcd' a (b-a)
+
</div>
        | a==b = a
 
  
gcd2 :: Int -> Int -> Int       
+
<div style="clear:both;"></div>
gcd2 a 0 = a
 
gcd2 a b = gcd2 b (a `mod` b)
 
  
isPrime :: Int -> Bool
+
<div class="toccolours mw-customtoggle-myList">Show solution</div>
isPrime 1 = False
 
isPrime y = isPrimeTest y (ceiling (sqrt (fromIntegral y)::Double))
 
  where
 
  isPrimeTest _ 1 = True
 
  isPrimeTest n x | n `mod` x ==0 = False
 
                  | otherwise = isPrimeTest n (x-1)
 
  
length' :: [a] -> Int
+
<div class=" mw-collapsible mw-collapsed" id="mw-customcollapsible-myList">
length' []  = 0
+
Some text in the div here.
length' (_:xs) = 1 + length' xs
+
<syntaxhighlight lang="Haskell">
 +
fact1 :: Int -> Int
 +
fact1 0 = 1
 +
fact1 n = n * fact1 (n-1)
  
sumIt :: [Int] -> Int
+
</syntaxhighlight>
sumIt []  = 0
+
Some more text in the div.
sumIt (x:xs) = x + sumIt xs
+
</div>
 
 
getHead :: [a] -> a
 
getHead (x:_) = x
 
 
 
getLast :: [a] -> a
 
getLast (x:xs) | length xs == 0 = x
 
              | otherwise = getLast xs
 
 
 
isElement :: Eq a => a -> [a] -> Bool
 
isElement _ [] = False
 
isElement a (x:xs) | a == x = True
 
                  | otherwise = isElement a xs
 
                 
 
getTail :: [a] -> [a]                 
 
getTail (_:xs) = xs
 
 
 
getInit :: [a] -> [a]
 
getInit [_] = []
 
getInit (x:xs) = x : getInit xs
 
 
 
combine :: [a] -> [a] -> [a]
 
combine [] y = y
 
combine (x:xs) y = x : combine xs y
 
 
 
max' :: [Int] -> Int
 
max' [x] = x
 
max' (x:y:z) | x > y = max' (x:z)
 
            | otherwise = max' (y:z)
 
 
 
max2 :: [Int] -> Int
 
max2 (y:ys) = tmp y ys where
 
  tmp a [] = a
 
  tmp a (x:xs) | x > a = tmp x xs
 
                |otherwise = tmp a xs
 
 
 
reverse' :: [a] -> [a]           
 
reverse' [] = []
 
reverse' (x:xs) = (reverse' xs) ++ [x]
 
 
 
reverse'' :: [a] -> [a]
 
reverse'' n = tmp n  []
 
  where tmp [] ys = ys
 
        tmp (x:xs) ys = tmp xs (x:ys)
 
 
 
take' :: Int -> [a] -> [a]
 
take' 0 _ = []
 
take' _ [] = []
 
take' n (x:xs) = x: take' (n-1) xs
 
 
 
drop' :: Int -> [a] -> [a]
 
drop' 0 x = x
 
drop' _ [] = []
 
drop' n (_:xs) = drop' (n-1) xs
 
 
 
minimum' :: Ord a => [a] -> a -- Is this right?
 
minimum' [x] = x
 
minimum' (x:y:z) | x < y = minimum' (x:z)
 
                | otherwise = minimum' (y:z)
 
 
 
divisors :: Int -> [Int]
 
divisors n = tmp n where
 
  tmp 0 = []
 
  tmp x | n `mod` x == 0 = x: tmp (x-1)
 
        | otherwise = tmp (x-1)
 
 
 
divisors' :: Int -> [Int]
 
divisors' n =  filter (\x -> n `mod` x == 0) [1..n]
 
 
 
divisors'' :: Int -> [Int]
 
divisors'' n =  [x | x<-[1..n], n `mod` x == 0]
 
 
 
zipThem:: [a] -> [b] -> [(a,b)]
 
zipThem (x:xs) (y:ys) = (x,y) : zipThem xs ys
 
zipThem _ _ = []
 
 
 
dotProduct :: [a] -> [b] -> [(a,b)]
 
dotProduct [] _ = []
 
dotProduct (x:xs) ys = tmp ys ++ dotProduct xs ys where
 
  tmp [] = []
 
  tmp (b:bs) = (x,b) : tmp bs
 
 
 
dotProduct' :: [a] -> [b] -> [(a,b)] 
 
dotProduct' xs ys = [(x,y)|x<-xs, y<-ys]
 
 
 
dotProduct'' :: [a] -> [b] -> [(a,b)]
 
dotProduct'' x y =
 
  zip (concat (map (replicate (length y)) x))
 
                    (concat (replicate (length x) y))
 
 
 
 
 
fibonacci :: Int -> Int
 
fibonacci n = fst (tmp n) where
 
  fibStep (a,b) = (b,a+b)
 
  tmp 0 = (0,1)
 
  tmp x = fibStep (tmp (x-1))
 
 
 
allToUpper :: String -> String
 
allToUpper xs = [toUpper x |x<-xs]                   
 
 
 
allToUpper' :: String -> String
 
allToUpper' xs = map toUpper xs
 
 
 
quicksort :: (Ord a) => [a] -> [a]
 
quicksort (x:xs) = let lp = filter (< x) xs
 
                      rp = filter (>= x) xs
 
                  in quicksort lp ++ [x] ++ quicksort rp
 
 
 
oddList :: Int -> Int -> [Int]
 
oddList a b = [ x |x<-[a..b], odd x]
 
 
 
removeAllUpper :: String -> String
 
removeAllUpper xs = [ x |x<-xs, not (isUpper x)]
 
 
 
union :: Eq a => [a] -> [a] -> [a]
 
union xs ys = xs ++ [y| y<-ys, not (elem y xs)]
 
 
 
intersection ::  Eq a =>  [a] -> [a] -> [a]
 
intersection xs ys = [y| y<-ys, elem y xs]
 
 
 
unique :: String -> String
 
unique n = reverse(tmp n "") where
 
  tmp [] store = store
 
  tmp (x:xs) store | x `elem` store = tmp xs store
 
                  | otherwise = tmp xs (x:store)
 
 
 
unique' :: String -> String                 
 
unique' [] = []
 
unique' (x:xs) = x: unique' (filter (/=x)xs)
 
 
 
countThem :: String -> [(Char, Int)]
 
countThem xs = let u = unique xs
 
              in [(x, length (filter (==x) xs)) |x<-u]
 
 
 
isPrime :: Int -> Bool
 
isPrime n = null [x |x<-[2..ceiling (sqrt (fromIntegral n)::Double)], n `mod` x == 0]
 
 
 
goldbach :: Int-> [(Int, Int)]
 
goldbach n = let primes = [x |x<-[2..(n `div` 2)+1], isPrime x]
 
            in [(x,n-x) |x<-primes, isPrime (n-x)]
 
 
 
goldbachList :: Int -> Int-> Int -> [(Int, Int)]
 
goldbachList a b limit = filter (\(x,_)-> x>limit) [head (goldbach x) | x<-[a..b], even x]
 
 
 
combinations :: Int -> String -> [String]
 
combinations 1 xs = [[x]| x<-xs]
 
combinations n (x:xs) | n == length (x:xs) = [(x:xs)]
 
                      |otherwise = [[x] ++ y |y<-combinations (n-1) xs ]
 
                                    ++ (combinations n xs)
 
 
 
not' :: Bool -> Bool
 
not' True = False
 
not' False = True
 
infixl 5 `not'`
 
 
 
and' :: Bool -> Bool -> Bool
 
and' True True = True
 
and' _ _ = False
 
infixl 4 `and'`
 
 
 
or' :: Bool -> Bool -> Bool
 
or' False False = False
 
or' _ _ = True
 
infixl 3 `or'`
 
 
 
nand' :: Bool -> Bool -> Bool
 
nand' x y = not' (and' x y)
 
infixl 4 `nand'`
 
 
 
xor' :: Bool -> Bool -> Bool
 
xor' x y = x/=y
 
infixl 3 `xor'`
 
 
 
impl' :: Bool -> Bool -> Bool
 
impl' True False = False
 
impl' _ _ = True
 
infixl 2 `impl'`
 
 
 
equ' :: Bool -> Bool -> Bool
 
equ' x y = x == y
 
infixl 7 `equ'`
 
 
 
tablen :: Int -> ([Bool] -> Bool) -> IO ()
 
tablen n f = putStr(concat [show x ++ " -> " ++ show(f x) ++ "\n" |x<-allValues n]) where
 
  allValues 1 = [[True], [False]]
 
  allValues n = [x:y| x<-[True,False], y<-allValues (n-1)]
 
 
 
huffman :: [(Char, Int)] -> [(Char, String)]
 
huffman input = let
 
                    prep = [ (y, [(x,"")] ) | (x,y)<-input]
 
                in sortBy (\ (x,_) (y,_) -> compare x y) (step prep) where
 
                    step :: [(Int, [(Char, String)])] -> [(Char, String)]
 
                    step [(_, result) ] = result
 
                    step list = let ((a1, as2):(b1,bs2):rest) = sortBy (\ (x,_) (y,_) -> compare x y) list
 
                                in step ((a1+b1, [(x,'0':a2)|(x,a2)<-as2]++[(x,'1':b2)|(x,b2)<-bs2])  : rest)
 
 
 
type Pic = [String]
 
 
 
pic :: Pic
 
pic = [ "....#....",
 
        "...###...",
 
        "..#.#.#..",
 
        ".#..#..#.",
 
        "....#....",
 
        "....#....",
 
        "....#####"]
 
 
 
pp :: Pic -> IO ()
 
pp x = putStr (concat (map (++"\n") x))
 
 
 
flipV :: Pic -> Pic
 
flipV = map reverse
 
  
flipV' :: Pic -> Pic
+
<div style="clear:both"></div>
flipV' xs = [reverse x|x<-xs]
 
 
 
flipH :: Pic -> Pic
 
flipH = reverse
 
 
 
above :: Pic -> Pic -> Pic
 
above x y = x ++ y
 
 
 
sideBySide :: Pic -> Pic -> Pic
 
sideBySide xs ys = map (\(x,y) -> x ++ y)(zip xs ys)
 
 
 
sideBySide':: Pic -> Pic -> Pic
 
sideBySide' (x:xs) (y:ys) = (x ++ y) : sideBySide' xs ys
 
sideBySide' _ _ = []
 
 
 
sideBySide'' :: Pic -> Pic -> Pic
 
sideBySide'' = zipWith (++)
 
 
 
toRow :: String -> Pic
 
toRow xs = map (\x -> [x]) xs -- [[x]|x<-xs]
 
 
 
rotateR :: Pic -> Pic
 
rotateR [x] = toRow x
 
rotateR (x:xs) = (rotateR xs) `sideBySide` (toRow x)
 
 
 
rotateR' :: Pic -> Pic
 
rotateR' x = foldl1 sideBySide (reverse (map toRow x))
 
 
 
 
 
rotateL :: Pic -> Pic
 
rotateL [x] = reverse(toRow x)
 
rotateL (x:xs) = reverse(toRow x) `sideBySide` (rotateL xs)
 
 
 
rotateL' :: Pic -> Pic
 
rotateL' x = foldl1 sideBySide (map (reverse.toRow) x)
 
 
 
zoom :: Int -> Pic -> Pic
 
zoom n xs = [concat(map (replicate n) x)|x<-concat (map (replicate n) xs)]
 
 
 
data Expr = Num Int
 
          | Add Expr Expr
 
          | Sub Expr Expr
 
          | Mul Expr Expr
 
          | Div Expr Expr
 
          | Var Char
 
    deriving (Eq)
 
 
 
testExpr1 :: Expr
 
testExpr1 = Sub (Num 1) (Add (Num 2) (Num 3)) 
 
 
 
testExpr2 :: Expr
 
testExpr2 = Add (Mul (Add (Num 1) (Num 2)) (Add (Num 4) (Var 'x')))
 
            (Mul (Num 1) (Var 'x'))
 
         
 
eval :: Expr -> Int
 
eval (Num x) = x
 
eval (Add l r) =  (eval l) + (eval r)
 
eval (Sub l r) =  (eval l) - (eval r)
 
eval (Mul l r) =  (eval l) * (eval r)
 
eval (Div l r) =  (eval l) `div` (eval r)
 
 
 
showExpr :: Expr -> String
 
showExpr expr = showExpr' expr NoOp
 
 
 
data Operation = Hi | HiDiv | Lo | LoSub | NoOp deriving (Eq)
 
 
 
showExpr' :: Expr -> Operation -> String
 
showExpr' (Num x) _ = show x
 
showExpr' (Var x) _ =  [x]
 
showExpr' (Add l r) op = let
 
  x = showExpr' l Lo ++"+"++showExpr' r Lo
 
  in if op == Hi || op == HiDiv || op==LoSub
 
    then "(" ++ x ++")"
 
    else x
 
showExpr' (Sub l r) op = let
 
  x = showExpr' l Lo ++"-"++showExpr' r LoSub
 
  in if op == Hi || op == HiDiv || op==LoSub
 
    then "(" ++ x ++")"
 
    else x   
 
showExpr' (Mul l r) op = let
 
  x = showExpr' l Hi ++"*"++showExpr' r Hi
 
  in if op == HiDiv
 
    then "(" ++ x ++")"
 
    else x
 
showExpr' (Div l r) _ = showExpr' l Hi ++"/"++showExpr' r HiDiv   
 
 
 
instance (Show Expr) where
 
  show = showExpr
 
 
 
deriv :: Expr-> Char -> Expr
 
 
 
deriv (Num _) _ = (Num 0)   
 
deriv (Var x) y | x==y = (Num 1)
 
                | otherwise = (Num 0)
 
deriv (Add l r) x = Add (deriv l x) (deriv r x)               
 
deriv (Sub l r) x = Sub (deriv l x) (deriv r x)
 
deriv (Mul l r) x = Add (Mul (deriv l x) r) (Mul l (deriv r x))
 
deriv (Div l r) x =
 
  Div
 
    (Sub (Mul (deriv l x) r) (Mul l (deriv r x)))
 
    (Mul r r)
 
 
 
data Tree a = Leaf a
 
            | Branch a (Tree a) (Tree a)
 
 
 
testTree :: Tree Int           
 
testTree = Branch 1 (Branch 2 (Leaf 3) (Leaf 4)) (Leaf 5)
 
 
 
sum' :: Tree Int -> Int
 
sum' (Leaf x) = x
 
sum' (Branch x l r) = sum' l + x + sum' r
 
 
 
toList :: Tree a -> [a]
 
toList (Leaf x) = [x]
 
toList (Branch x l r) = toList l ++ [x] ++ toList r
 
 
 
toString :: Show a => Tree a -> String
 
toString (Leaf x) = show x
 
toString (Branch x l r) = show x ++ "(" ++ (toString l) ++ "," ++ (toString r) ++ ")"
 
 
 
</syntaxhighlight>
 

Latest revision as of 10:45, 23 September 2020

fact1 :: Int -> Int
fact1 0 = 1
fact1 n = n * fact1 (n-1)


Some text in the div here.

fact1 :: Int -> Int
fact1 0 = 1
fact1 n = n * fact1 (n-1)

Some more text in the div.

Show solution

Some text in the div here.

fact1 :: Int -> Int
fact1 0 = 1
fact1 n = n * fact1 (n-1)

Some more text in the div.