Estructuras II TP 2 ListSeq.hs

import Par
import Seq

tabulateSaux :: (Int -> a) -> Int -> Int -> [a]
tabulateSaux f nat valor = if valor == nat
                              then []
                              else let (tx, txs) = (f valor) ||| (tabulateSaux f nat (valor + 1))
                                   in tx : txs

contraerS :: (a -> a -> a) -> [a] -> [a]
contraerS f [] = []
contraerS f [x] = [x]
contraerS f (x:y:xs) = let (xyC, xsC) = (f x y) ||| (contraerS f xs)
                       in xyC : xsC

expandirS :: (a -> a -> a) -> [a] -> [a] -> Int -> [a]
expandirS f [] [] idx = []
expandirS f [x] [x'] idx = [x']
expandirS f s@(x:y:xs) s'@(x':xs') idx = if (mod idx 2) == 0
                                             then x' : (expandirS f s s' (idx + 1))
                                             else let (head, tail) = (f x' x) ||| (expandirS f xs xs' (idx + 1))
                                                  in head : tail

instance Seq [] where
    emptyS = []


    singletonS x = [x]


    lengthS [] = 0
    lengthS (x:xs) = 1 + lengthS xs


    -- Suponemos nos dan un índice válido.
    nthS (x:xs) 0 = x
    nthS (x:xs) n = nthS xs (n - 1)


    mapS f [] = []
    mapS f (x:xs) = let (mx, mxs) = (f x) ||| (mapS f xs) in mx : mxs


    tabulateS f nat = tabulateSaux f nat 0


    filterS f [] = []
    filterS f (x:xs) = let (fx, fxs) = (f x) ||| (filterS f xs) in
                       if fx then x : fxs else fxs


    appendS = (++)


    takeS [] _ = []
    takeS xs 0 = []
    takeS (x:xs) n = x : (takeS xs (n - 1))


    dropS [] _ = []
    dropS xs 0 = xs
    dropS (x:xs) n = dropS xs (n - 1)


    showtS [] = EMPTY
    showtS [x] = ELT x
    showtS xs = let mitad = div (lengthS xs) 2
                    (mitad1, mitad2) = (takeS xs mitad) ||| (dropS xs mitad)
                in NODE mitad1 mitad2


    showlS [] = NIL
    showlS (x:xs) = CONS x xs


    joinS xs = [elem | listaElem <- xs, elem <- listaElem]


    reduceS f base [] = base
    reduceS f base [x] = f base x
    reduceS f base xs = reduceS f base (contraerS f xs)


    scanS f base [] = (singletonS base, base)
    scanS f base [x] = (singletonS base, f base x)
    scanS f base xs = let xsC = contraerS f xs
                          (xsSeq, xsRed) = scanS f base xsC
                      in (expandirS f xs xsSeq 0, xsRed)

    fromList xs = xs