Solució examen parcial Maig 2017

examen.hs

-- 1.1

shuffleOnce :: [a] -> [a]
shuffleOnce xs = ys'
    where
        n = length xs
        (l1, l2) = splitAt (n `div` 2) xs
        ys = concat $ zipWith pair l2 l1
        pair a b = [a, b]
        ys' 
           | even n     = ys
           | otherwise  = ys ++ [last xs]


-- 1.2

shuffleBack :: Eq a => [a] -> Int
shuffleBack xs = succ $ length $ takeWhile (/= xs) $ tail $ iterate shuffleOnce xs


-- 2.1

segments :: Ord a => [a] -> [[a]] 
segments = foldr f []
    where 
        f x [] = [[x]]
        f x ((z:zs):ys) 
            | x <= z    = (x:z:zs):ys 
            | otherwise = [x]:(z:zs):ys


-- 2.2

mergeSegments :: Ord a => [[a]] -> [[a]]
mergeSegments = map merge' . lists 

lists :: [[a]] -> [[[a]]] 
lists [] = []
lists [x] = [[x, []]]         
lists (x1:x2:xs) = [x1, x2]:lists xs

merge' :: Ord a => [[a]] -> [a]
merge' [xs, ys] = merge xs ys 

merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
    | x <= y    = x:merge xs (y:ys)
    | otherwise = y:merge (x:xs) ys  


-- 2.3

mergeSort :: Ord a => [a] -> [a]
mergeSort = head . head . dropWhile (not . size1) . iterate mergeSegments . segments
    where
        size1 [x] = True
        size1 _ = False  

-- 3.1

data FExpr a = Const a | Func String [FExpr a]
    deriving (Show)


-- 3.2

flatten :: FExpr a -> FExpr a 
flatten (Const x) = Const x
flatten (Func f xs) = Func f $ concat $ map (transform . flatten) xs
    where
        transform (Const x) = [Const x]
        transform (Func g ys)
            | f == g    = ys
            | otherwise = [Func g ys]


-- 3.3

instance (Eq a) => Eq (FExpr a) where
    e1 == e2 = equals (flatten e1) (flatten e2)

equals :: (Eq a) => FExpr a -> FExpr a -> Bool
equals (Const x) (Const y) = x == y
equals (Func f xs) (Func g ys) = f == g && perm xs ys
equals _ _ = False

perm :: (Eq a) => [FExpr a] -> [FExpr a]-> Bool
perm xs ys = all (\e -> count e xs == count e ys) xs

count :: (Eq a) => FExpr a -> [FExpr a] -> Int
count e = length . filter (== e) 

Ara que ho torno a veure, perm podria ser sobre [a] ennloc de [FExpr a] i count sobre a enlloc de FExpr a.