Text format to columns on Haskell

This is the language study excersice which reformat text input into text with columns. All process will have follow parameters:

• ncols - number of columns
• nspaces - spaces number between columns
• width - width of columns
• pagesize - lines of page

We will use next modules and exported names:

import           Data.List
import           Data.Maybe            (fromMaybe, isJust)
import           Prelude               hiding (Word)
import           System.Console.GetOpt
import           System.Environment

Parameters of re-formating will be got from command line, which is parsing with standard Haskell module GetOpt (see above). Btw, this parser (be default?) supports "-aN" but not "-a N".

This is the "record" for CLI options:

-- | Stricts to get syntax errors immediately
data CmdOpts = CmdOpts {
  help     :: !Bool,
  ncols    :: !Int, -- number of columns
  nspaces  :: !Int, -- spaces between columns
  width    :: !Int, -- width of column
  pagesize :: !Int -- lines in page
  } deriving Show

Their fields are strict to get syntax error immediately. We are reading input text from "stdin" so will we are waiting for input (WITH OPTION ERROR!) we won't get error reporting - so, they will be strict.

This null-arity function returns the default values of CLI options (if some are omitted):

-- | Default values of command line options
defaultCmdOpts :: CmdOpts
defaultCmdOpts = CmdOpts {
  help = False,
  ncols = 2,
  nspaces = 4,
  width = 20,
  pagesize = 24
  }

Then, as in other languages (argparse in Python ,for example) we should define options: their names, types, numbers, mandatory, etc.:

-- | Definition of program command line options
cmdSyntax :: [OptDescr (CmdOpts -> CmdOpts)]
cmdSyntax =
  [
    Option ['h', '?'] ["help"]
      (NoArg (\cmdOpts -> cmdOpts {help=True} ))
      "print this help",

    Option ['c'] ["cols"]
      (OptArg (\s cmdOpts -> cmdOpts {ncols=readOpt s}) "NCOLS")
      "columns number (default: 2)",

    Option ['s'] ["spaces"]
      (OptArg (\s cmdOpts -> cmdOpts {nspaces=readOpt s}) "NSPACES")
      "spaces number (default: 4)",

    Option ['w'] ["width"]
      (OptArg (\s cmdOpts -> cmdOpts {width=readOpt s}) "WIDTH")
      "column width (default: 20)",

    Option ['p'] ["pagesize"]
      (OptArg (\s cmdOpts -> cmdOpts {pagesize=readOpt s}) "PAGESIZE")
      "page size in lines (default: 25)"
  ] where
  readOpt :: Read a => Maybe [Char] -> a
  readOpt s = (read $ fromMaybe "" s)

First arg of OptArg is lambda which gets string value of option and aggregated options values - it must parse string to internal type and to save result into this cmdOpts for further processing.

Parsing function is parseCmdOpts which works with external world so operates in IOcontext:

-- | Usage string
usage :: String
usage = usageInfo "SYNTAX: col [options...]" cmdSyntax


-- | Parses command line options
parseCmdOpts :: IO CmdOpts
parseCmdOpts = do
  argv <- getArgs
  case getOpt Permute cmdSyntax argv of
    (opts, _, []) -> return $ foldl (flip id) defaultCmdOpts opts
    (_, _, errs) -> error $ concat errs ++ "\n" ++ usage

This is the utility function which split sequence into pies with size n and is based on standard function splitAt:

-- | Splits `xs` on pies with the same size `n`
splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs
  where (as, bs) = splitAt n xs

To simplify our types expressions (signatures) we set types definitions for word (symbols without spaces), line, column and page:

-- | Typedefs
type Word = String
type Line = String
type Column = [Line]
type Page = [Column]

Here we begin actual processing. First, we need to make main working function which gets words and cuts (extracts) line from them but saves rest of words for further processing. It calculate how many words we need, then calculate how much they must be sparse (to fill width of column) and returns result as Line and list of words rest. If it's impossible to extract line with such width then result will be Nothing (if possible - line is wrapped into Just). Idea is to calculate lengths of words but (to simplify further calculations) additively: not [2, 3, 4] but [2, 6, 10], i.e. lengths of words plus one-symbol spaces (minimal needed symbols). Then we takes as much words as we need to keep line length <= width. This does wl = ... line in the code:

