Haskell - converting High Order Function to recursive function - haskell

Question

requirement:write function single - Tests whether exactly one element of a list satisfies a given condition.
single :: (a -> Bool) -> [a] -> Bool
I wrote this function:
single p xs = count p xs == 1
where count pred = length . filter pred
Question: What is the easy (correct) way to convert the above functions into one recursive function without using " High Order Functions"?

Answer 1

You can do like that:
single p = lookupFirst
where
lookupFirst [] = False
lookupFirst (x:xs) | p x = lookupSecond xs
| otherwise = lookupFirst xs
lookupSecond [] = True
lookupSecond (x:xs) | p x = False
| otherwise = lookupSecond xs

Answer 2

We can use a none predicate that checks if the remainder of the list does not satisfy the condition:
single :: (a -> Bool) -> [a] -> Bool
single p [] = False
single p (x:xs) | p x = none p xs
| otherwise = single p xs
none :: (a -> Bool) -> [a] -> Bool
none _ [] = True
none p (x:xs) = not (p x) && none p xs
We thus also defined a none function that checks that no element in the given list satisfies a given predicate.
Or without passing the predicate through the recursion:
single :: (a -> Bool) -> [a] -> Bool
single p = helper
where helper [] = False
helper (x:xs) | p x = none xs
| otherwise = helper xs
none [] = True
none (x:xs) = not (p x) && none xs
The above written functions will also immediately stop from the moment a second item is found that satisfies the predicate. This can be useful if we work for instance with an infinite list. If there is a second item that satisfies the constraint, then the function will stop, if no such element or only one such element will ever be generated, we will however get stuck in an infinite loop (there is no much we can do about this). For example:
*Main> single even [1..] -- two or more elements satisfy the constraint
False
*Main> single even [1,3..] -- no element satisfies the constraint
^CInterrupted.
*Main> single even ([1,2]++[3,5..]) -- one element satisfies the constraint
^CInterrupted.

Answer 3

xor and foldl
The most intuitive thing I can thing of is to just fold xor (exclusive or) and your function f thru the list. In case you're not familiar with the binary function xor, it returns True only when (at most) 1 of its arguments are True; otherwise False
xor :: Bool -> Bool -> Bool
xor True b = not b
xor False b = b
single :: (a -> Bool) -> [a] -> Bool
single f [] = False
single f xs = foldl (\acc -> xor acc . f) False xs
main = do
putStrLn $ show (single even []) -- False
putStrLn $ show (single even [1]) -- False
putStrLn $ show (single even [2]) -- True
putStrLn $ show (single even [1,2]) -- True
putStrLn $ show (single even [1,2,3]) -- True
putStrLn $ show (single even [1,2,3,4]) -- False
Xor monoid
xor can be nicely encoded as a Monoid tho, which lends single to a more algebraic implementation using foldMap.
data Xor = Xor Bool
instance Monoid Xor where
mempty = Xor False
mappend (Xor True) (Xor b) = Xor (not b)
mappend (Xor False) (Xor b) = Xor b
single f xs = aux $ foldMap (Xor . f) xs
where
aux (Xor b) = b
main = do
putStrLn $ show (single even []) -- False
putStrLn $ show (single even [1]) -- False
putStrLn $ show (single even [2]) -- True
putStrLn $ show (single even [1,2]) -- True
putStrLn $ show (single even [1,2,3]) -- True
putStrLn $ show (single even [1,2,3,4]) -- False
auxiliary helper
This is another way you can do it with an auxiliary helper. This one has an added benefit in that it exits immediately (stops iteration thru the list) after an answer is determined
single :: (a -> Bool) -> [a] -> Bool
single f xs = aux False f xs
where
aux b f [] = b
aux True f (x:xs) = if (f x) then False else aux True f (xs)
aux False f (x:xs) = aux (f x) f xs
main = do
putStrLn $ show (single even []) -- False
putStrLn $ show (single even [1]) -- False
putStrLn $ show (single even [2]) -- True
putStrLn $ show (single even [1,2]) -- True
putStrLn $ show (single even [1,2,3]) -- True
putStrLn $ show (single even [1,2,3,4]) -- False
feedback welcome!
I'm a Haskell newbie but maybe these ideas are interesting to you. Or maybe they're bad! Leave me a comment if there's anything I can do to improve the answer ^_^