Haskell D'hont

data.json

[
  { "name": "PP", "votes": 563292, "rel": 34.55, "seats": 21},
  { "name": "AhoraMadrid", "votes": 519210, "rel": 31.85, "seats": 20},
  { "name": "PSOE", "votes": 249152, "rel": 15.28, "seats": 9},
  { "name": "Cs", "votes": 186059, "rel": 11.41, "seats": 7},
  { "name": "UPyD", "votes": 29823, "rel": 1.83, "seats": 0 },
  { "name": "IU", "votes": 27869, "rel": 1.71, "seats": 0 },
  { "name": "VOX", "votes": 9843, "rel": 0.60, "seats": 0 },
  { "name": "PACMA", "votes": 9601, "rel": 0.59, "seats": 0}
]

Dhont.hs

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Dhont
  ( dhont
  , Entry
  , entries
  ) where

import           Data.Aeson
import qualified Data.ByteString.Lazy as BL
import           Data.Maybe           (fromJust)
import           GHC.Generics


import           Control.Arrow        (second)
import           Control.Monad        (join)
import           Data.List            (sortBy)
import qualified Data.Map.Strict      as Map
import           Data.Ord             (comparing)

data Entry = Entry
  { name  :: String
  , votes :: Integer
  } deriving (Show, Eq, Generic)

instance FromJSON Entry
instance ToJSON Entry


entries :: [Entry]
entries = fromJust $ decode "[{ \"name\": \"PP\", \"votes\": 563292, \"rel\": 34.55, \"seats\": 21},{ \"name\": \"AhoraMadrid\", \"votes\": 519210, \"rel\": 31.85, \"seats\": 20},{ \"name\": \"PSOE\", \"votes\": 249152, \"rel\": 15.28, \"seats\": 9},{ \"name\": \"Cs\", \"votes\": 186059, \"rel\": 11.41, \"seats\": 7},{ \"name\": \"UPyD\", \"votes\": 29823, \"rel\": 1.83, \"seats\": 0 },{ \"name\": \"IU\", \"votes\": 27869, \"rel\": 1.71, \"seats\": 0 },{ \"name\": \"VOX\", \"votes\": 9843, \"rel\": 0.60, \"seats\": 0 },{ \"name\": \"PACMA\", \"votes\": 9601, \"rel\": 0.59, \"seats\": 0}]"

-- La primera estrategia que se va a realizar es construir la tabla
-- según que aparece en el algoritmo original. La tabla tendrá una
-- dimensión de el número de partidos por tantos cocientes como
-- escaños a repartir.
--
-- La conjunto de los cocientes es:
--           { q_i = Votes / i | i \in [1..escaños]}
--
--
-- Para esta estregia, podríamos generar la tabla completa, ordenarla,
-- y tomar los n escaños a repartir.
--
-- Me gustaría saber si podemos optimizar esta fórmula y lograr un
-- mejor rendimiento tanto en memoria como en
-- ejecución. Fundamentalmente, aprovechándonos de la evaluación
-- perezosa en Haskell.

quotients :: Integer -> [Integer]
quotients v = map (div v) [1..]

-- La limitación del número de cocientes se introduce en la generación
-- de la tabla, aunque en las próxmas estrategias se puede tratar de
-- retrasar todo lo posible.

table :: [Entry] -> Int -> [[(String, Integer)]]
table entries seats = map row entries
  where
    nQuotients :: Entry -> [Integer]
    nQuotients = take seats . quotients . votes

    row :: Entry -> [(String, Integer)]
    row entry = map ((,) (name entry)) (nQuotients entry)

    {- Se ha simplificado la función zipWith para convertirla
     en un map.

        zipWith (,) (repeat $ name entry) (nQuotients entry)

    Cuando zipWith tiene el mismo valor para el primer argumento
    de la operación binaria (que recibe dos argumentos), es
    equivalente a un map con la operación binaria parcialmente
    aplicada.

    zipWith :: (a -> b -> c) ->     [a]     ->     [b]     -> [c]
                    (,)        (repeat name)   (nQuotients)

    map ::  (b -> c)  ->      [b]     -> [c]
           ((,) name)    (nQuotients)


    Al aplicar la función a cada entrada, generamos una lista de
    listas, equivalente a una tabla. Se puede aplanar con:

                foldr (++) [] :: [[a]] -> [a]

    El problema que tiene hacer (++) es que estamos recorriendo la
    lista completa para hacer el append.

    Se puede tomar la vía de las Mónadas, que nos sirve para
    hacer un `flatten`:

                join :: m (m a) -> m a

    Pero la pregunta es, ¿nos importa el orden de la tabla aplanada?
    ¿Qué otras opciones hay para aplanar una lista?


    El detalle final es que podemos convertir esta tabla ajustada al
    número de asientos en una tabla infinita elimintando simplemente
    nQuotients y dejando la lista de cocientes sin acotar. La tabla
    sería infinita, pero enumerable.
    -}

calc :: [Entry] -> Int -> [(String, Integer)]
calc entries seats = take seats $ sortBy (flip $ comparing snd) flatEntries
  where
    flatEntries :: [(String, Integer)]
    flatEntries = join $ table entries seats


{- Una vez tenemos la lista ordenada de a quién le corresponden los
   escaños, solo tenemos que contar cuántas veces sale cada nombre.

   Podemos acumular los datos en un Map. (Hashmap)

   La ordenación de las tuplas de debe hacer según el segungo valor,
   que es el número de votos. Además, queremos ordenarla de mayor a
   menor cantidad de votos.
-}

partySeats :: [Entry] -> Int -> Map.Map String Integer
partySeats entries seats = Map.fromListWith (+) hasSeat
  where
    hasSeat :: [(String, Integer)]
    hasSeat = map (second (const 1)) $ calc entries seats

{- Lo único que nos quedaría añadir sería el umbral. -}

dhont :: Double -> [Entry] -> Int -> Map.Map String Integer
dhont threshold entries seats = partySeats (filter aboveThreshold entries) seats
  where
    totalVotes :: Integer
    totalVotes = sum $ map votes  entries

    voteThreshold :: Integer
    voteThreshold = floor $ (fromInteger totalVotes) * threshold

    aboveThreshold :: Entry -> Bool
    aboveThreshold entry = voteThreshold < votes entry


{-             ¿Qué es lo siguiente?

    1. Hacer el algoritmo completamente lazy
    2. Comparativas de rendimiento (benchmarks)

-}

Main.hs

module Main where

import           Dhont                (Entry, dhont)

import           Data.Aeson
import qualified Data.ByteString.Lazy as BL
import           Data.Map.Strict      as Map
import           System.Environment
import           System.Exit

main :: IO ()
main = do
  (t:s:f:[]) <- getArgs
  let threshold = read t :: Double
  let seats = read s :: Int
  contents <- BL.readFile f
  case decode contents :: Maybe [Entry] of
    Just entries -> putStrLn . show $ dhont threshold entries seats
    Nothing      -> putStrLn "Error while parsing data..."
  return ()