import Data.Function
import qualified Data.List as L
import qualified Data.Map  as M

sp :: Char
sp = '_'

alignColumn :: [String] -> [String]
alignColumn = L.transpose . f . L.transpose . addsp
    where
      addsp xss = map add xss
          where maxlen = foldr (\x a -> if length x > a then length x else a) 0 xss
                add xs = xs ++ replicate (maxlen - length xs) sp
      f [] = []
      f xss = g $ do
          is <- groupOfIndex $ head xss
          let (ys:yss) = insertSP xss is
          return $ ys : f yss
      g [] = []
      g xs = L.minimumBy (compare `on` length) xs

insertSP :: [String] -> [Int] -> [String]
insertSP xss1 is = f xss1 pre
    where
      pre = zipWith (\k _ -> if elem k is then Nothing else Just sp) [0..] (head xss1)
      f [] cs
          | all (== Nothing) cs = []
          | otherwise = foldr (\x acc -> maybe sp id x : acc) [] cs : []
      f (xs:xss) cs = (map fst ys) : f xss (map snd ys)
          where
            ys = zipWith g xs cs
                where
                  g x Nothing = (x, Nothing)
                  g x (Just c) = (c, Just x)

groupOfIndex :: String -> [[Int]]
groupOfIndex xs = map (spi++) . M.elems . fst . foldl f (M.empty, 0) $ xs
    where
      spi = L.findIndices (==sp) xs
      f (acc,i) x
          | x == sp = (acc, i+1)
          | otherwise = (M.insertWith (++) x [i] acc, i+1)

main :: IO ()
main = do
    run ["1","1"]
    run ["1","2"]
    run ["12", "21"]
    run ["11", "12"]
    run ["113", "114"]
    run ["123", "134"]
    run ["1212", "1322", "1122"]
    run ["123", "113", "1323"]
    run ["1234", "4321", "1122"]
    -- run ["12121313432121233", "21322312443213443"]
    where
      run xs = do
          mapM_ putStrLn xs
          putStrLn . unlines $ alignColumn xs