diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0d7ee0f --- /dev/null +++ b/.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 diff --git a/fantasi.cabal b/fantasi.cabal index 4291c9a..2ca3171 100644 --- a/fantasi.cabal +++ b/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 diff --git a/n1.graphml b/n1.graphml new file mode 100644 index 0000000..d5a772e --- /dev/null +++ b/n1.graphml @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Tuura/Fantasi/HubRewrite.hs b/src/Tuura/Fantasi/HubRewrite.hs new file mode 100644 index 0000000..a2eb14e --- /dev/null +++ b/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)] \ No newline at end of file diff --git a/src/fantasi/Tuura/Fantasi/Main.hs b/src/fantasi/Tuura/Fantasi/Main.hs index 92a7e00..9a78cd8 100644 --- a/src/fantasi/Tuura/Fantasi/Main.hs +++ b/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,9 +17,13 @@ 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 @@ -24,3 +31,12 @@ main = do 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?" diff --git a/src/fantasi/Tuura/Fantasi/Options.hs b/src/fantasi/Tuura/Fantasi/Options.hs index d1a62f5..2ca5201 100644 --- a/src/fantasi/Tuura/Fantasi/Options.hs +++ b/src/fantasi/Tuura/Fantasi/Options.hs @@ -11,7 +11,8 @@ data Options = Options , optVersion :: Bool , optGraphML :: FilePath , optGraphName :: FilePath - , optSimName :: FilePath } + , optSimName :: FilePath + , optAliasHub :: Bool } defaultOptions :: Options defaultOptions = Options @@ -19,7 +20,8 @@ defaultOptions = Options , 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 diff --git a/stack.yaml b/stack.yaml index 63314d5..7f435bc 100644 --- a/stack.yaml +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index 7395953..d681f50 100644 --- a/test/Main.hs +++ b/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)