-- | Cuts line with width `w` from words `ws` by drop some words and adding
-- spaces between kept ones. If it's possible returns (Maybe line, rest-of-words),
-- otherwise (Nothing, all-words)
cutLine :: Int -> [Word] -> (Maybe Line, [Word])
cutLine _ [] = (Just "", [])
cutLine w ws =
  let wl = takeWhile (<=w) $ scanl1 ((+).(+1)) $ map length ws -- additive words lengths
      wn = length wl -- words number
      (w0, w1) = splitAt wn ws
      gn = wn - 1 -- gaps number
  in
    case gn of
      -1 -> (Nothing, ws)
      0 -> (Just $ w0!!0, w1)
      _ ->
        let ag = w - last wl -- additional gaps needed
            gw = 1 + ag `div` gn -- gaps width (except last one)
            lgw = gw + (ag `mod` gn) -- last gap width
            gap = replicate gw ' '
            lgap = replicate lgw ' '
            (firstWords, lastWord) = splitAt (wn-1) w0
        in
          (Just $ intercalate gap firstWords ++ lgap ++ lastWord!!0, w1)

We calculates needed spaces to sparse line to width w and add them into each gap, last gap will have remainder of division (if we are adding 5 spaces to 2 gapes then last will have 3 spaces, not 2).

Next function cuts column from words: actually we can think about resulting text as text with one column looking like snake :) So, we cut one column (all columns have the same width, laid snake column):

-- | Cuts column (list of lines) with width `w` from words `ws`. If it's possible
-- (to reformat words into new width `w`), returns Maybe column, Nothing otherwise
cutColumn :: Int -> [Word] -> Maybe Column
cutColumn w ws =
  let (mbLine, othWords) = cutLine w ws in
    do
      line <- mbLine
      case othWords of
        [] -> return [line]
        _ -> do othLines <- (cutColumn w othWords)
                return $ [line] ++ othLines

Now we will cut the "snake" into separate pies - real columns. We need (sure) to know page size (ps argument) and width of columns (w). We use >>= bind function to drop Nothing (into Nothing). And yes, we actually cut the snake - with splitEvery - into the same size parts (size is ps):

-- | Cuts columns with width `w` for page with size `ps` (lines in page) from input
-- text `txt`
cutColumns :: Int -> Int -> String -> Maybe [Column]
cutColumns w ps txt =
  let ws = words txt in
    cutColumn w ws >>= \c -> return $ splitEvery ps c

And last we cuts pages from list of columns, principle is the same:

-- | Cuts pages from early cutted (reformatted) columns `mbCols` when number of columns
-- is `nc`
cutPages :: Int -> Maybe [Column] -> Maybe [Page]
cutPages nc mbCols = mbCols >>= \cols -> return $ splitEvery nc cols

Now we need utility function, zip - not for 2 sequences, but for any number of them. enumFrom is analogue of Python range(0), we select each time item with the same index - like in real zip. But since we have any number of sequence, they are represented as list of sequences seqs. Sequences can have different number of items, so we complement each one with Nothing (NULL), but then existing items will be wrapped in Just. We stop to consume resulting sub-lists when all their items will be Nothing:

