S2

ConeptCode.hs

module ConceptCode (
  up,
  down
) where

import Control.Monad
import Data.List


{-
  Супер классная штука для формирования списка списков %)
  Да, ее надо запомнить
-}
listOfLists :: Int -> [a] -> [[a]]
listOfLists n source = getStuff n [[]]
  where getStuff 0 x = x
        getStuff n res = do
          x <- source
          r <- res
          let xr = x:r
          getStuff n' $ return xr
          where n' = n - 1


{-
  Обрезаем длину справа, т.е. слева берем в два раза меньше чем есть
-}
up :: [a] -> [a]
up source = 
  let l   = length source
      l'  = quot l 2
  in
  take l' source

{-
  С верхнего уровня на нижний
  На входе - алфавит + исходная последовательность
  На выходе - родитель + дочерние
-}
down :: [a] -> [a] -> [[a]]
down alph source = 
  let l = length source
      xs = listOfLists l alph
  in
  do
    x <- xs
    return $ source ++ x

Main.hs

import Data.Char
import qualified ConceptCode as CC

-- Алфавит
alph = ['0' .. '9']

-- Алиасы
up = CC.up
down = CC.down alph

-- Из чиселок в массив разрядов и обратно
decode :: [Char] -> Int
decode = read

encode :: Int -> [Char]
encode i = fillDigits $ show i
  where fillDigits xs = if isPow2 $ length xs 
                          then xs
                          else '0' : xs
        isPow2 = (\x -> (floor x) == (ceiling x) ) . (logBase 2) . fromIntegral

main = do
  line <- getLine
  let p =  encode $ (+3) $ decode $ up line
  putStrLn $ p
  putStrLn $ unlines $ down p 
  return ()