IO.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.PlaneGraph.IO
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Converting from/to Adjacency Representation of the plane graph
--
--------------------------------------------------------------------------------
module Data.PlaneGraph.IO where

import           Control.Lens
import           Control.Monad (forM_)
import           Data.Aeson
import           Data.Bifunctor
import qualified Data.ByteString as B
import           Data.Ext
import           Data.Geometry.Point
import qualified Data.List as List
import qualified Data.PlanarGraph.AdjRep as PGA
import qualified Data.PlanarGraph.IO as PGIO
import           Data.PlaneGraph.Core
import           Data.PlaneGraph.AdjRep (Face,Vtx(Vtx),Gr(Gr))
import           Data.Proxy
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import           Data.Yaml (ParseException)
import           Data.Yaml.Util

--------------------------------------------------------------------------------

-- $setup
-- >>> import Data.PlanarGraph.Dart
-- >>> import Data.PlanarGraph.AdjRep(Face(..))
-- >>> :{
-- let dart i s = Dart (Arc i) (read s)
--     small :: Gr (Vtx Int String Int) (Face String)
--     small = Gr [ Vtx 0 (Point2 0 0) [ (2,"0->2")
--                                     , (1,"0->1")
--                                     , (3,"0->3")
--                                     ] 0
--                , Vtx 1 (Point2 2 2) [ (0,"1->0")
--                                     , (2,"1->2")
--                                     , (3,"1->3")
--                                     ] 1
--                , Vtx 2 (Point2 2 0) [ (0,"2->0")
--                                     , (1,"2->1")
--                                     ] 2
--                , Vtx 3 (Point2 (-1) 4) [ (0,"3->0")
--                                        , (1,"3->1")
--                                        ] 3
--                ]
--                [ Face (2,1) "OuterFace"
--                , Face (0,1) "A"
--                , Face (1,0) "B"
--                ]
--     smallG = fromAdjRep (Proxy :: Proxy ()) small
-- :}
--
--
-- This represents the following graph. Note that the graph is undirected, the
-- arrows are just to indicate what the Positive direction of the darts is.
--
-- ![myGraph](docs/Data/PlaneGraph/small.png)

--------------------------------------------------------------------------------
-- * Reading and Writing the Plane Graph

-- | Reads a plane graph from a bytestring
readPlaneGraph   :: (FromJSON v, FromJSON e, FromJSON f, FromJSON r)
                 => proxy s -> B.ByteString
                 -> Either ParseException (PlaneGraph s v e f r)
readPlaneGraph _ = decodeYaml

-- | Writes a plane graph to a bytestring
writePlaneGraph :: (ToJSON v, ToJSON e, ToJSON f, ToJSON r)
                => PlaneGraph s v e f r -> B.ByteString
writePlaneGraph = encodeYaml

--------------------------------------------------------------------------------

instance (ToJSON v, ToJSON e, ToJSON f, ToJSON r) => ToJSON (PlaneGraph s v e f r) where
  toEncoding = toEncoding . toAdjRep
  toJSON     = toJSON     . toAdjRep

instance (FromJSON v, FromJSON e, FromJSON f, FromJSON r)
         => FromJSON (PlaneGraph s v e f r) where
  parseJSON v = fromAdjRep (Proxy :: Proxy s) <$> parseJSON v

--------------------------------------------------------------------------------

-- | Transforms the planar graph into a format taht can be easily converted
-- into JSON format. For every vertex, the adjacent vertices are given in
-- counter clockwise order.
--
-- See 'toAdjacencyLists' for notes on how we handle self-loops.
--
-- running time: \(O(n)\)
toAdjRep :: PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
toAdjRep = first (\(PGA.Vtx v aj (VertexData p x)) -> Vtx v p aj x) . PGIO.toAdjRep
         .  view graph

fromAdjRep    :: proxy s -> Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
fromAdjRep px = PlaneGraph . PGIO.fromAdjRep px
              . first (\(Vtx v p aj x) -> PGA.Vtx v aj $ VertexData p x)

--------------------------------------------------------------------------------

-- | Orders the adjacencylists of a plane graph (with \(n\) vertices) (in Adj
-- repr) so that they are all counter-clockwise around the vertices.
--
-- running time: \(O(n \log n)\)
makeCCW            :: (Num r, Ord r) => Gr (Vtx v e r) f -> Gr (Vtx v e r) f
makeCCW (Gr vs fs) = Gr (map sort' vs) fs
  where
    -- create an array that we can use to lookup the vertex locations in constant time.
    location' = V.create $ do
                   a <- MV.new (length vs)
                   forM_ vs $ \(Vtx i p _ _) ->
                     MV.write a i $ ext p
                   pure a
    -- sort the adjacencies around every vertex v
    sort' (Vtx v p ajs x) = Vtx v p (List.sortBy (around p) ajs) x
    around p (a,_) (b,_) = ccwCmpAround (ext p) (location' V.! a) (location' V.! b)

--------------------------------------------------------------------------------