1-- Copyright 1994 Grady Booch 2-- Copyright 1998-2014 Simon Wright <simon@pushface.org> 3 4-- This package is free software; you can redistribute it and/or 5-- modify it under terms of the GNU General Public License as 6-- published by the Free Software Foundation; either version 2, or 7-- (at your option) any later version. This package is distributed in 8-- the hope that it will be useful, but WITHOUT ANY WARRANTY; without 9-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A 10-- PARTICULAR PURPOSE. See the GNU General Public License for more 11-- details. You should have received a copy of the GNU General Public 12-- License distributed with this package; see file COPYING. If not, 13-- write to the Free Software Foundation, 59 Temple Place - Suite 14-- 330, Boston, MA 02111-1307, USA. 15 16-- As a special exception, if other files instantiate generics from 17-- this unit, or you link this unit with other files to produce an 18-- executable, this unit does not by itself cause the resulting 19-- executable to be covered by the GNU General Public License. This 20-- exception does not however invalidate any other reasons why the 21-- executable file might be covered by the GNU Public License. 22 23with System.Address_To_Access_Conversions; 24 25package body BC.Graphs.Undirected is 26 27 28 ---------------------- 29 -- Graph operations -- 30 ---------------------- 31 32 procedure Create_Arc (G : in out Graph; 33 A : in out Arc'Class; 34 I : Arc_Item; 35 First : in out Vertex'Class; 36 Second : in out Vertex'Class) is 37 begin 38 Clear (A); 39 A.Rep := new Arc_Node'(Ada.Finalization.Controlled with 40 Item => I, 41 Enclosing => G'Unchecked_Access, 42 From => First.Rep, 43 To => Second.Rep, 44 Next_Incoming => null, 45 Next_Outgoing => null, 46 Count => 1); 47 if Second.Rep /= null then 48 A.Rep.Next_Incoming := Second.Rep.Incoming; 49 Second.Rep.Incoming := A.Rep; 50 A.Rep.Count := A.Rep.Count + 1; 51 Second.Rep.Count := Second.Rep.Count + 1; 52 end if; 53 if First.Rep /= null then 54 A.Rep.Next_Outgoing := First.Rep.Outgoing; 55 First.Rep.Outgoing := A.Rep; 56 A.Rep.Count := A.Rep.Count + 1; 57 First.Rep.Count := First.Rep.Count + 1; 58 end if; 59 end Create_Arc; 60 61 62 ----------------------- 63 -- Vertex operations -- 64 ----------------------- 65 66 function Arity (V : Vertex) return Natural is 67 Count : Natural := 0; 68 Curr : Arc_Node_Ptr; 69 begin 70 if V.Rep = null then 71 raise BC.Is_Null; 72 end if; 73 Curr := V.Rep.Incoming; 74 while Curr /= null loop 75 Count := Count + 1; 76 Curr := Curr.Next_Incoming; 77 end loop; 78 Curr := V.Rep.Outgoing; 79 while Curr /= null loop 80 if Curr.From /= Curr.To then 81 Count := Count + 1; 82 end if; 83 Curr := Curr.Next_Outgoing; 84 end loop; 85 return Count; 86 end Arity; 87 88 89 -------------------- 90 -- Arc operations -- 91 -------------------- 92 93 procedure Set_First_Vertex (A : in out Arc; 94 V : access Vertex'Class) is 95 Prev, Curr : Arc_Node_Ptr; 96 begin 97 if A.Rep = null then 98 raise BC.Is_Null; 99 end if; 100 if A.Rep.From /= null then 101 Prev := null; 102 Curr := A.Rep.From.Outgoing; 103 while Curr /= A.Rep loop 104 Prev := Curr; 105 Curr := Curr.Next_Outgoing; 106 end loop; 107 if Prev = null then 108 A.Rep.From.Outgoing := Curr.Next_Outgoing; 109 else 110 Prev.Next_Outgoing := Curr.Next_Outgoing; 111 end if; 112 A.Rep.From.Count := A.Rep.From.Count - 1; 113 A.Rep.Count := A.Rep.Count - 1; 114 end if; 115 if V.Rep /= null then 116 A.Rep.Next_Outgoing := V.Rep.Outgoing; 117 V.Rep.Outgoing := A.Rep; 118 A.Rep.Count := A.Rep.Count + 1; 119 V.Rep.Count := V.Rep.Count + 1; 120 end if; 121 A.Rep.From := V.Rep; 122 end Set_First_Vertex; 123 124 125 procedure Set_Second_Vertex (A : in out Arc; 126 V : access Vertex'Class) is 127 Prev, Curr : Arc_Node_Ptr; 128 begin 129 if A.Rep = null then 130 raise BC.Is_Null; 131 end if; 132 if A.Rep.To /= null then 133 Prev := null; 134 Curr := A.Rep.To.Incoming; 135 while Curr /= A.Rep loop 136 Prev := Curr; 137 Curr := Curr.Next_Incoming; 138 end loop; 139 if Prev = null then 140 A.Rep.To.Incoming := Curr.Next_Incoming; 141 else 142 Prev.Next_Incoming := Curr.Next_Incoming; 143 end if; 144 A.Rep.To.Count := A.Rep.To.Count - 1; 145 A.Rep.Count := A.Rep.Count - 1; 146 end if; 147 if V.Rep /= null then 148 A.Rep.Next_Incoming := V.Rep.Incoming; 149 V.Rep.Incoming := A.Rep; 150 A.Rep.Count := A.Rep.Count + 1; 151 V.Rep.Count := V.Rep.Count + 1; 152 end if; 153 A.Rep.To := V.Rep; 154 end Set_Second_Vertex; 155 156 157 procedure First_Vertex (A : Arc; 158 V : in out Vertex'Class) is 159 begin 160 if A.Rep = null then 161 raise BC.Is_Null; 162 end if; 163 Clear (V); 164 V.Rep := A.Rep.From; 165 if V.Rep /= null then 166 V.Rep.Count := V.Rep.Count + 1; 167 end if; 168 end First_Vertex; 169 170 171 procedure Second_Vertex (A : Arc; 172 V : in out Vertex'Class) is 173 begin 174 if A.Rep = null then 175 raise BC.Is_Null; 176 end if; 177 Clear (V); 178 V.Rep := A.Rep.To; 179 if V.Rep /= null then 180 V.Rep.Count := V.Rep.Count + 1; 181 end if; 182 end Second_Vertex; 183 184 185 --------------------- 186 -- Graph iterators -- 187 --------------------- 188 189 190 package Graph_Address_Conversions 191 is new System.Address_To_Access_Conversions (Graph); 192 193 function New_Graph_Iterator 194 (For_The_Graph : Graph) return Graph_Iterator'Class is 195 Result : constant Undirected_Graph_Iterator 196 := (For_The_Graph => Graph_Ptr (Graph_Address_Conversions.To_Pointer 197 (For_The_Graph'Address)), 198 Index => For_The_Graph.Rep); 199 begin 200 return Result; 201 end New_Graph_Iterator; 202 203 204 package Vertex_Address_Conversions 205 is new System.Address_To_Access_Conversions (Vertex); 206 207 function New_Vertex_Iterator 208 (For_The_Vertex : Vertex) return Vertex_Iterator'Class is 209 Result : Undirected_Vertex_Iterator; 210 begin 211 Result.For_The_Vertex := 212 Vertex_Ptr (Vertex_Address_Conversions.To_Pointer 213 (For_The_Vertex'Address)); 214 Reset (Result); 215 return Result; 216 end New_Vertex_Iterator; 217 218 219 ------------------------------- 220 -- Private iteration support -- 221 ------------------------------- 222 223 procedure Reset (It : in out Undirected_Graph_Iterator) is 224 begin 225 It.Index := It.For_The_Graph.Rep; 226 end Reset; 227 228 229 procedure Next (It : in out Undirected_Graph_Iterator) is 230 begin 231 if It.Index /= null then 232 It.Index := It.Index.Next; 233 end if; 234 end Next; 235 236 237 function Is_Done (It : Undirected_Graph_Iterator) return Boolean is 238 begin 239 return It.Index = null; 240 end Is_Done; 241 242 243 function Current_Vertex 244 (It : Undirected_Graph_Iterator) return Abstract_Vertex'Class is 245 begin 246 if It.Index = null then 247 raise BC.Is_Null; 248 end if; 249 It.Index.Count := It.Index.Count + 1; 250 return Vertex' 251 (Ada.Finalization.Controlled with Rep => It.Index); 252 end Current_Vertex; 253 254 255 ---------------------- 256 -- Vertex iterators -- 257 ---------------------- 258 259 procedure Reset (It : in out Undirected_Vertex_Iterator) is 260 begin 261 It.Do_Outgoing := True; 262 if It.For_The_Vertex.Rep /= null then 263 It.Index := It.For_The_Vertex.Rep.Outgoing; 264 if It.Index = null then 265 It.Do_Outgoing := False; 266 It.Index := It.For_The_Vertex.Rep.Incoming; 267 -- skip self-directed arcs, already seen in outgoing side 268 -- XXX hmm, wouldn't .Outgoing have been non-null? 269 while It.Index /= null and then It.Index.From = It.Index.To loop 270 pragma Assert (False); 271 It.Index := It.Index.Next_Incoming; 272 end loop; 273 end if; 274 else 275 It.Index := null; 276 end if; 277 end Reset; 278 279 280 procedure Next (It : in out Undirected_Vertex_Iterator) is 281 begin 282 -- XXX I think we ought to check here that there is an Index! 283 if It.Do_Outgoing then 284 It.Index := It.Index.Next_Outgoing; 285 if It.Index = null then 286 It.Do_Outgoing := False; 287 It.Index := It.For_The_Vertex.Rep.Incoming; 288 -- skip self-directed arcs, already seen in outgoing side 289 while It.Index /= null and then It.Index.From = It.Index.To loop 290 It.Index := It.Index.Next_Incoming; 291 end loop; 292 end if; 293 elsif It.Index /= null then 294 It.Index := It.Index.Next_Incoming; 295 -- skip self-directed arcs, already seen in outgoing side 296 while It.Index /= null and then It.Index.From = It.Index.To loop 297 It.Index := It.Index.Next_Incoming; 298 end loop; 299 end if; 300 end Next; 301 302 303 function Is_Done (It : Undirected_Vertex_Iterator) return Boolean is 304 begin 305 return It.Index = null; 306 end Is_Done; 307 308 309 function Current_Arc (It : Undirected_Vertex_Iterator) 310 return Abstract_Arc'Class is 311 begin 312 if It.Index = null then 313 raise BC.Is_Null; 314 end if; 315 It.Index.Count := It.Index.Count + 1; 316 return Arc'(Ada.Finalization.Controlled with Rep => It.Index); 317 end Current_Arc; 318 319 320end BC.Graphs.Undirected; 321