yolo is a special graph implementation in haskell. it is desinged to model the connections of hashtags in social media.

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