apportionment 0.0.0.3 → 0.0.0.4

raw patch · 5 files changed

+199/−7 lines, 5 filesdep +QuickCheckdep +apportionmentdep +doctest-exitcode-stdiodep ~basedep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, apportionment, doctest-exitcode-stdio, doctest-lib

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• Makefile +8/−0
• apportionment.cabal +21/−5
• src/Math/Apportionment.hs +51/−2
• test/Main.hs +11/−0
• test/Test/Math/Apportionment.hs +108/−0

@@ -0,0 +1,8 @@+run-test:	update-test+	runhaskell Setup configure --user --enable-tests+	runhaskell Setup build+	runhaskell Setup haddock+	runhaskell Setup test apportionment-test --show-details=streaming++update-test:+	doctest-extract-0.1 -i src/ -o test/ --import-tested --executable-main=Main.hs Math.Apportionment

@@ -1,12 +1,12 @@ Name:                apportionment-Version:             0.0.0.3+Version:             0.0.0.4 Synopsis:            Round a set of numbers while maintaining its sum Description:   Round a set of numbers while maintaining its sum.   According procedures are used to assign seats to parties in a parliament.   You may also use it to round percentages that sum up to 100%.   <https://en.wikipedia.org/wiki/Apportionment_(politics)>-Homepage:            http://hub.darcs.net/thielema/apportionment+Homepage:            https://hub.darcs.net/thielema/apportionment License:             BSD3 License-File:        LICENSE Author:              Henning Thielemann@@ -14,15 +14,17 @@ Category:            Math Build-Type:          Simple Cabal-Version:       >=1.10+Extra-Source-Files:+  Makefile  Source-Repository this-  Tag:         0.0.0.3+  Tag:         0.0.0.4   Type:        darcs-  Location:    http://hub.darcs.net/thielema/apportionment+  Location:    https://hub.darcs.net/thielema/apportionment  Source-Repository head   Type:        darcs-  Location:    http://hub.darcs.net/thielema/apportionment+  Location:    https://hub.darcs.net/thielema/apportionment  Library   Exposed-Modules:     Math.Apportionment@@ -33,3 +35,17 @@   Hs-Source-Dirs:      src   Default-Language:    Haskell2010   GHC-Options:         -Wall++Test-Suite apportionment-test+  Type:             exitcode-stdio-1.0+  Default-Language: Haskell2010+  GHC-Options:      -Wall+  Hs-source-dirs:   test+  Main-Is:          Main.hs+  Other-Modules:    Test.Math.Apportionment+  Build-Depends:+    apportionment,+    doctest-exitcode-stdio >=0.0 && <0.1,+    doctest-lib >=0.1 && <0.2,+    QuickCheck >=2 && <3,+    base

