SHARE
TWEET

gxl

edv Nov 15th, 2011 122 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Main where
  2.  
  3. import System.Random
  4. import Data.Graph
  5. import Data.List
  6. import Data.Maybe
  7. import qualified GXL as GXL
  8.  
  9. import Text.XML.HaXml.XmlContent
  10. import Text.XML.HaXml.OneOfN
  11.  
  12. type Point = (Int, Int)
  13. type Station = (Point, Int, [Int])
  14.  
  15. gGraph :: Point -> Int -> Int -> Int
  16.           -> IO (Graph, Vertex -> Station, Int -> Maybe Vertex)
  17. gGraph c r n rn = do
  18.     points <- gPoints c r n
  19.     return $ graphFromEdges $ gStations points rn
  20.  
  21. gPoints :: (Int, Int) -> Int -> Int -> IO [Point]
  22. gPoints _ _ 0 = return []
  23. gPoints c r n = do
  24.     point <- gPoint c r
  25.     rest  <- gPoints c r (n-1)
  26.     return $ point : rest
  27.  
  28. gPoint :: (Int, Int) -> Int -> IO Point
  29. gPoint c@(x, y) r = do
  30.     x1 <- randomRIO (x - r, x + r)
  31.     y1 <- randomRIO (y - r, y + r)
  32.     if ((x1-x)^2 + (y1-y)^2 <= r^2)
  33.         then return (x1, y1)
  34.         else gPoint c r
  35.  
  36. gStations :: [Point] -> Int -> [Station]
  37. gStations list range = foldl' (\a e -> a ++ [gStation e list range (length a)]) [] list
  38.   where
  39.     len = length list
  40.  
  41. gStation :: Point -> [Point] -> Int -> Int -> Station
  42. gStation p list range k = (p, k, edges')
  43.   where
  44.     edges' :: [Int]
  45.     edges' = foldr (\e a ->
  46.         if (chDistance p e range)
  47.             then (fromMaybe (-1) $ elemIndex e list) : a
  48.             else a
  49.         ) [] $ drop (k+1) list
  50.  
  51. chDistance :: Point -> Point -> Int -> Bool
  52. chDistance (x1,y1) (x2,y2) r = d <= (4*(r^2))
  53.   where
  54.     d = ((x2-x1)^2) + ((y2-y1)^2)
  55.  
  56. toGXL :: (Graph, Vertex -> Station, Int -> Maybe Vertex)
  57.          -> Int
  58.          -> GXL.Gxl
  59. toGXL (g, v, n) range = GXL.Gxl (GXL.Gxl_Attrs $ Default "") $ GXL.Graph
  60.     (GXL.Graph_Attrs "stacje" Nothing
  61.         (NonDefault GXL.Graph_edgeids_false)
  62.         (NonDefault GXL.Graph_hypergraph_false)
  63.         (NonDefault GXL.Graph_edgemode_defaultundirected))
  64.     Nothing
  65.     []
  66.     ((toNodes (vertices g) v range) ++ (toEdges (vertices g) v)) : []
  67.  
  68. toNodes :: [Vertex] -> (Vertex -> Station) -> Int
  69.            -> [(OneOf3 GXL.Node GXL.Edge GXL.Rel)]
  70. toNodes vert v range = foldr (\e a ->
  71.     (OneOf3 $ GXL.Node
  72.         (GXL.Node_Attrs $ nodeid $ v e)
  73.         Nothing
  74.         [ GXL.Attr (GXL.Attr_Attrs Nothing "range" Nothing) []
  75.             $ ThreeOf10 $ GXL.AInt $ show range
  76.         , GXL.Attr (GXL.Attr_Attrs Nothing "center" Nothing) []
  77.             $ FiveOf10 $ GXL.AString $ center $ v e
  78.         ]
  79.         []
  80.         ):a) [] vert
  81.   where
  82.     nodeid (_, a, _) = show a
  83.     center (a, _, _) = show a
  84.  
  85. toEdges :: [Vertex] -> (Vertex -> Station)
  86.            -> [(OneOf3 GXL.Node GXL.Edge GXL.Rel)]
  87. toEdges vert v = foldr (\ee a -> (foldr (\e aa ->
  88.     (TwoOf3 $ GXL.Edge
  89.         (GXL.Edge_Attrs
  90.             Nothing
  91.             (show $ key' $ v ee)
  92.             (show e)
  93.             Nothing
  94.             Nothing
  95.             Nothing )
  96.         Nothing
  97.         []
  98.         []
  99.     ):aa) [] $ edges' $ v ee)++a) [] vert
  100.   where
  101.     edges' (_, _, a) = a
  102.     key' (_,k,_) = k
  103.  
  104. main = do
  105.     putStrLn "Podaj współrzędne środka (x,y): "
  106.     center <- getLine
  107.     putStrLn "Podaj promień koła: "
  108.     radius <- getLine
  109.     putStrLn "Podaj liczbę stacji: "
  110.     num <- getLine
  111.     putStrLn "Podaj zasięg stacji: "
  112.     range <- getLine
  113.     graph <- gGraph ((read center)::(Int,Int))
  114.                     ((read radius)::Int)
  115.                     ((read num)::Int)
  116.                     ((read range)::Int)
  117.     putStrLn $ showXml False $ toGXL graph ((read range)::Int)
RAW Paste Data
Top