packages feed

majority-1.0: test/Properties.hs

module Main (main) where

import Algorithms.Majority (majority)
import Data.Function (on)
import Data.List (group, maximumBy, partition)
import Data.Map (empty, insertWith, toList)
import Test.QuickCheck (quickCheck)

verify :: Eq a => a -> [a] -> Maybe a
verify can xs | length ys > length zs = Just can
              | otherwise             = Nothing

  where

    (ys, zs) = partition (== can) xs

maximumByWeight :: [(a, Int)] -> a
maximumByWeight = fst . maximumBy (compare `on` snd)

majority_map :: Ord a => [a] -> Maybe a
majority_map xs = verify can xs

  where

    acc = foldr (\ x -> insertWith (+) x 1) empty xs

    can = maximumByWeight (toList acc)

majority_group :: Eq a => [a] -> Maybe a
majority_group xs = verify can xs

  where

    acc = [ (head ys, length ys) | ys <- group xs ]

    can = maximumByWeight acc

prop_majority_map :: [Int] -> Bool
prop_majority_map xs = majority xs == majority_map xs

prop_majority_group :: [Int] -> Bool
prop_majority_group xs = majority xs == majority_group xs

main =
  do
    quickCheck prop_majority_map
    quickCheck prop_majority_group