-- | zip for N sequences
zipN :: [[a]] -> [[Maybe a]]
zipN seqs =
  let seqs' = map (\sq -> map Just sq ++ repeat Nothing) seqs in
  takeWhile (any isJust) [[sq!!i | sq <- seqs'] | i <- enumFrom 0]

See picture:

  1     2     3     N     M        <- seq1
  2     3     N     N     N        <- seq2
[1,2] [2,3] [3,N] skip! skip! ...  <- zipN

Now we should "fold" results into text (from structured data). Folding of page will creates page into ONE column (the snake, yes:)

-- | Folds page `page` with width of column `w` and vertical space `vSpace` into string
foldPage :: String -> Int -> Page -> Column
foldPage vSpace w page =
 let emptyCol = replicate w ' ' in
 map (\c -> intercalate vSpace $ map (fromMaybe emptyCol) c) (zipN page)

Then we can fold pages into text (String). "Pages" - because result of cut is list of pages (which are columns which are lines which are words). Each page will be delimited with string like (page number):

                                 - 2 -

named colontit. It is justified with pw - page width.

vSpace here is vertical space between columns. enumPage is enumerated pages with... zip, zip does it in very natural way - it "adds" to page it's number (from 1, see enumFrom 1):

-- | Folds pages `pages` with columns of width `w` and page width `pw` into string
foldPages :: String -> Int -> Int -> [Page] -> String
foldPages vSpace w pw pages =
  let showPage i = "- " ++ show i ++ " -"
      pdel = "\n\n"
      colontit i = pdel
                   ++ replicate (pw `div` 2 - length (showPage i) `div` 2) ' '
                   ++ (showPage i) ++ pdel
      enumPages = zip (map (intercalate "\n" . foldPage vSpace w) pages) (enumFrom 1)
  in
    intercalate "" $ map (\(p,i) -> p ++ colontit (i::Integer)) enumPages

foldPage folds pages into one column (list of lines) and then we are joing column lines with "\n". Last function is col which joins together all processing:

-- | Reformats input text `txt` into new text with columns which options are setted
-- in `opts`
col :: CmdOpts -> String -> String
col opts txt =
  let mbCols = cutColumns (width opts) (pagesize opts) txt
      mbPages = cutPages (ncols opts) mbCols
      vSpace = replicate (nspaces opts) ' '
      pageWidth = (ncols opts) * (width opts) + (ncols opts - 1) * (nspaces opts)
  in
  foldPages vSpace (width opts) pageWidth (fromMaybe [] mbPages)

pageWidth we need to justify colontit.

Main entry point is simple and runs all I/O: processing of "stdin" content (see getContents) with out col function. But if we have fHelp then we print usage help instead (user enters "-h" CLI option):

main :: IO()
main = do
  cmdOpts <- parseCmdOpts
  let CmdOpts { help = fHelp } = cmdOpts in
    if fHelp then putStrLn usage
    else do
         inTxt <- getContents
         putStr $ col cmdOpts inTxt

fHelp is boolean flag mathed help field of our CLI options record. Actually it's simple example, but looks interesting. To run it use:

cat somefile.txt | runghc col.hs -w40 | less

This code is available in my Git

Python groupby pitfall

Python function groupby has one feature which can be cause of unexpected pitfall:

...The returned group is itself an iterator that shares the underlying iterable with groupby(). Because the source is shared, when the groupby() object is advanced, the previous group is no longer visible. So, if that data is needed later, it should be stored as a list...

Example:

from itertools import *

input = ((1, "one"), (1, "one too"), (1, "also one"),
         (2, "two"), (2, "another two"), (2, "two again")
)

grp = groupby(input, lambda p: p[0])
# grp = map(lambda p: (p[0], list(p[1])), grp)   # (A)
maxg, maxi = max(grp, key=lambda g: g[0])
print("maxg =", maxg, "maxi =", list(maxi))

Output without (A) is:

maxg = 2 maxi = [(2, 'two again')]

which is unexpected because we suppose to find "last" group to iterate than over it's items (they are 3!).

But with (A) is:

maxg = 2 maxi = [(2, 'two'), (2, 'another two'), (2, 'two again')]

This happens because sub-iterators of groups are not independent, iteration over groups "eats" sub-iterators too.

Iterative "in-place" Haskell factorial

This is the implementation of factorial which does not use recursion and does not pass result via stack but use 2 "global" vars: counter abd factorial value. For example:

fact 5 = 120

       counter  | fact
       ---------+-----------
        5       | 5
        4       | 20
        3       | 60
        2       | 120
        1       | 120 => end

Instead of pass temporary result of multiplication via stack, we'll create 2 states and use them as counter and factorial value. How to create 2 states? For one state we can use State monad, for 2... state in the state. Adding state to another monad (possible state too) is responsibility of StateT transformer. Calculation will looks like StateT Integer (State Integer) (). This means that we use Integer for counter and multiplication result, nothing will be returned as result because we use as result the state.

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class


-- | StateT s m a :: * -> (* -> *) -> * -> *
-- here "external" is in signature, not actually - in call
fact1 :: StateT Integer (State Integer) ()
fact1 = do
  i <- get              -- ^ counter: external state
  when (i > 1) $ do     -- ^ if counter > 1
    lift $ modify (i*)  -- ^ mult internal state by counter (initial: 1)
    modify (-1+)        -- ^ decrement external state
    fact1               -- ^ to next iteration, changed states


fact :: Integer -> Integer
fact n = execState (execStateT fact1 n) 1
-- ^ external (internal in signature) state is fact, internal is counter


main :: IO ()
main = do
  putStrLn "Result: "
  print $ fact 5

Implementation is simple. First, signature describes only types, not actual nesting structure, so in function body "internal" is the internal in signature. lift/get are relative for internal/external but in termins of signature. Really after transformation you will works with stack-like structure, so when you call your function, you should create all in reverse order: internal becomes external, so we get counter as external state but pass it in call as internal. No collision here: it's actually internal, only in signature it's looks like external, because signature looks like application of StateT (externally) to argument State.

We nothing return because there is a way to return state instead of result. This does exec* functions family (execState is needed in external call).

Harmonic series

This is the very simple interview question: check that series are harmonic, i.e. list of numbers are line (kx + b) - two close elements always have the same difference (k).

Naive implementation is:

-- Naive version of checking if sequence of numbers are harmonic (difference
-- between neighbords is the const)

-- Folding function with args (prev, diff, result)
rf (p, d, Nothing) c = (c, d', Just True) where d' = c - p
rf (p, d, Just False) c = (c, d, Just False)
rf (p, d, Just True) c = (c, d', Just $ d == d') where d' = c - p

harm [] = False
harm (hd:xs) = let (_, _, Just x) = foldl rf (hd, 0, Nothing) xs in x


main = do
  print $ harm [1, 2, 3, 4, 5, 6, 9]
  print $ harm [1, 2, 3, 4, 5, 6]
  print $ harm [2, 4, 6, 8]

where we are folding items and keep on each step tuple (prev, diff, result), where result is Just True, Just False or Nothing on first item. Actually this code has problem: it can not process harm [2] or harm [].

Another version may calculate difference between neighboards and then to calculate difference in the same way again:

1    2    3    4    6
  -1   -1   -1   -2
     0    0   -1!

After it we can summarize all items and if result is 0 then we have harmonic numbers:

neighOp op [] = []
neighOp op l@(hd:xs) = zipWith op l xs

harm [] = False
harm [x] = False
harm ns = 0 == (foldl1 (+) $ neighOp (-) $ (neighOp (-) ns))


main = do
  print $ harm [1, 2, 3, 4, 5, 6, 9]
  print $ harm [1, 2, 3, 4, 5, 6]
  print $ harm [2, 4, 6, 8]
  print $ harm [2]
  print $ harm []

3d version does not folding all items but drops all 0's until find first non zero which means that non-harmonic series are found:

neighOp op [] = []
neighOp op l@(hd:xs) = zipWith op l xs

harm [] = False
harm [x] = False
harm ns = case dropWhile (==0) $ neighOp (-) $ neighOp (-) ns of
  [] -> True
  _ -> False


main = do
  print $ harm [1, 2, 3, 4, 5, 6, 9]
  print $ harm [1, 2, 3, 4, 5, 6]
  print $ harm [2, 4, 6, 8]
  print $ harm [2]
  print $ harm []

Case will be lazy so calculations happens until first non-zero item in 2nd difference.