Skip to content

Instantly share code, notes, and snippets.

@BarnabasMarkus

BarnabasMarkus/yolo.hs

Last active May 31, 2018 14:24
Show Gist options
  • Save BarnabasMarkus/61cbbe05a3dbc7bda2471d073fac4dee to your computer and use it in GitHub Desktop.
Save BarnabasMarkus/61cbbe05a3dbc7bda2471d073fac4dee to your computer and use it in GitHub Desktop.
Download ZIP
yolo is a special graph implementation in haskell. it is desinged to model the connections of hashtags in social media.
Raw
yolo.hs
-- :l C:\Users\BMarkus\Dropbox\haskell\yolo.hs
-- | ABOUT YOLO
--
--
module Yolo
( Node
, Edge
, Weight
, WeightedEdge
, Graph (..)
, emptyGraph
, nodeNum
, edgeNum
, size
, nodeExists
, upsNode
, delNode
, nodeEdges
, edgeExists
, upsEdge
, delEdge
, getEdge
, getWeight
, bulk
) where
-- ---------------------------------------------------------------------------
-- | IMPORTS
-- ---------------------------------------------------------------------------
import Data.List
import Data.Semigroup
import Data.Char
-- ---------------------------------------------------------------------------
-- | TYPES
-- ---------------------------------------------------------------------------
type Node = String
type Edge = (Node, Node)
type WeightedEdge = (Node, Node, Weight)
type Weight = Int
type Hashtag = String
-- ---------------------------------------------------------------------------
-- | UNDIRECTED GRAPH DATA STRUCTURE
-- ---------------------------------------------------------------------------
data Graph = Graph
{ nodes :: [Node]
, edges :: [WeightedEdge]
} deriving Eq
instance Show Graph where
show (Graph nodes edges) =
mconcat [ "G { N:", show nodes, " , E:", show edges, " }"]
instance Semigroup Graph where
(<>) graph (Graph nodes edges) =
bulk upsEdge edges $
bulk upsNode nodes graph
instance Monoid Graph where
mempty = emptyGraph
mappend = (<>)
-- ---------------------------------------------------------------------------
-- | GRAPH FUNCTIONS
-- ---------------------------------------------------------------------------
-- | Empty graph
emptyGraph :: Graph
emptyGraph = Graph [] []
-- | Number of nodes
nodeNum :: Graph -> Int
nodeNum = length . nodes
-- | Number of edges
edgeNum :: Graph -> Int
edgeNum = length . edges
-- | 2 dim tuple (nodeNum, edgeNum)
size :: Graph -> (Int, Int)
size graph = (nodeNum graph, edgeNum graph)
-- | True if node is in Graph's nodes
nodeExists :: Node -> Graph -> Bool
nodeExists node (Graph nodes _) = node `elem` nodes
-- | Add new node to graph
upsNode :: Node -> Graph -> Graph
upsNode node (Graph nodes edges) =
Graph nodes' edges
where nodes' = nub $ node : nodes
-- | Delete node from graph
delNode :: Node -> Graph -> Graph
delNode node (Graph nodes edges) =
Graph nodes' edges'
where
nodes' = [ n | n <- nodes , n /= node ]
edges' = [ e | e@(n1,n2,_) <- edges
, n1 /= node && n2 /= node ]
-- | List node's edges
nodeEdges :: Node -> Graph -> [WeightedEdge]
nodeEdges node graph@(Graph nodes edges) =
[edge | edge@(n1, n2, _) <- edges, n1 == node || n2 == node]
-- | Edge existence check
edgeExists :: Edge -> Graph -> Bool
edgeExists edge graph =
if getEdge edge graph == [] then False else True
-- | Upsert edge
upsEdge :: WeightedEdge -> Graph -> Graph
upsEdge edge@(n1, n2, w) graph =
if edgeExists (n1, n2) graph
then updEdge edge graph
else insEdge edge graph
-- | Update existing edge
updEdge :: WeightedEdge -> Graph -> Graph
updEdge edge@(n1, n2, w) graph@(Graph nodes edges) =
let w0 = getWeight . head $ getEdge (n1, n2) graph
in insEdge (n1, n2, w + w0) $ delEdge (n1, n2) graph
-- | Insert new edge
insEdge :: WeightedEdge -> Graph -> Graph
insEdge edge@(n1, n2, w) (Graph nodes edges) =
bulk upsNode [n1, n2] $ Graph nodes (edge : edges)
-- | Delete edge
delEdge :: Edge -> Graph -> Graph
delEdge (n1, n2) (Graph nodes edges) =
Graph nodes edges'
where
edges' = [ edge | edge@(nA, nB, _) <- edges
, not ((nA == n1 && nB == n2) || (nA == n2 && nB == n1))]
-- | Get edge
getEdge :: Edge -> Graph -> [WeightedEdge]
getEdge (n1, n2) (Graph _ edges) =
[ edge | edge@(nA, nB, _) <- edges
, (nA == n1 && nB == n2) || (nA == n2 && nB == n1) ]
-- | Get weight of an edge
getWeight :: WeightedEdge -> Weight
getWeight (_, _, w) = w
-- | Bulk operations on graph
bulk :: (a -> Graph -> Graph) -> [a] -> Graph -> Graph
bulk _ [] graph = graph
bulk func (x:xs) graph = bulk func xs $ func x graph
-- ---------------------------------------------------------------------------
-- | EXAMPLES AND TESTS
-- ---------------------------------------------------------------------------
{-
g :: Graph
g = Graph ["A", "B", "C", "D"] [("A", "B", 3), ("B", "C", 1)]
f :: Graph
f = Graph ["A", "B", "X", "Y"] [("B", "A", 10), ("X", "Y", 1)]
-}
-- ---------------------------------------------------------------------------
-- | HASHTAG (GOES TO DIFF FILE)
-- ---------------------------------------------------------------------------
-- | Get #hashtags from string.
-- Return lowercase #hashtag list
getHashtags :: String -> [Hashtag]
getHashtags post =
nub $ [ map toLower x | x <- words post
, length x > 1
, isPrefixOf "#" x]
-- | Create
edgeGenerator :: [Hashtag] -> [WeightedEdge]
edgeGenerator [] = []
edgeGenerator (x:xs) = [(x,y,1) | y <- xs] ++ edgeGenerator xs
postToGraph :: String -> Graph -> Graph
postToGraph post graph =
bulk upsEdge edges graph
where
hashtags = getHashtags post
edges = edgeGenerator hashtags
post1 :: String
post1 = "#Enjoy this #sunny #summer day #holiday"
post2 :: String
post2 = "#work as much as i can #workaholic"
post3 :: String
post3 = "we are planning our #summer #holiday #fun #exciting"
postx :: String
postx = "this is the #1 post w #2 #3"
posts :: [String]
posts = [post1, post2, post3]
g :: Graph
g = Graph
{ nodes = []
, edges = []
}
h :: Graph
h = bulk postToGraph posts g
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment