• API
• FAQ
• Tools
• Trends
• Archive
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: "
117.     putStrLn $showXml False$ toGXL graph ((read range)::Int)