line.hs

module Line (Line(..), extract, left, right, allfocuses, neighbourhood, mean, onsides, makelist, st_makelist, smoothmean, smoothwith) where

import Data.Maybe

data Line a = Line [a] a [a] deriving (Eq, Show)

instance Functor Line where
	fmap f (Line ls a rs) = Line (map f ls) (f a) (map f rs)

extract :: Line a -> a
extract (Line _ a _) = a

left :: Line a -> Maybe (Line a)
left line@(Line [] x rs) = Nothing
left (Line (l:ls) x rs) = Just $ Line ls l (x:rs)

right :: Line a -> Maybe (Line a)
right line@(Line ls x []) = Nothing
right (Line ls x (r:rs)) = Just $ Line (x:ls) r rs

allfocuses :: Line a -> Line (Line a)
allfocuses line = Line (tail $ makelist left line) line (tail $ makelist right line)

neighbourhood :: Int -> Line a -> Line a
neighbourhood n (Line ls x rs) = Line (take n ls) x (take n rs)

mean :: Fractional a => Int -> Line a -> a
mean n line = go $ neighbourhood n line
	where go (Line ls x rs) = (sum (ls ++ [x] ++ rs)) / (fromIntegral $ length (ls ++ [x] ++ rs))

onsides :: (a -> Maybe a) -> (a -> b) -> a -> [b]
onsides next f = tail . map f . makelist next

makelist :: (a -> Maybe a) -> a -> [a]
makelist next x = x : case next x of
	Nothing -> []; Just y -> makelist next y

st_makelist :: s -> (s -> Maybe (a, s)) -> [a]
st_makelist s f = case f s of
	Nothing -> []; Just (x, y) -> x : st_makelist y f

smoothmean :: Fractional a => Int -> Line a -> Line a
smoothmean n line@(Line ls x rs) = mean n <$> allfocuses line

smoothwith :: (Line a -> a) -> Line a -> Line a
smoothwith f line = f <$> allfocuses line