Lehmer.hs

Lehmer.hs

module Books where

import qualified Data.Aeson as Aeson
import Data.List (elemIndex, uncons, unfoldr)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Vector (Vector, (!))
import qualified Data.Vector as Vector

encodeLehmer :: forall a. (Eq a) => Vector a -> [a] -> [Int]
encodeLehmer set =
  unfoldr
    ( fmap
        ( \(x, xs) ->
            ( x,
              map
                ( \y ->
                    if y > x
                      then pred y
                      else y
                )
                xs
            )
        )
        . uncons
    )
    . mapMaybe (`Vector.elemIndex` set)

decodeLehmer :: forall a. Vector a -> [Int] -> [a]
decodeLehmer set =
  map (set !)
    . foldl (\acc n -> n : map (\m -> if m >= n then m + 1 else m) acc) []
    . reverse

getBooks :: String -> IO (Maybe (Vector (Map String String)))
getBooks filename =
  fmap (Vector.fromList . List.sortOn (Map.lookup "title")) <$> Aeson.decodeFileStrict filename

codeSortedLehmerCode :: Vector (Map String String) -> [Int]
codeSortedLehmerCode books = encodeLehmer books (List.sortOn (Map.lookup "code") (Vector.toList books))

factorials :: [Integer]
factorials = snd (List.mapAccumL alg 1 [1 ..])
  where
    alg :: Integer -> Integer -> (Integer, Integer)
    alg a b = (a * b, a)

fromFactorial :: [Int] -> Integer
fromFactorial = sum . zipWith (*) factorials . reverse . map fromIntegral

toFactorial :: Integer -> [Int]
toFactorial n0 = reverse (unfoldr alg (n0, 1))
  where
    alg :: (Integer, Integer) -> Maybe (Int, (Integer, Integer))
    alg (n, m) =
      let (n', r) = quotRem n m
       in if n == 0
            then Nothing
            else Just (fromIntegral r, (n', m + 1))

formatBigNum :: Integer -> String
formatBigNum =
  List.intercalate ","
    . reverse
    . List.unfoldr (\ns -> if null ns then Nothing else Just (List.splitAt 3 ns))
    . reverse
    . show