Estructuras II TP 2 ArrSeq.hs

import Seq
import qualified Arr as A
import Par

contraerS :: (a -> a -> a) -> A.Arr a -> Int -> A.Arr a
contraerS f arr n = A.tabulate (\i -> if i == (div n 2) then arr A.! (2*i) else f (arr A.! (2*i)) (arr A.! (2*i + 1))) (div (n + 1) 2)


instance Seq A.Arr where
    lengthS = A.length
    tabulateS = A.tabulate
    nthS = (A.!)
    fromList = A.fromList
    joinS = A.flatten


    emptyS = fromList []


    singletonS x = fromList [x]


    takeS arr i = A.subArray 0 i arr


    dropS arr i = A.subArray i ((lengthS arr) - i) arr


    showtS arr = case lengthS arr of
                      0 -> EMPTY
                      1 -> ELT (nthS arr 0)
                      n -> let mitad = div n 2
                               (mitad1, mitad2) = (takeS arr mitad) ||| (dropS arr mitad)
                           in NODE mitad1 mitad2


    showlS arr = case lengthS arr of
                      0 -> NIL
                      n -> let (head, tail) = (nthS arr 0) ||| (dropS arr 1)
                           in CONS head tail


    appendS s t = joinS (fromList [s,t])


    mapS f arr = tabulateS (\i -> f (nthS arr i)) (lengthS arr)


    filterS f arr = joinS (tabulateS (\i -> if f (nthS arr i) then singletonS (nthS arr i) else emptyS) (lengthS arr))


    reduceS f base arr = case lengthS arr of
                               0 -> base
                               1 -> f base (nthS arr 0)
                               n -> reduceS f base (contraerS f arr n)


    scanS f base arr = case lengthS arr of
                            0 -> (singletonS base, base)
                            1 -> (singletonS base, f base (nthS arr 0))
                            n -> let arrC = if mod n 2 == 0 then tabulateS (\i -> f (nthS arr (2*i)) (nthS arr (2*i + 1))) (div n 2)
                                                            else contraerS f arr n
                                     (arrSeq, arrRed) = scanS f base arrC
                                     expansion = tabulateS (\i -> if (mod i 2) == 0 then nthS arrSeq (div i 2) else f (nthS arrSeq (div i 2)) (nthS arr (i-1))) n
                                 in (expansion, arrRed)