gistfile1.hs

module Alternate where

import Control.Arrow (Arrow, (***))
import Test.QuickCheck

-- | Transform a list into a list of pairs.
-- Lazy consumer.
pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y) : pairs (y:z)
pairs _ = []

-- | Transform a pair by applying a function to both elements.
pair :: Arrow a => a b' c' -> a (b', b') (c', c')
pair f = f *** f

-- | True if both elements in a pair satisfy some predicate.
both :: Eq b => (b' -> b) -> (b', b') -> Bool
both f = uncurry (==) . pair f

-- | Applies a predicate to all elements in a list and test whether the
-- results alternate.
--
-- Single traversal, strict consumption. Should short-circuit.
--
-- @alternate even [1,2,3,4] = True@
-- @alternate odd [1,1,1,1] = False@
-- @alternate (const True) [1..] = False@
-- @alternate even [1..] = undefined@
alternate, alternate1, alternate2, alternate3, alternate4 :: (a -> Bool) -> [a] -> Bool
alternate = alternate3

alternate1 p = go . map (p *** p) . pairs
    where
        go [] = True
        go ((x, y):rest) | x == y    = False
                         | otherwise = go rest

alternate2 p = not . any eq . map (p *** p) . pairs
   where eq = uncurry (==)

alternate3 p = not . any eq . pairs
    where eq (x, y) = p x == p y

alternate4 p = not . any (both p) . pairs

prop_alternate_KnownFalse f xs = not (null xs) ==> f (const True) xs == False

simpleTest f = prop_alternate_KnownFalse f [1..200]