Various Haskell Code

DList.hs

module DList
    ( DList(..)
    , fromList
    , toList
    , empty
    , (|>)
    , (|:)
    ) where

-- Difference List
newtype DList a = DList ([a] -> [a])

instance Show a => Show (DList a) where
    show xs = "DList " ++ show (toList xs)

fromList :: [a] -> DList a
fromList xs = DList (xs ++)

toList :: DList a -> [a]
toList (DList f) = f []

empty :: DList a
empty = DList id

-- Append operator.
(|>) :: DList a -> DList a -> DList a
(DList f) |> (DList g) = DList (f . g)

infixl 5 |>

-- Cons operator.
(|:) :: a -> DList a -> DList a
x |: (DList f) = DList ((x :) . f)

infixr 5 |:

FastIO.hs

module FastIO
    ( getIList
    , getIList'
    , repeatT
    ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.ByteString.Char8 (readInteger, readInt)
import qualified Data.ByteString.Char8 as BSChar8
import Data.Char (isSpace)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Control.Monad (replicateM_)

gl = ByteString.getLine
dw = BSChar8.dropWhile

get :: Integral a => (ByteString -> Maybe (a, ByteString)) -> IO [a]
get u = unfoldr f <$> gl
    where f = u . dw isSpace

getIList :: IO [Integer]
getIList = get readInteger

getIList' :: IO [Int]
getIList' = get readInt

repeatT :: IO a -> IO ()
repeatT action = do
    Just (t, _) <- readInt <$> gl
    replicateM_ t action

IO.hs

module IO
    ( getNumList
    , repeatT
    ) where

import Control.Applicative ((<$>))
import Control.Monad (replicateM_)

getNumList :: (Num a, Read a) => IO [a]
getNumList = map read . words <$> getLine

repeatT :: IO a -> IO ()
repeatT action = do
    t <- readLn
    replicateM_ t action

List.hs

{-# LANGUAGE ViewPatterns #-}

module List
    ( consecutive
    , pairup
    , grouping
    , outersperse
    , monotone
    ) where

import Data.List (tails)
import Control.Applicative ((<*>))

-- Group each n consecutive elements of xs.
-- Overlapping case.
-- Example:
--
-- λ: consecutive 3 [0..5]
-- [[0,1,2],[1,2,3],[2,3,4],[3,4,5]]
consecutive :: Int -> [a] -> [[a]]
consecutive n xs = let m = length xs - n + 1
                   in [ take n x | x <- take m $ tails xs ]

-- Pair up two consecutive elements of xs.
-- Example:
--
-- λ: pairup [0..5]
-- [(0,1),(1,2),(2,3),(3,4),(4,5)]
pairup :: [a] -> [(a, a)]
pairup = zip <*> tail

-- Grouping each n elements of xs
-- Non-overlapping case.
-- Example:
--
-- λ: grouping 5 [0..10]
-- [[0,1,2,3,4],[5,6,7,8,9],[10]]
grouping :: Int -> [a] -> [[a]]
grouping n (splitAt n -> (xs, [])) = [xs]
grouping n (splitAt n -> (xs, ys)) = xs : grouping n ys

outersperse :: a -> [a] -> [a]
outersperse sep [] = [sep]
outersperse sep (x:xs) = sep : x : outersperse sep xs

monotone :: Eq a => [a] -> Bool
monotone = all (uncurry (==)) . pairup

Local.hs

module Local where

import List
import DList
import IO
import FastIO

import Data.Char (isDigit, digitToInt)
import Data.List (unfoldr)

(=~=) :: Eq a => Maybe a -> Maybe a -> Maybe a
(Just a) =~= (Just b) | a == b = Just a
_        =~= _                 = Nothing

infix 4 =~=

equiv :: Eq a => [Maybe a] -> Maybe a
equiv = foldr1 (=~=)

type Digits = [Int]

toDigits :: String -> Digits
toDigits = unfoldr f
    where f "" = Nothing
          f (c:cs) | isDigit c = Just ((digitToInt c), cs)
                   | otherwise = Nothing


asAppliedTo :: (a -> b) -> a -> (a -> b)
asAppliedTo = const

(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
f .: g = \a b -> f (g a b)

infixr 9 .:

(.$) :: (a -> b) -> a -> (a -> b)
(.$) = asAppliedTo

infixr 0 .$

-- Factorization
type Factors = [(Int, Int)]

factors :: Int -> Factors
factors n = go n 2
    where go n k
            | n < 2          = []
            | n < k*k        = [(n, 1)]
            | otherwise =
                case n `divMod` k of
                    (q, 0) -> loop q k 1
                    _      -> go n (k+1)
          loop n k p =
            case n `divMod` k of
              (q, 0) -> loop q k (p+1)
              _      -> (k, p) : go n (k+1)

unfactors :: Factors -> Int
unfactors = foldr f 1
    where f = (*) . uncurry (^)

numfactors :: Int -> Int
numfactors = foldr f 1 . factors
    where f = (*) . (+1) . snd