transitive_sort.hs

module Main where

import Control.Monad.Random.Class
import Algebra.Graph
import Control.Monad
import Data.Maybe
import Lib

main :: IO ()
main = print =<< foo [1..4]

type N a = (a, a)

foo :: (MonadRandom m, Ord a) => [a] -> m (Graph Int)
foo ls = simplify . overlays . catMaybes <$> mapM (picks ls) (zip [0..] ls)

picks :: (Ord a, MonadRandom m) => [a] -> (Int, a) -> m (Maybe (Graph Int))
picks ls (i,l) = do
  a <- pick ls (i,l)
  b <- pick ls (i,l)
  return $ overlay <$> a <*> b

pick :: (MonadRandom m, Ord a) => [a] -> (Int, a) -> m (Maybe (Graph Int))
pick ls (i,l) = do
  n <- getRandomR (0, length ls - 2)
  let n' | n >= i    = succ n
         | otherwise = n
      m              = ls !! n'
      res            = case compare l m of
                            LT -> Just $ connect (vertex i ) (vertex n')
                            GT -> Just $ connect (vertex n') (vertex i)
                            EQ -> Nothing
  return res

{-
ts = do
  create a graph
  for every element in your list
    choose two other elements (possibly randomly)
    insert an inductive graph node for those three elements
  resolve the graph
-}