RandomDiagram.hs

{-| Module  : FiniteCategories
Description : Select a random diagram in a category.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

This module provide functions to generate random diagrams.
It can be used to test functions, to generate examples or to test hypothesis.
-}

module RandomDiagram.RandomDiagram 
(
    mkRandomDiagram,
    defaultMkRandomDiagram
)
where
    import FiniteCategory.FiniteCategory
    import CompositionGraph.CompositionGraph
    import RandomCompositionGraph.RandomCompositionGraph
    import System.Random                            (RandomGen, uniformR)
    import Data.Maybe                               (isNothing, fromJust)
    import Utils.Sample
    import FunctorCategory.FunctorCategory
    import Diagram.Diagram

    -- | Choose a random diagram in the functor category of an index category and an image category.
    mkRandomDiagram :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                        FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
                        RandomGen g) => c1 -> c2 -> g -> (Diagram c1 m1 o1 c2 m2 o2, g)
    mkRandomDiagram index cat gen = pickOne (ob FunctorCategory{sourceCat=index, targetCat=cat}) gen
    
    
    -- | Constructs two random composition graphs and choose a random diagram between the two.
    defaultMkRandomDiagram  :: (RandomGen g) => g ->  (Diagram (CompositionGraph Int Int) (CGMorphism Int Int) Int (CompositionGraph Int Int) (CGMorphism Int Int) Int, g)
    defaultMkRandomDiagram g1 = mkRandomDiagram cat1 cat2 g3
        where 
            (nbArrows1, g2) = uniformR (1,8) g1
            (nbAttempts1, g3) = uniformR (0,nbArrows1+nbArrows1) g2
            (cat1, g4) = mkRandomCompositionGraph nbArrows1 nbAttempts1 5 g3
            (nbArrows2, g5) = uniformR (1,11-nbArrows1) g4
            (nbAttempts2, g6) = uniformR (0,nbArrows2+nbArrows2) g5
            (cat2, g7) = mkRandomCompositionGraph nbArrows2 nbAttempts2 5 g6