@@ -18,6 +18,16 @@ import Data.Ord.HT (comparing, )  +{- $setup+>>> import Control.Applicative ((<$>))+>>> import qualified Test.QuickCheck as QC+>>>+>>> forAllNonNegatives ::+>>>    (Num a, Ord a, Show a, QC.Arbitrary a) => ([a] -> Bool) -> QC.Property+>>> forAllNonNegatives = QC.forAll $+>>>    (map QC.getNonNegative <$> QC.arbitrary) `QC.suchThat` (\xs -> sum xs > 0)+-}+ {- | Like 'largestRemainder' but result values are sorted with respect to descending fractional parts of the inputs.@@ -33,6 +43,12 @@           List.sortBy (comparing (negate.snd)) intFracs    in  map (1+) intUps ++ intDowns +-- ToDo: generalize to Traversable++-- ToDo: require NonEmpty++-- ToDo: It would be safer to use Integer+ {- | This function rounds values such that the sum of the rounded values@@ -42,6 +58,14 @@ <https://en.wikipedia.org/wiki/Largest_remainder_method>  Input values must be non-negative, otherwise 'properFraction' bites us.++>>> largestRemainder [1,2,3::Rational]+[1,2,3]+>>> largestRemainder [1.1,2.2,3.3,4.4::Rational]+[1,2,3,5]++prop> \xs -> xs == largestRemainder (map fromIntegral xs :: [Rational])+prop> forAllNonNegatives $ \xs -> round (sum xs) == sum (largestRemainder (xs :: [Rational])) -} largestRemainder :: (RealFrac a) => [a] -> [Int] largestRemainder = largestRemainderCore . fractions@@ -50,8 +74,16 @@ @largestRemainderScaled s xs@ scales and rounds the values in @xs@ such that their sum becomes @s@. -E.g. @largestRemainderScaled 100 [1,2,3]@-returns integral percentages proportional to 1:2:3.+>>> largestRemainderScaled 100 [1,2,3::Rational]+[17,33,50]++That is, it returns integral percentages almost proportional to 1:2:3.++>>> largestRemainderScaled 100 [1,10,100::Rational]+[1,9,90]++prop> forAllNonNegatives $ \xs -> xs == largestRemainderScaled (sum xs) (map fromIntegral xs :: [Rational])+prop> \(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (largestRemainderScaled s (xs :: [Rational])) -} largestRemainderScaled :: (RealFrac a) => Int -> [a] -> [Int] largestRemainderScaled s = largestRemainderCore . fractionsScaled s@@ -89,6 +121,22 @@ In @highestAveragesScaled divs s xs@, @divs@ must be an infinite list of strictly increasing positive numbers. E.g. @highestAveragesScaled dHondtDivisors s xs@ runs the d'Hondt method.++>>> highestAveragesScaled dHondtDivisors 100 [1,2,3::Rational]+[17,33,50]+>>> highestAveragesScaled dHondtDivisors 100 [1,10,100::Rational]+[0,9,91]++>>> highestAveragesScaled sainteLagueDivisors 100 [1,2,3::Rational]+[17,33,50]+>>> highestAveragesScaled sainteLagueDivisors 100 [1,10,100::Rational]+[1,9,90]++prop> forAllNonNegatives $ \xs -> xs == highestAveragesScaled dHondtDivisors (sum xs) (map fromIntegral xs :: [Rational])+prop> forAllNonNegatives $ \xs -> xs == highestAveragesScaled sainteLagueDivisors (sum xs) (map fromIntegral xs :: [Rational])++prop> \(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (highestAveragesScaled dHondtDivisors s (xs :: [Rational]))+prop> \(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (highestAveragesScaled sainteLagueDivisors s (xs :: [Rational])) -} highestAveragesScaled :: (RealFrac a) => [a] -> Int -> [a] -> [Int] highestAveragesScaled divs s xs =@@ -98,6 +146,7 @@        take s $ Fold.foldl (ListHT.mergeBy (compose2 (>=) snd)) [] $        Map.mapWithKey (map . (,)) $ outerProduct (/) m divs +-- ToDo: use Stream dHondtDivisors :: Num a => [a] dHondtDivisors = iterate (1+) 1 

@@ -0,0 +1,11 @@+-- Do not edit! Automatically created with doctest-extract.+module Main where++import qualified Test.Math.Apportionment+import qualified Test.QuickCheck as QC++import qualified Test.DocTest.Driver as DocTest++main :: IO ()+main = DocTest.runWith QC.stdArgs{QC.maxSuccess=3000} $ do+    Test.Math.Apportionment.test

@@ -0,0 +1,108 @@+-- Do not edit! Automatically created with doctest-extract from src/Math/Apportionment.hs+{-# LINE 21 "src/Math/Apportionment.hs" #-}++module Test.Math.Apportionment where++import Math.Apportionment+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 22 "src/Math/Apportionment.hs" #-}+import     Control.Applicative ((<$>))+import     qualified Test.QuickCheck as QC++forAllNonNegatives     ::+       (Num a, Ord a, Show a, QC.Arbitrary a) => ([a] -> Bool) -> QC.Property+forAllNonNegatives     = QC.forAll $+       (map QC.getNonNegative <$> QC.arbitrary) `QC.suchThat` (\xs -> sum xs > 0)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Math.Apportionment:67: "+{-# LINE 67 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 67 "src/Math/Apportionment.hs" #-}+     (\xs -> xs == largestRemainder (map fromIntegral xs :: [Rational]))+ DocTest.printPrefix "Math.Apportionment:68: "+{-# LINE 68 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 68 "src/Math/Apportionment.hs" #-}+     (forAllNonNegatives $ \xs -> round (sum xs) == sum (largestRemainder (xs :: [Rational])))+ DocTest.printPrefix "Math.Apportionment:62: "+{-# LINE 62 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 62 "src/Math/Apportionment.hs" #-}+   (largestRemainder [1,2,3::Rational])+  [ExpectedLine [LineChunk "[1,2,3]"]]+ DocTest.printPrefix "Math.Apportionment:64: "+{-# LINE 64 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 64 "src/Math/Apportionment.hs" #-}+   (largestRemainder [1.1,2.2,3.3,4.4::Rational])+  [ExpectedLine [LineChunk "[1,2,3,5]"]]+ DocTest.printPrefix "Math.Apportionment:85: "+{-# LINE 85 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 85 "src/Math/Apportionment.hs" #-}+     (forAllNonNegatives $ \xs -> xs == largestRemainderScaled (sum xs) (map fromIntegral xs :: [Rational]))+ DocTest.printPrefix "Math.Apportionment:86: "+{-# LINE 86 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 86 "src/Math/Apportionment.hs" #-}+     (\(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (largestRemainderScaled s (xs :: [Rational])))+ DocTest.printPrefix "Math.Apportionment:77: "+{-# LINE 77 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 77 "src/Math/Apportionment.hs" #-}+   (largestRemainderScaled 100 [1,2,3::Rational])+  [ExpectedLine [LineChunk "[17,33,50]"]]+ DocTest.printPrefix "Math.Apportionment:82: "+{-# LINE 82 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 82 "src/Math/Apportionment.hs" #-}+   (largestRemainderScaled 100 [1,10,100::Rational])+  [ExpectedLine [LineChunk "[1,9,90]"]]+ DocTest.printPrefix "Math.Apportionment:135: "+{-# LINE 135 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 135 "src/Math/Apportionment.hs" #-}+     (forAllNonNegatives $ \xs -> xs == highestAveragesScaled dHondtDivisors (sum xs) (map fromIntegral xs :: [Rational]))+ DocTest.printPrefix "Math.Apportionment:136: "+{-# LINE 136 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 136 "src/Math/Apportionment.hs" #-}+     (forAllNonNegatives $ \xs -> xs == highestAveragesScaled sainteLagueDivisors (sum xs) (map fromIntegral xs :: [Rational]))+ DocTest.printPrefix "Math.Apportionment:138: "+{-# LINE 138 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 138 "src/Math/Apportionment.hs" #-}+     (\(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (highestAveragesScaled dHondtDivisors s (xs :: [Rational])))+ DocTest.printPrefix "Math.Apportionment:139: "+{-# LINE 139 "src/Math/Apportionment.hs" #-}+ DocTest.property+{-# LINE 139 "src/Math/Apportionment.hs" #-}+     (\(QC.Positive s) -> forAllNonNegatives $ \xs -> s == sum (highestAveragesScaled sainteLagueDivisors s (xs :: [Rational])))+ DocTest.printPrefix "Math.Apportionment:125: "+{-# LINE 125 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 125 "src/Math/Apportionment.hs" #-}+   (highestAveragesScaled dHondtDivisors 100 [1,2,3::Rational])+  [ExpectedLine [LineChunk "[17,33,50]"]]+ DocTest.printPrefix "Math.Apportionment:127: "+{-# LINE 127 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 127 "src/Math/Apportionment.hs" #-}+   (highestAveragesScaled dHondtDivisors 100 [1,10,100::Rational])+  [ExpectedLine [LineChunk "[0,9,91]"]]+ DocTest.printPrefix "Math.Apportionment:130: "+{-# LINE 130 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 130 "src/Math/Apportionment.hs" #-}+   (highestAveragesScaled sainteLagueDivisors 100 [1,2,3::Rational])+  [ExpectedLine [LineChunk "[17,33,50]"]]+ DocTest.printPrefix "Math.Apportionment:132: "+{-# LINE 132 "src/Math/Apportionment.hs" #-}+ DocTest.example+{-# LINE 132 "src/Math/Apportionment.hs" #-}+   (highestAveragesScaled sainteLagueDivisors 100 [1,10,100::Rational])+  [ExpectedLine [LineChunk "[1,9,90]"]]