Added -a option to alias the largest Node in the graph.

.gitignore

@@ -0,0 +1,29 @@
+
+# Created by https://www.gitignore.io/api/haskell
+
+### Haskell ###
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+
+
+# End of https://www.gitignore.io/api/haskell

fantasi.cabal

@@ -32,11 +32,16 @@ library
   hs-source-dirs:      src
   exposed-modules:     Tuura.Fantasi.VHDL.Internal.EnvironmentWriter,
                        Tuura.Fantasi.VHDL.Internal.GraphWriter,
-                       Tuura.Fantasi.VHDL.Writer
+                       Tuura.Fantasi.VHDL.Writer,
+                       Tuura.Fantasi.HubRewrite
   -- other-modules:
   build-depends:       base >= 4 && < 5,
                        bytestring,
-                       pangraph
+                       pangraph,
+                       fgl,
+                       bytestring,
+                       containers,
+                       algebraic-graphs
   ghc-options:         -Wall
   default-language:    Haskell2010
 

n1.graphml

@@ -0,0 +1,44 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
+    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+    xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
+     http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
+  <graph id="G" edgedefault="undirected">
+    <node id="v00"/>
+    <node id="v01"/>
+    <node id="v02"/>
+    <node id="v03"/>
+    <node id="v04"/>
+    <node id="v05"/>
+    <node id="v06"/>
+    <node id="v07"/>
+    <node id="v08"/>
+    <node id="v09"/>
+    <node id="v10"/>
+    <node id="v11"/>
+    <node id="v12"/>
+    <node id="v13"/>
+    <node id="v14"/>
+    <edge source="v00" target="v01"/>
+    <edge source="v00" target="v02"/>
+    <edge source="v00" target="v03"/>
+    <edge source="v01" target="v04"/>
+    <edge source="v01" target="v05"/>
+    <edge source="v02" target="v05"/>
+    <edge source="v02" target="v06"/>
+    <edge source="v03" target="v06"/>
+    <edge source="v03" target="v07"/>
+    <edge source="v04" target="v08"/>
+    <edge source="v05" target="v08"/>
+    <edge source="v05" target="v09"/>
+    <edge source="v06" target="v09"/>
+    <edge source="v06" target="v10"/>
+    <edge source="v07" target="v10"/>
+    <edge source="v08" target="v11"/>
+    <edge source="v09" target="v12"/>
+    <edge source="v10" target="v13"/>
+    <edge source="v11" target="v12"/>
+    <edge source="v12" target="v14"/>
+    <edge source="v13" target="v12"/>
+    </graph>
+</graphml>

