fork(1) download
copy 
  1. import Control.Applicative
  2. import Control.Monad.Memo
  3. import Data.Function
  4. import qualified Data.List as L
  5. import qualified Data.Map  as M
  6.  
  7. sp :: Char
  8. sp = '_'
  9.  
  10. alignColumn :: [String] -> [String]
  11. alignColumn = L.transpose . startEvalMemo . f . L.transpose . addsp
  12.     where
  13.       addsp xss = map ff xss
  14.           where maxlen = foldr (\x a -> if length x > a then length x else a) 0 xss
  15.                 ff xs = xs ++ replicate (maxlen - length xs) sp
  16.       f [] = return []
  17.       f xss = g <$> mapM (\(ys:yss) -> (ys:) <$> memo f yss)
  18.               [insertSP xss is | is <- groupOfIndex $ head xss]
  19.       g [] = []
  20.       g xs = L.minimumBy (compare `on` length) xs
  21.  
  22. insertSP :: [String] -> [Int] -> [String]
  23. insertSP xss1 is = f xss1 pre
  24.     where
  25.       pre = zipWith (\k _ -> if elem k is then Nothing else Just sp) [0..] (head xss1)
  26.       f [] cs
  27.           | all (== Nothing) cs = []
  28.           | otherwise = foldr (\x acc -> maybe sp id x : acc) [] cs : []
  29.       f (xs:xss) cs = (map fst ys) : f xss (map snd ys)
  30.           where
  31.             ys = zipWith g xs cs
  32.                 where
  33.                   g x Nothing = (x, Nothing)
  34.                   g x (Just c) = (c, Just x)
  35.  
  36. groupOfIndex :: String -> [[Int]]
  37. groupOfIndex xs = map (spi++) . M.elems . fst . foldl f (M.empty, 0) $ xs
  38.     where
  39.       spi = L.findIndices (==sp) xs
  40.       f (acc,i) x
  41.           | x == sp = (acc, i+1)
  42.           | otherwise = (M.insertWith (++) x [i] acc, i+1)
  43.  
  44. main :: IO ()
  45. main = do
  46.     run ["1","1"]
  47.     run ["1","2"]
  48.     run ["12", "21"]
  49.     run ["11", "12"]
  50.     run ["113", "114"]
  51.     run ["123", "134"]
  52.     run ["1212", "1322", "1122"]
  53.     run ["123", "113", "1323"]
  54.     run ["1234", "4321", "1122"]
  55.     run ["12121313432121233", "21322312443213443"]
  56.     -- 121_21_31_34_3212123__3
  57.     -- _2132_2312_44321___3443
  58.     where
  59.       run xs = do
  60.           mapM_ putStrLn xs
  61.           putStrLn . unlines $ alignColumn xs
  62.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.hs:2:8:
    Could not find module `Control.Monad.Memo'
    Perhaps you meant
      Control.Monad.Fix (from base)
      Control.Monad.ST (from base)
      Control.Monad.Zip (from base)
    Use -v to see a list of the files searched for.
stdout
copy 
Standard output is empty
https://ideone.com/lmBube
language:
Haskell (ghc 8.4.4)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!