-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/IGraph/Algorithms/Motif.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DataKinds #-}
module IGraph.Algorithms.Motif
    ( triad
    , triadCensus
    ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import System.IO.Unsafe (unsafePerformIO)

import Foreign

import IGraph
import IGraph.Internal
{-# LINE 13 "src/IGraph/Algorithms/Motif.chs" #-}




-- | Every triple of vertices in a directed graph
-- 003: A, B, C, the empty graph.
-- 012: A->B, C, a graph with a single directed edge.
-- 102: A<->B, C, a graph with a mutual connection between two vertices.
-- 021D: A<-B->C, the binary out-tree.
-- 021U: A->B<-C, the binary in-tree.
-- 021C: A->B->C, the directed line.
-- 111D: A<->B<-C.
-- 111U: A<->B->C.
-- 030T: A->B<-C, A->C. Feed forward loop.
-- 030C: A<-B<-C, A->C.
-- 201: A<->B<->C.
-- 120D: A<-B->C, A<->C.
-- 120U: A->B<-C, A<->C.
-- 120C: A->B->C, A<->C.
-- 210: A->B<->C, A<->C.
-- 300: A<->B<->C, A<->C, the complete graph.
triad :: [Graph 'D () ()]
triad = map make edgeList
  where
    edgeList =
         [ []
         , [(0,1)]
         , [(0,1), (1,0)]
         , [(1,0), (1,2)]
         , [(0,1), (2,1)]
         , [(0,1), (1,2)]
         , [(0,1), (1,0), (2,1)]
         , [(0,1), (1,0), (1,2)]
         , [(0,1), (2,1), (0,2)]
         , [(1,0), (2,1), (0,2)]
         , [(0,1), (1,0), (0,2), (2,0)]
         , [(1,0), (1,2), (0,2), (2,0)]
         , [(0,1), (2,1), (0,2), (2,0)]
         , [(0,1), (1,2), (0,2), (2,0)]
         , [(0,1), (1,2), (2,1), (0,2), (2,0)]
         , [(0,1), (1,0), (1,2), (2,1), (0,2), (2,0)]
         ]
    make :: [(Int, Int)] -> Graph 'D () ()
    make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()

triadCensus :: (Ord v, Read v) => Graph d v e -> [Int]
triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
    igraphTriadCensus (_graph gr) result
    map truncate <$> toList result

-- motifsRandesu

igraphTriadCensus :: (IGraph) -> (Ptr Vector) -> IO ()
igraphTriadCensus a1 a2 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  igraphTriadCensus'_ a1' a2' >>= \res ->
  return ()

{-# LINE 66 "src/IGraph/Algorithms/Motif.chs" #-}


igraphMotifsRandesu :: (IGraph) -> (Ptr Vector) -> (Int) -> (Ptr Vector) -> IO ()
igraphMotifsRandesu a1 a2 a3 a4 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = castPtr a4} in
  igraphMotifsRandesu'_ a1' a2' a3' a4' >>= \res ->
  return ()

{-# LINE 69 "src/IGraph/Algorithms/Motif.chs" #-}


foreign import ccall safe "IGraph/Algorithms/Motif.chs.h igraph_triad_census"
  igraphTriadCensus'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Algorithms/Motif.chs.h igraph_motifs_randesu"
  igraphMotifsRandesu'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))