Zompist Bboard Again

Code: Select all

module Main where

import Data.Foldable (traverse_)
import Data.List (group)
import System.IO (hSetBuffering, stdout, BufferMode(..))
import Text.Read (readMaybe)

import Data.IntMap.Strict ((!))
import qualified Data.IntMap.Strict as IM

-- see https://en.wikipedia.org/wiki/Composition_(combinatorics)#Number_of_compositions
compositions :: Int -> [[Int]]
compositions = go 1 . subtract 1
  where
    go :: Int -> Int -> [[Int]]
    go k 0 = []
    go k 1 = [[k,1],[k+1]]
    go k n = ((k:) <$> go 1 (n-1)) ++ go (k+1) (n-1)

maxReps :: Eq a => [a] -> Int
maxReps = maximum . fmap length . group

getMapping :: IO (IM.IntMap String)
getMapping = do
    putStrLn "(NB. Enter an empty line when you are done creating mappings)"
    go IM.empty 1
  where
    go m n = do
        putStr $ "Enter the letter corresponding to number " ++ show n ++ ": "
        l <- getLine
        let m' = IM.insert n l m
        if null l
            then pure m'
            else go m' (n+1)

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering

    m <- getMapping

    putStr "What do you want your words to sum to? "
    totalsum <- readLn :: IO Int

    putStr "At most how many repetitions of a single letter in a row will you tolerate? "
    reps <- readLn :: IO Int

    let ws = filter ((<=reps) . maxReps) $ filter (all (<= (IM.size m))) $ compositions totalsum
    traverse_ (putStrLn . concatMap (m !)) ws