semigroup_maker.hs

import System.IO  
import Control.Monad
import Data.Tree
import Data.List
import System.Environment

-------------------------------------------------------------------------------
encodeTree (Node root []) = "01"
encodeTree (Node root childs) = "0" ++ intercalate "" (sort $ map encodeTree childs) ++ "1"
isIsomorphic t1 t2 = encodeTree t1 == encodeTree t2

op m [x] = x
op m (x:y:xs) = op m $ (m !! x !! y):xs
am m = [0, 1..length m - 1]
f m x y z = and [z /= x, z /= y, op m [z, y] == z, op m [x, z] == x]
isNext m x y = and [x /= y, op m [x, y] == x, not $ any (f m x y) (am m)]
nexts m x = filter (isNext m x) (am m)
lowerElement m = op m $ am m
goStoT m x = [Node v (goStoT m v) | v <- nexts m x]
semigroupToTree m = Node le (goStoT m le) where le = lowerElement m

isSemiIso s1 s2 = isIsomorphic (semigroupToTree s1) (semigroupToTree s2) 

nums x = map read x
ca a n = if length a <= n then [take n a] else [take n a] ++ (ca (drop n a) n)

g (Node x []) = Node (show x) []
g (Node x a) = Node (show x) (map g a)
drt t = putStr . drawTree $ g t
-------------------------------------------------------------------------------

tt = Node 0 [Node 1 [Node 2[]], Node 3 []] :: Tree Int
ft = [Node (-1) [], Node 1 []] :: [Tree Int]

sortForest a = sortBy (\(Node x _) (Node y _) -> compare y x) a
isNode x (Node y a) | x == y    = True
                    | otherwise = or $ map (isNode x) a
findNode x t@(Node y a) | x == y    = t
                        | a == []   = Node (-1) []
                        | otherwise = (sortForest $ map (findNode x) a) !! 0 -- Можно сделать с помощью фильтра
r (Node x _) = x

opt x y t | isNode x (findNode y t) = y
          | isNode y (findNode x t) = x
          | otherwise               = r t

tts t = [[opt y x t| x <- [0..n]] | y <- [0..n]] where n = length t - 1

mtmn x = Node (head x) (mt $ tail x)
mt :: [Int] -> Forest Int
mt [x] = [Node x []]
mt [x, y] = [Node x [], Node y []]
mt [x, y, z] = [Node x [], Node y [], Node z []]
mt a = [mtmn l, mtmn r] where n = div (length a) 2; l = take n a; r = drop n a
makeTree n = Node 0 (mt [1..n-1])

ms n = tts $ makeTree n

sa [] = ""
sa (x:xs) = show x ++ " " ++ sa xs
sm [] = ""
sm (x:xs) = sa x ++ sm xs

ff s = writeFile "./input.txt" s

main = do
  args <- getArgs
  let n = read (args !! 0) :: Int
      str = sm $ ms n
  ff $ (str ++ str)