-- |
-- Module      : Verismith.Circuit.Random
-- Description : Random generation for DAG
-- Copyright   : (c) 2018-2019, Yann Herklotz
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
--
-- Define the random generation for the directed acyclic graph.
module Verismith.Circuit.Random
  ( rDups,
    rDupsCirc,
    randomDAG,
    genRandomDAG,
  )
where

import Data.Graph.Inductive (Context)
import qualified Data.Graph.Inductive as G
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.List (nub)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Hog
import qualified Hedgehog.Range as Hog
import Verismith.Circuit.Base

dupFolder :: (Eq a, Eq b) => Context a b -> [Context a b] -> [Context a b]
dupFolder :: forall a b.
(Eq a, Eq b) =>
Context a b -> [Context a b] -> [Context a b]
dupFolder Context a b
cont [Context a b]
ns = Context a b -> Context a b
forall {a} {a} {b} {c}.
(Eq a, Eq a) =>
([a], b, c, [a]) -> ([a], b, c, [a])
unique Context a b
cont Context a b -> [Context a b] -> [Context a b]
forall a. a -> [a] -> [a]
: [Context a b]
ns
  where
    unique :: ([a], b, c, [a]) -> ([a], b, c, [a])
unique ([a]
a, b
b, c
c, [a]
d) = ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
a, b
b, c
c, [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
d)

-- | Remove duplicates.
rDups :: (Eq a, Eq b) => Gr a b -> Gr a b
rDups :: forall a b. (Eq a, Eq b) => Gr a b -> Gr a b
rDups Gr a b
g = [Context a b] -> Gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Context a b] -> gr a b
G.buildGr ([Context a b] -> Gr a b) -> [Context a b] -> Gr a b
forall a b. (a -> b) -> a -> b
$ (Context a b -> [Context a b] -> [Context a b])
-> [Context a b] -> Gr a b -> [Context a b]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
G.ufold Context a b -> [Context a b] -> [Context a b]
forall a b.
(Eq a, Eq b) =>
Context a b -> [Context a b] -> [Context a b]
dupFolder [] Gr a b
g

-- | Remove duplicates.
rDupsCirc :: Circuit -> Circuit
rDupsCirc :: Circuit -> Circuit
rDupsCirc = Gr Gate () -> Circuit
Circuit (Gr Gate () -> Circuit)
-> (Circuit -> Gr Gate ()) -> Circuit -> Circuit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr Gate () -> Gr Gate ()
forall a b. (Eq a, Eq b) => Gr a b -> Gr a b
rDups (Gr Gate () -> Gr Gate ())
-> (Circuit -> Gr Gate ()) -> Circuit -> Gr Gate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Circuit -> Gr Gate ()
getCircuit

-- | Gen instance to create an arbitrary edge, where the edges are limited by
-- `n` that is passed to it.
arbitraryEdge :: Hog.Size -> Gen CEdge
arbitraryEdge :: Size -> Gen CEdge
arbitraryEdge Size
n = do
  Size
x <- (Size -> Bool) -> GenT Identity Size
with ((Size -> Bool) -> GenT Identity Size)
-> (Size -> Bool) -> GenT Identity Size
forall a b. (a -> b) -> a -> b
$ \Size
a -> Size
a Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
n Bool -> Bool -> Bool
&& Size
a Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
0 Bool -> Bool -> Bool
&& Size
a Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
n Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1
  Size
y <- (Size -> Bool) -> GenT Identity Size
with ((Size -> Bool) -> GenT Identity Size)
-> (Size -> Bool) -> GenT Identity Size
forall a b. (a -> b) -> a -> b
$ \Size
a -> Size
x Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
a Bool -> Bool -> Bool
&& Size
a Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
n Bool -> Bool -> Bool
&& Size
a Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
0
  CEdge -> Gen CEdge
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CEdge -> Gen CEdge) -> CEdge -> Gen CEdge
forall a b. (a -> b) -> a -> b
$ LEdge () -> CEdge
CEdge (Size -> Node
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
x, Size -> Node
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
y, ())
  where
    with :: (Size -> Bool) -> GenT Identity Size
