• Alfredo Di Napoli's avatar
    Split the project in 3 · 34d68dc4
    Alfredo Di Napoli authored
    This commit splits the project in 3 sub-projects:
    
    1. `gargantext-graph-core`: it contains the plain algorithms on graphs;
    2. `gargantext-graph-accelerate`: accelerate utilities on graphs;
    3. `gargantext-graph-eigin`: eigen utilities on graphs;
    34d68dc4
Random.hs 1.54 KB
{-| Module      : Graph.Tools.Random
Description :
Copyright   : (c) CNRS, Alexandre Delanoë
License     : AGPL + CECILL v3
Maintainer  : alexandre+dev@delanoe.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs    #-}
{-# LANGUAGE NoImplicitPrelude       #-}


module Graph.Tools.Random where

import Data.Csv
import Data.Text (pack, splitOn, unpack)
import Data.Vector hiding (map, uniq)
import Prelude (read)
import Protolude
import Graph.Types
import qualified Data.Graph.Inductive.PatriciaTree as DGIP
import qualified Data.Set                          as Set
import qualified Data.Vector                       as Vector

import qualified Data.Matrix.Sparse.Static    as SMatrix
import qualified Numeric.LinearAlgebra.Static as DMatrix

-- Random Matrix
-- | Random Matrix && Graph
-- TODO random matrix of any size for the tests

randomMatrix :: KnownNat n => IO (MatrixD n)
randomMatrix = DMatrix.rand

{-
matrix2graph :: forall   n
              . (KnownNat n)
             => MatrixS n
             -> FiniteGraph n () ()
matrix2graph m = withG (mkGraphUfromEdges $ map (\(x,y,_) -> (x,y)) $ SMatrix.toList m)
                       identity
-}

randomAdjacency :: KnownNat n => IO (MatrixS n)
randomAdjacency = do
  m1 <- randomMatrix
  m2 <- randomMatrix
  pure $ SMatrix.sparsify (\(i, j) v -> if i < j && v > 0.9 then Just 1 else Nothing)
       $ DMatrix.mul m1 m2
  -- pure $ SMatrix.fromMatrix
  --      $ DMatrix.imapL (\(i, j) v -> if i < j && v > 0.9 then 1 else 0)
  --      $ DMatrix.mul m1 m2