[Haskell-cafe] local mins

Закиров Марат marat61 at gmail.com
Fri Aug 15 19:33:35 UTC 2014


Some time ago we have a discussion and now I am ready to present my
algorithm for counting local mins. It is liniar for imperative case
and in functially too (I hope). I spent hours of debugging on it...

-- | Main entry point to the application.
module Main where

str = [5, 6, 7, 1, 0, 5, 3]

norm :: ([a],[a]) -> ([a],[a])
norm (x,[]) = (take l1 x, take l2 $ reverse x) where l1 = length x `div` 2
    l2 = length x - l1
norm ([],x) = (take l2 $ reverse x, take l1 x) where l1 = length x `div` 2
    l2 = length x - l1
norm x = x

insert :: (Ord a, Show a) => [a] -> Int -> ([(a, Int)],[(a, Int)]) ->
([(a, Int)],[(a, Int)])
insert [] _ x = x
insert x p ([],[]) = ([(head x, p)],[])
insert x p (y,[]) = insert x p (norm (y,[]))
insert x p (ys,z:zs) = if head x >= fst z then (ys,(head x, p):z:zs)
else insert x p (ys,zs)

delete :: (Ord a, Show a) => Int -> Int -> ([(a, Int)],[(a, Int)]) ->
([(a, Int)],[(a, Int)])
False = undefined
delete p r ([],x) = delete p r (norm ([],x))
delete p r (x:xs,y) = if p > (snd x + r) then (xs,y) else (x:xs,y)

getmin :: (Ord a, Show a) => ([(a, Int)],[(a, Int)]) -> a
getmin ([],[]) = error "Getmin error"
getmin ([],x) = getmin (norm ([],x))
getmin (x:xs,y) = fst x

pass :: (Ord a, Show a) => [a] -> [a]
pass [] = []
pass (x:xs) = xs

minn :: Ord a => [a] -> [a] -> [a]
minn x y = []

lmini :: (Ord a, Show a) => Int -> Int -> ([(a, Int)],[(a, Int)]) ->
[a] -> [a] -> [a]
lmini _ _ _ [] _ = []
lmini p r deq c l = if p < r then lmini (p+1) r (insert l p deq) c (pass l)
    else getmin deqn : lmini (p+1) r deqn (pass c) (pass l)
 where deqn = if p < (r*2) then insert l p deq
   else insert l p (delete (p-1) r deq)
lmin :: (Ord a, Show a) => Int -> [a] -> [a]
lmin r x = lmini 0 r ([],[]) x x

main :: IO ()
main = do
    putStrLn "Min for list"
    putStrLn $ show str

-- 
Regards, Marat.
С уважением Марат.


More information about the Haskell-Cafe mailing list