with =
      ((Size -> Bool) -> GenT Identity Size -> GenT Identity Size)
-> GenT Identity Size -> (Size -> Bool) -> GenT Identity Size
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Size -> Bool) -> GenT Identity Size -> GenT Identity Size
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Hog.filter (GenT Identity Size -> (Size -> Bool) -> GenT Identity Size)
-> GenT Identity Size -> (Size -> Bool) -> GenT Identity Size
forall a b. (a -> b) -> a -> b
$
        Node -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          (Node -> Size) -> GenT Identity Node -> GenT Identity Size
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> GenT Identity Node -> GenT Identity Node
forall (m :: * -> *) a. MonadGen m => Size -> m a -> m a
Hog.resize
            Size
n
            (Range Node -> GenT Identity Node
forall (m :: * -> *). MonadGen m => Range Node -> m Node
Hog.int (Node -> Node -> Range Node
forall a. Integral a => a -> a -> Range a
Hog.linear Node
0 Node
100))

-- | Gen instance for a random acyclic DAG.
randomDAG ::
  -- | The generated graph. It uses Arbitrary to generate
  -- random instances of each node
  Gen Circuit
randomDAG :: Gen Circuit
randomDAG = do
  [Gate]
list <- Range Node -> GenT Identity Gate -> GenT Identity [Gate]
forall (m :: * -> *) a. MonadGen m => Range Node -> m a -> m [a]
Hog.list (Node -> Node -> Range Node
forall a. Integral a => a -> a -> Range a
Hog.linear Node
1 Node
100) (GenT Identity Gate -> GenT Identity [Gate])
-> GenT Identity Gate -> GenT Identity [Gate]
forall a b. (a -> b) -> a -> b
$ Gate -> Gate -> GenT Identity Gate
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
Hog.enum Gate
forall a. Bounded a => a
minBound Gate
forall a. Bounded a => a
maxBound
  [LEdge ()]
l <- Range Node -> GenT Identity (LEdge ()) -> GenT Identity [LEdge ()]
forall (m :: * -> *) a. MonadGen m => Range Node -> m a -> m [a]
Hog.list (Node -> Node -> Range Node
forall a. Integral a => a -> a -> Range a
Hog.linear Node
10 Node
1000) GenT Identity (LEdge ())
aE
  Circuit -> Gen Circuit
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Circuit -> Gen Circuit)
-> (Gr Gate () -> Circuit) -> Gr Gate () -> Gen Circuit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr Gate () -> Circuit
Circuit (Gr Gate () -> Gen Circuit) -> Gr Gate () -> Gen Circuit
forall a b. (a -> b) -> a -> b
$ [LNode Gate] -> [LEdge ()] -> Gr Gate ()
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
G.mkGraph ([Gate] -> [LNode Gate]
forall {b}. [b] -> [(Node, b)]
nodes [Gate]
list) [LEdge ()]
l
  where
    nodes :: [b] -> [(Node, b)]
nodes [b]
l = [Node] -> [b] -> [(Node, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0 .. [b] -> Node
forall a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
length [b]
l Node -> Node -> Node
forall a. Num a => a -> a -> a
- Node
1] [b]
l
    aE :: GenT Identity (LEdge ())
aE = CEdge -> LEdge ()
getCEdge (CEdge -> LEdge ()) -> Gen CEdge -> GenT Identity (LEdge ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Size -> Gen CEdge) -> Gen CEdge
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
Hog.sized Size -> Gen CEdge
arbitraryEdge

-- | Generate a random acyclic DAG with an IO instance.
genRandomDAG :: IO Circuit
genRandomDAG :: IO Circuit
genRandomDAG = Gen Circuit -> IO Circuit
forall (m :: * -> *) a. MonadIO m => Gen a -> m a
Hog.sample Gen Circuit
randomDAG