-
Notifications
You must be signed in to change notification settings - Fork 2
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Added -a option to alias the largest Node in the graph. #8
base: master
Are you sure you want to change the base?
Changes from all commits
516ace5
68acffe
ba5dc2d
8946a56
eeacba2
251da88
503e813
9b73a89
ae642e6
e2c272d
5c63872
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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> |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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)] |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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?" | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is not a helpful message: the user of FANTASI has no idea what Pangraph is, and what it means for it to be "nothing". Please make this more informative. Furthermore, you still seem to be mixing up parsing and aliasing. Why not parse first, report parse errors, and then alias? It makes the code easier to read. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. You are right, I was thinking as a Pangraph user. I think it I might try to catch Maybe exceptions here. |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This seems to have been used only once, which I guess doesn't make it very useful. I'd just inline it.