src/Tuura/Fantasi/HubRewrite.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Tuura.Fantasi.HubRewrite where
+
+import Pangraph
+
+import Data.ByteString.Char8 (pack)
+import Data.ByteString(ByteString)
+import qualified Data.ByteString as BS
+
+import Data.List(sortBy)
+
+import Algebra.Graph hiding (vertexList, edgeList)
+import Algebra.Graph.ToGraph hiding(vertexList, edgeList)
+import qualified Algebra.Graph.ToGraph as Alga
+
+import qualified Data.Set as Set
+
+import Data.Set(toList)
+
+-- Given a hub vertex, and four new vertices, the function replaces the hub with the vertices.
+splitHub :: Ord a => a -> (a, a, a, a) -> Graph a -> Graph a
+splitHub x (x00, x01, x10, x11) g = overlays
+    [ removeVertex x g 
+    , biclique in0 [x00, x01]
+    , biclique in1 [x10, x11]
+    , biclique [x00, x10] out0
+    , biclique [x01, x11] out1 ]
+  where
+    breakInHalf as =    let i = length as `div` 2
+                        in (take i as, drop i as) 
+    (in0 , in1 ) = breakInHalf . toList $ preSet x g
+    (out0, out1) = breakInHalf . toList $ postSet x g
+
+-- Useful alias.
+type Endpoints = (VertexID, VertexID)
+
+-- Returns the largest degree node from a Pangraph.
+-- Uses FGL patrica tree graph.
+largestDegreeNodes :: Graph VertexID -> [VertexID]
+largestDegreeNodes g = let
+    -- Get incoming Vertices of a Vertex.
+    sizePreSet = Set.size . \v -> preSet v g
+    -- Compare using Int instance.
+    ordVerticesBy :: VertexID -> VertexID -> Ordering
+    ordVerticesBy a b = sizePreSet a `compare` sizePreSet b
+    -- Sort the list largest to smallest using Flip
+    in sortBy (flip ordVerticesBy) . Alga.vertexList $ g
+
+-- Takes the a VertexID and generates its aliases based on a NxN matrix.
+generateAliasVertexIDs :: Int -> VertexID -> [VertexID]
+generateAliasVertexIDs n bs = map (\i -> bs `BS.append` ps i) (generateMatrixCords n)
+    where
+        ps :: Show a => a -> ByteString
+        ps = pack . show
+        -- Generate the possible ij of an NxN matrix. Uses Matrix indexing!
+        generateMatrixCords :: Int -> [(Int, Int)]
+        generateMatrixCords 0 = []
+        generateMatrixCords n' = concatMap (\l -> zip (repeat l) [1..n']) [1..n']
+
+-- | Take a graph finds it largest hub and replace with a set of four
+-- equivalently connected aliases.
+aliasHub :: Pangraph -> Maybe Pangraph
+aliasHub p = let
+    gOriginal = 
+        let vertexSuitability = (length . vertexList) p > 1 
+            edgeSuitability = (length . edgeList) p > 2
+        in  if vertexSuitability && edgeSuitability 
+                then Alga.toGraph p
+                else error "Graph is not suitable for aliasing as it has too few Vertices or Edges!"
+    vID:_ = largestDegreeNodes gOriginal
+    aliasIDs = generateAliasVertexIDs 2 vID
+    -- Is there a better way?
+    aliasesAsTuples = (aliasIDs !! 0, aliasIDs !! 1, aliasIDs !! 2, aliasIDs !! 3)
+    gAliased = splitHub vID aliasesAsTuples gOriginal
+    in makePangraph (map makeVertex' . Alga.vertexList $ gAliased) (map makeEdge' . Alga.edgeList $ gAliased)
+
+makeVertex' :: VertexID -> Vertex
+makeVertex' vID = makeVertex vID [("id", vID)]
+
+makeEdge' :: Endpoints -> Edge
+makeEdge' e = makeEdge e [("source", fst e), ("target", snd e)]

src/fantasi/Tuura/Fantasi/Main.hs

@@ -1,11 +1,14 @@
 module Tuura.Fantasi.Main (main) where
 
+import Pangraph
 import Tuura.Fantasi.Options
+import Tuura.Fantasi.HubRewrite     (aliasHub)
 import qualified Pangraph.GraphML.Parser  as P
 import qualified Tuura.Fantasi.VHDL.Writer     as VHDL
-import Data.ByteString  (readFile, writeFile)
+import Data.ByteString  (readFile, writeFile, ByteString)
 import Prelude hiding   (readFile, writeFile)
-import Data.Maybe       (maybe)
+import Data.Maybe       (fromMaybe)
+import Control.Monad(when)
 
 main :: IO ()
 main = do
@@ -14,13 +17,26 @@ main = do
     let graphMLPath           = optGraphML options
         graphVHDLPath         = optGraphName options
         simulationEnvVhdlPath = optSimName options
+        runAlias              = optAliasHub options
 
-    -- parse graph
-    pangraph <- ((maybe (error "file or graph is malformed") id) . P.parse) <$> readFile graphMLPath
+    when runAlias (print "Running Alias")
+
+    -- read and parse graph, handling error with a message.
+    pangraph <- (`getPangraph` options) <$> readFile graphMLPath
+
     let graphVHDL   = VHDL.writeGraph pangraph
     let simEnvVHDL  = VHDL.writeEnvironment pangraph
 
     -- output vhdl graph
     writeFile graphVHDLPath graphVHDL
     -- output vhdl simulation environment
     writeFile simulationEnvVhdlPath simEnvVHDL
+
+getPangraph :: ByteString -> Options -> Pangraph
+getPangraph bs options = let
+    applyAlias = if optAliasHub options
+        then aliasHub
+        else Just 
+    maybePangraph = P.parse bs >>= applyAlias
+    in fromMaybe (error errMsg) maybePangraph 
+    where errMsg = "Pangraph is nothing! Does the graph construct?"

src/fantasi/Tuura/Fantasi/Options.hs

@@ -11,15 +11,17 @@ data Options = Options
     , optVersion   :: Bool
     , optGraphML   :: FilePath
     , optGraphName :: FilePath
-    , optSimName   :: FilePath }
+    , optSimName   :: FilePath
+    , optAliasHub  :: Bool }
 
 defaultOptions :: Options
 defaultOptions = Options
     { optHelp      = False
     , optVersion   = False
     , optGraphML   = ""
     , optGraphName = "graph.vhdl"
-    , optSimName   = "sim-environment.vhdl" }
+    , optSimName   = "sim-environment.vhdl"
+    , optAliasHub  = False }
 
 options :: [OptDescr (Options -> IO Options)]
 options =
@@ -38,6 +40,10 @@ options =
     , Option ['v'] ["version"]
       (NoArg (\opts -> return opts { optVersion = True }))
       "Show version of Fantasi"
+
+    , Option ['a'] ["alias-hub"]
+      (NoArg (\opts -> return opts { optAliasHub = True }))
+      "Alias the largest hub to improve FPGA routing"
     ]
 
 getOptions :: IO Options

stack.yaml

@@ -3,5 +3,7 @@ extra-package-dbs: []
 packages:
 - .
 extra-deps:
-- pangraph-0.1.1.5
-resolver: lts-11.3
+- pangraph-0.2.1
+- html-entities-1.1.4.2
+- algebraic-graphs-0.2
+resolver: lts-12.0

test/Main.hs

@@ -7,14 +7,15 @@ import Test.HUnit
 import Pangraph.GraphML.Parser
 import Tuura.Fantasi.VHDL.Writer
 import VHDLLiterals
+import Data.Maybe(fromJust)
 
 main :: IO Counts
 main = runTestTT $ TestList[case1, case2]
 
 case1 :: Test
 case1 = TestCase $ assertEqual "case1: Enviroment Writer N1"
-  enviroFile1 (writeEnvironment $ unsafeParse graphfileN1)
+  enviroFile1 (writeEnvironment $ (fromJust . parse) graphfileN1)
 
 case2 :: Test
 case2 = TestCase $ assertEqual "case2: Graph Writer N1"
-  vhdlGraph1 (writeGraph $ unsafeParse graphfileN1)
+  vhdlGraph1 (writeGraph $ (fromJust . parse) graphfileN1)