protocol: polish benchmarks

diff --git a/hjugement-protocol/benchmarks/Election.hs b/hjugement-protocol/benchmarks/Election.hs
index 8106b0dfadb5aa9a39640dfda54962ea3f0e6738..c93e84956c6fd3c262e561ae5a646f165c6f9db1 100644 (file)
--- a/hjugement-protocol/benchmarks/Election.hs
+++ b/hjugement-protocol/benchmarks/Election.hs
@@ -3,6 +3,7 @@ module Election where
 
 import qualified Data.List as List
 import qualified Data.Text as Text
+import qualified Text.Printf as Printf
 
 import Voting.Protocol
 import Utils
@@ -20,14 +21,14 @@ makeElection nQuests nChoices = Election
        (<$> [1..nQuests]) $ \quest -> Question
         { question_text = Text.pack $ "quest"<>show quest
         , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
-        , question_mini = zero
-        , question_maxi = sum $ List.replicate nChoices one
+        , question_mini = one
+        , question_maxi = one -- sum $ List.replicate nChoices one
         }
  } where election_uuid = UUID "xLcs7ev6Jy6FHH"
 
 makeVotes :: Election q -> [[Bool]]
 makeVotes Election{..} =
-       [ [ True | _choice <- question_choices quest ]
+       [ True : List.tail [ False | _choice <- question_choices quest ]
        | quest <- election_questions
        ]
 
@@ -42,10 +43,18 @@ makeBallot elec =
        where
        seed = 0
 
+titleElection :: Election q -> String
+titleElection Election{..} =
+       Printf.printf "(questions=%i)×(choices=%i)==%i"
+        nQuests nChoices (nQuests * nChoices)
+       where
+       nQuests  = List.length election_questions
+       nChoices = List.foldr max 0 $ List.length . question_choices <$> election_questions
+
 benchEncryptBallot :: forall q. Params q => Int -> Int -> Benchmark
 benchEncryptBallot nQuests nChoices =
        env setupEnv $ \ ~elec ->
-               bench ("(nQuests="<>show nQuests<>")*(nChoices="<>show nChoices<>")=="<>show (nQuests * nChoices)) $
+               bench (titleElection elec) $
                        nf makeBallot elec
        where
        setupEnv = do
@@ -55,7 +64,7 @@ benchEncryptBallot nQuests nChoices =
 benchVerifyBallot :: forall q. Params q => Int -> Int -> Benchmark
 benchVerifyBallot nQuests nChoices =
        env setupEnv $ \ ~(elec,ballot) ->
-               bench ("(nQuests="<>show nQuests<>")*(nChoices="<>show nChoices<>")=="<>show (nQuests * nChoices)) $
+               bench (titleElection elec) $
                        nf (verifyBallot elec) ballot
        where
        setupEnv = do
@@ -65,11 +74,10 @@ benchVerifyBallot nQuests nChoices =
 
 benchmarks :: [Benchmark]
 benchmarks =
- -- let inputs = [(1,2), (5,5), (10,5), (5,10){-, (10,6), (10,7), (15,5)-}] in
  let inputs =
         [ (nQ,nC)
-        | nQ <- [1,5,10,15{-,20,25-}]
-        , nC <- [5..7]
+        | nQ <- [1,5,10,15,20,25]
+        , nC <- [5,7]
         ] in
  [ bgroup "WeakParams"
         [ bgroup "encryptBallot"

diff --git a/hjugement-protocol/benchmarks/Utils.hs b/hjugement-protocol/benchmarks/Utils.hs
index a4b0cb3804fdd8c9aab482de3de439c0e81909b9..45eba67b415412c9e0f660450f4b47a21e471572 100644 (file)
--- a/hjugement-protocol/benchmarks/Utils.hs
+++ b/hjugement-protocol/benchmarks/Utils.hs
@@ -16,6 +16,8 @@ module Utils
  , Text
  , Word8
  , Num, Fractional(..), Integral(..), Integer, fromIntegral
+ , min
+ , max
  , Show(..)
  , MonadTrans(..)
  , ExceptT

diff --git a/hjugement-protocol/benchmarks/html/.gitignore b/hjugement-protocol/benchmarks/html/.gitignore
new file mode 100644 (file)
index 0000000..2d19fc7
--- /dev/null
+++ b/hjugement-protocol/benchmarks/html/.gitignore
@@ -0,0 +1 @@
+*.html