1------------------------------------------------------------------------------ 2-- GtkAda - Ada95 binding for Gtk+/Gnome -- 3-- -- 4-- Copyright (C) 2014-2015, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24with Ada.Containers.Doubly_Linked_Lists; 25with Ada.Tags; use Ada.Tags; 26with Ada.Unchecked_Deallocation; 27with GNAT.Heap_Sort_G; 28 29package body Glib.Graphs.Layouts is 30 31 Preferred_Length : constant := 1; 32 -- Number of layers between edge ends (this is for future extension, so 33 -- that some edges might be forced to span layers. 34 35 Add_Dummy_Nodes : constant Boolean := True; 36 -- Whether to add dummy (invisible node) for edges that span multiple 37 -- layers. 38 39 Dummy_Node_Size : constant Gdouble := 4.0; 40 -- Size of the dummy nodes (since we also have margins, we might as well 41 -- keep those nodes small). 42 43 Default_Layer : constant Integer := 0; 44 45 type Integer_Array is array (Integer range <>) of Integer; 46 type Integer_Array_Access is access Integer_Array; 47 -- maps vertices to some data 48 49 procedure Make_Acyclic (G : in out Graph); 50 -- Make sure the graph is acyclic 51 52 package Vertex_Lists is new Ada.Containers.Doubly_Linked_Lists 53 (Vertex_Access); 54 use Vertex_Lists; 55 type Layer_Info_Array is array (Integer range <>) of Vertex_Lists.List; 56 type Layer_Info_Array_Access is access Layer_Info_Array; 57 58 type Layout_Info is record 59 Horizontal : Boolean; 60 Space_Between_Layers : Gdouble; 61 Space_Between_Items : Gdouble; 62 63 Min_Layer, Max_Layer : Integer; 64 65 In_Layers : Layer_Info_Array_Access; 66 -- The ordered list of items in each layer 67 68 Layers : Integer_Array_Access; 69 -- For each vertex, its assigned layer 70 end record; 71 72 procedure Free (Self : in out Layout_Info); 73 -- Free memory used by Self 74 75 function Slack (Info : Layout_Info; Edge : Edge_Access) return Integer; 76 -- Returns the slack for an edge. When greater than 0, the edge could 77 -- be tightened to lead to a nicer layer 78 79 function Layer (Info : Layout_Info; V : Vertex_Access) return Integer; 80 -- Return the layer for a vertex 81 82 procedure Adjust_Positions 83 (G : Graph; 84 Info : Layout_Info); 85 -- Adjust the position of the items within their layer. 86 -- Items must hav already been ordered, and they are moved a little so that 87 -- they tend to align with their parent and child nodes 88 89 procedure Sort_Nodes_Within_Layers 90 (G : Graph; 91 Info : in out Layout_Info); 92 -- Sort the nodes within each layer so as to minimize crossing of edges. 93 -- To do this, we use a Median or Barycenter Heuristic. 94 -- This is also similar to what graphize uses to reorder nodes within a 95 -- layer to minimize edge crossing. See for instance: 96 -- "The barycenter Heuristic and the reorderable matrix" 97 -- Erkki Makinen, Harri Siirtola 98 -- http://www.informatica.si/PDF/29-3/ 99 -- 13_Makinen-The%20Barycenter%20Heuristic....pdf 100 -- 101 -- See also 102 -- http://www.graphviz.org/Documentation/TSE93.pdf 103 -- 104 -- Basically, for each layer, we order the nodes based on the barycenter 105 -- of their neighbor nodes, and repeat for each layer. 106 107 type Weight_Info is record 108 Weight : Gdouble; 109 Vertex : Vertex_Access; 110 end record; 111 type Weight_Array is array (Integer range <>) of Weight_Info; 112 113 procedure Sort (W : in out Weight_Array); 114 -- sort the array by weight 115 -- Precondition: W'First = 0 116 -- Sorts 1 .. W'Last elements 117 118 procedure Init_Rank 119 (G : Graph; 120 Info : in out Layout_Info); 121 -- Computes an initial feasible ranking (i.e where nodes are 122 -- organized such that children nodes are in layers higher than their 123 -- parents). This always assigns root nodes (with no in-edges) to 124 -- layer 0. This might result in non-tight edges, for instance: 125 -- /--F 126 -- A -> B -> C -> D 127 -- E -----------/ 128 -- 129 -- ??? This algorithm requires computation of in-edges, which is 130 -- not always available for all types of graphs. Seems that we could 131 -- replace it with a DFS, where leaf nodes are assigned to layer 0 132 -- (so the ordering would be different, but since we are tightening 133 -- edges afterward it doesn't really matter). 134 135 procedure Organize_Nodes 136 (G : Graph; 137 Info : in out Layout_Info); 138 -- Compute the position of nodes within each layer. 139 -- We provide an initial ordering for elements: starting from nodes 140 -- at the lowest layer (rightmost or topmost item depending on 141 -- layout), we do a breadth-first-search, and add each child in to 142 -- its respective layer. This ensures that for the spanning tree at 143 -- least there are no edge crossings. 144 145 procedure Rank_Items (G : in out Graph; Info : in out Layout_Info); 146 -- Compute the layer for each item 147 148 ---------- 149 -- Tree -- 150 ---------- 151 152 package Edge_Lists is new Ada.Containers.Doubly_Linked_Lists (Edge_Access); 153 use Edge_Lists; 154 155 type Edge_Array is array (Integer range <>) of Edge_Lists.List; 156 157 type Tree (Max_Index : Natural) is record 158 Node_Count : Natural := 0; 159 160 Node_In_Tree : Integer_Array (Min_Vertex_Index .. Max_Index) := 161 (others => -1); 162 -- This is used to test whether the corresponding node from the graph is 163 -- in the tree. 164 -- Since the graph might include several disjoint components, the value 165 -- in this array indicates which component the node is part of. 166 167 Edges : Edge_Array (Min_Vertex_Index .. Max_Index); 168 -- For each vertex, the list of tree edges that start from it. 169 170 Disjoint_Components : Natural := 0; 171 -- Number of disjoint sets in thetree 172 end record; 173 -- A spanning tree for the graph. 174 175 procedure Add_Edge (Self : in out Tree; E : Edge_Access); 176 procedure Add_Vertex (Self : in out Tree; V : Vertex_Access); 177 -- Add a new edge or vertex to the tree. 178 179 function In_Tree (Self : Tree; V : Vertex_Access) return Boolean; 180 -- Whether the vertex is already in the tree 181 182 function Is_Spanning (Self : Tree) return Boolean; 183 -- Whether all nodes are in the tree (i.e we have a full spanning tree for 184 -- the graph). 185 186 procedure Normalize_Layers (Spanning : Tree; Info : in out Layout_Info); 187 -- Normalize the layers so that each independenct component starts at 188 -- layer 0. This leads to nicer layout, since independent components 189 -- are aligned 190 191 procedure Feasible_Tree 192 (G : Graph; 193 Info : in out Layout_Info; 194 Spanning : out Tree); 195 -- Computes an initial feasible tree. This is a spanning tree for the 196 -- graph so that all of its edges are tight (which for instance will 197 -- tighten the link E->D in the example above). 198 -- This changes layer assignment for the vertices. 199 200 ---------- 201 -- Free -- 202 ---------- 203 204 procedure Free (Self : in out Layout_Info) is 205 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 206 (Integer_Array, Integer_Array_Access); 207 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 208 (Layer_Info_Array, Layer_Info_Array_Access); 209 210 begin 211 Unchecked_Free (Self.In_Layers); 212 Unchecked_Free (Self.Layers); 213 end Free; 214 215 ----------- 216 -- Slack -- 217 ----------- 218 219 function Slack (Info : Layout_Info; Edge : Edge_Access) return Integer is 220 begin 221 return Info.Layers (Get_Index (Get_Dest (Edge))) 222 - Info.Layers (Get_Index (Get_Src (Edge))) 223 - Preferred_Length; 224 end Slack; 225 226 ----------- 227 -- Layer -- 228 ----------- 229 230 function Layer (Info : Layout_Info; V : Vertex_Access) return Integer is 231 begin 232 if V.all in Base_Dummy_Vertex'Class then 233 return Base_Dummy_Vertex (V.all).Layer; 234 else 235 return Info.Layers (Get_Index (V)); 236 end if; 237 end Layer; 238 239 -------------- 240 -- Add_Edge -- 241 -------------- 242 243 procedure Add_Edge (Self : in out Tree; E : Edge_Access) is 244 Sindex : constant Integer := Get_Index (Get_Src (E)); 245 begin 246 Add_Vertex (Self, Get_Src (E)); 247 Add_Vertex (Self, Get_Dest (E)); 248 Self.Edges (Sindex).Append (E); 249 end Add_Edge; 250 251 ---------------- 252 -- Add_Vertex -- 253 ---------------- 254 255 procedure Add_Vertex (Self : in out Tree; V : Vertex_Access) is 256 begin 257 if not In_Tree (Self, V) then 258 Self.Node_Count := Self.Node_Count + 1; 259 Self.Node_In_Tree (Get_Index (V)) := Self.Disjoint_Components; 260 end if; 261 end Add_Vertex; 262 263 ------------- 264 -- In_Tree -- 265 ------------- 266 267 function In_Tree (Self : Tree; V : Vertex_Access) return Boolean is 268 begin 269 return Self.Node_In_Tree (Get_Index (V)) /= -1; 270 end In_Tree; 271 272 ----------------- 273 -- Is_Spanning -- 274 ----------------- 275 276 function Is_Spanning (Self : Tree) return Boolean is 277 begin 278 return Self.Node_Count = Self.Node_In_Tree'Length; 279 end Is_Spanning; 280 281 ------------------ 282 -- Make_Acyclic -- 283 ------------------ 284 285 procedure Make_Acyclic (G : in out Graph) is 286 Acyclic : aliased Boolean; 287 Sorted : constant Depth_Vertices_Array := Depth_First_Search 288 (G => G, 289 Acyclic => Acyclic'Access, 290 Reverse_Edge_Cb => Revert_Edge'Access); 291 pragma Unreferenced (Sorted); 292 begin 293 null; 294 end Make_Acyclic; 295 296 ---------- 297 -- Sort -- 298 ---------- 299 300 procedure Sort (W : in out Weight_Array) is 301 procedure Move (From, To : Natural); 302 function Lt (Op1, Op2 : Natural) return Boolean; 303 304 procedure Move (From, To : Natural) is 305 begin 306 W (To) := W (From); 307 end Move; 308 309 function Lt (Op1, Op2 : Natural) return Boolean is 310 begin 311 return W (Op1).Weight < W (Op2).Weight; 312 end Lt; 313 314 package HS is new GNAT.Heap_Sort_G (Move, Lt); 315 begin 316 HS.Sort (W'Last); 317 end Sort; 318 319 ---------------------- 320 -- Normalize_Layers -- 321 ---------------------- 322 323 procedure Normalize_Layers (Spanning : Tree; Info : in out Layout_Info) is 324 Min_Layer : Integer_Array (1 .. Spanning.Disjoint_Components) := 325 (others => Integer'Last); 326 -- The minimal layer used for each of the independent components 327 328 Component : Integer; 329 begin 330 for V in Spanning.Node_In_Tree'Range loop 331 Component := Spanning.Node_In_Tree (V); 332 Min_Layer (Component) := 333 Integer'Min (Min_Layer (Component), Info.Layers (V)); 334 end loop; 335 336 for V in Spanning.Node_In_Tree'Range loop 337 Component := Spanning.Node_In_Tree (V); 338 Info.Layers (V) := Info.Layers (V) - Min_Layer (Component); 339 end loop; 340 end Normalize_Layers; 341 342 ------------------------------ 343 -- Sort_Nodes_Within_Layers -- 344 ------------------------------ 345 346 procedure Sort_Nodes_Within_Layers 347 (G : Graph; 348 Info : in out Layout_Info) 349 is 350 Max_Iterations : constant := 8; 351 Max_I : constant Integer := Max_Index (G); 352 Position : Integer_Array (Min_Vertex_Index .. Max_I); 353 354 procedure Do_Iteration (Layer : Integer; Downward : Boolean); 355 procedure Do_Iteration (Layer : Integer; Downward : Boolean) is 356 Weights : Weight_Array (0 .. Max_I + 1); 357 C : Vertex_Lists.Cursor := Info.In_Layers (Layer).First; 358 Src, Dest : Vertex_Access; 359 Current_C : Integer := Weights'First + 1; 360 Eit : Edge_Iterator; 361 Total, Count : Integer; 362 begin 363 while Has_Element (C) loop 364 Dest := Element (C); 365 Total := 0; 366 Count := 0; 367 368 if Downward then 369 Eit := First (G, Src => Dest); 370 else 371 Eit := First (G, Dest => Dest); 372 end if; 373 374 while not At_End (Eit) loop 375 if Downward then 376 Src := Get_Dest (Get (Eit)); 377 else 378 Src := Get_Src (Get (Eit)); 379 end if; 380 381 -- ignore self-links. 382 -- Only take into account tight edges (where nodes are in 383 -- adjacent layers), which is the default if we added dummy 384 -- nodes. 385 386 if Src /= Dest 387 and then (Add_Dummy_Nodes 388 or else Slack (Info, Get (Eit)) = 0) 389 then 390 Total := Total + Position (Get_Index (Src)); 391 Count := Count + 1; 392 end if; 393 394 Next (Eit); 395 end loop; 396 397 if Count = 0 then 398 -- leave the item in place 399 Weights (Current_C) := 400 (Gdouble (Position (Get_Index (Dest))), Dest); 401 else 402 Weights (Current_C) := 403 (Gdouble (Total) / Gdouble (Count), Dest); 404 end if; 405 406 Current_C := Current_C + 1; 407 Next (C); 408 end loop; 409 410 -- Now sort based on weights 411 412 Sort (Weights (0 .. Current_C - 1)); 413 Info.In_Layers (Layer).Clear; 414 for W in 1 .. Current_C - 1 loop 415 Position (Get_Index (Weights (W).Vertex)) := W; 416 Info.In_Layers (Layer).Append (Weights (W).Vertex); 417 end loop; 418 end Do_Iteration; 419 420 C : Vertex_Lists.Cursor; 421 Current_C : Integer; 422 423 begin 424 -- Store the position of elements within each layer 425 426 for L in Info.In_Layers'Range loop 427 C := Info.In_Layers (L).First; 428 Current_C := 1; 429 while Has_Element (C) loop 430 Position (Get_Index (Element (C))) := Current_C; 431 Current_C := Current_C + 1; 432 Next (C); 433 end loop; 434 end loop; 435 436 for Iteration in 0 .. Max_Iterations - 1 loop 437 if Iteration mod 2 = 0 then 438 for L in reverse Info.In_Layers'First .. Info.In_Layers'Last - 1 439 loop 440 Do_Iteration (L, Downward => True); 441 end loop; 442 else 443 for L in Info.In_Layers'First + 1 .. Info.In_Layers'Last loop 444 Do_Iteration (L, Downward => False); 445 end loop; 446 end if; 447 end loop; 448 end Sort_Nodes_Within_Layers; 449 450 ---------------------- 451 -- Adjust_Positions -- 452 ---------------------- 453 454 procedure Adjust_Positions 455 (G : Graph; 456 Info : Layout_Info) 457 is 458 type Box is record 459 X, Y, W, H : Gdouble; 460 Space_After : Gdouble; -- between item and the next 461 end record; 462 Boxes : array (Min_Vertex_Index .. Max_Index (G)) of Box; 463 464 procedure Do_Iteration (Layer : Integer; Downward : Boolean); 465 procedure Do_Iteration (Layer : Integer; Downward : Boolean) is 466 C : Vertex_Lists.Cursor := Info.In_Layers (Layer).First; 467 Lowest : Gdouble := Gdouble'First; 468 Highest : Gdouble; 469 Total : Gdouble; 470 Count : Integer; 471 New_Pos : Gdouble; 472 Src : Vertex_Access; 473 Eit : Edge_Iterator; 474 Current, Next_Item : Vertex_Access; 475 Current_B : Box; -- size for Current 476 Next_B : Box; -- size for Next_Item 477 Child_B : Box; 478 begin 479 if Has_Element (C) then 480 Next_Item := Element (C); 481 Next_B := Boxes (Get_Index (Next_Item)); 482 end if; 483 484 while Next_Item /= null loop 485 Total := 0.0; 486 Count := 0; 487 488 -- Find the range of coordinates allowed for the current item 489 490 Current := Next_Item; 491 Current_B := Next_B; 492 493 Next (C); 494 if Has_Element (C) then 495 Next_Item := Element (C); 496 Next_B := Boxes (Get_Index (Next_Item)); 497 498 if Info.Horizontal then 499 Highest := Next_B.Y; 500 else 501 Highest := Next_B.X; 502 end if; 503 else 504 Next_Item := null; 505 Highest := Gdouble'Last; 506 end if; 507 508 -- Now take a look at all its neighbors, either in previous 509 -- or later layers, depending on the iteration 510 511 if Downward then 512 Eit := First (G, Src => Current); 513 else 514 Eit := First (G, Dest => Current); 515 end if; 516 517 while not At_End (Eit) loop 518 if Downward then 519 Src := Get_Dest (Get (Eit)); 520 else 521 Src := Get_Src (Get (Eit)); 522 end if; 523 524 -- ignore self-links. 525 -- Only take into account tight edges (where nodes are in 526 -- adjacent layers), which is the default if we added dummy 527 -- nodes. 528 529 if Src /= Current 530 and then (Add_Dummy_Nodes 531 or else Slack (Info, Get (Eit)) = 0) 532 then 533 Child_B := Boxes (Get_Index (Src)); 534 Count := Count + 1; 535 536 if Info.Horizontal then 537 Total := Total + Child_B.Y + Child_B.H / 2.0; 538 else 539 Total := Total + Child_B.X + Child_B.W / 2.0; 540 end if; 541 end if; 542 543 Next (Eit); 544 end loop; 545 546 if Count /= 0 then 547 New_Pos := Total / Gdouble (Count); 548 549 if Info.Horizontal then 550 -- When we compute the highest possible position, we 551 -- do not include space_between_items. This gives a 552 -- chance to still move a vertex that would be blocked 553 -- between two others (which will also move the next 554 -- vertices) 555 556 New_Pos := New_Pos - Current_B.H / 2.0; 557 New_Pos := Gdouble'Min (New_Pos, Highest - Current_B.H); 558 559 else 560 New_Pos := New_Pos - Current_B.W / 2.0; 561 New_Pos := Gdouble'Min (New_Pos, Highest - Current_B.W); 562 end if; 563 else 564 if Info.Horizontal then 565 New_Pos := Current_B.Y; 566 else 567 New_Pos := Current_B.X; 568 end if; 569 end if; 570 571 New_Pos := Gdouble'Max (Lowest, New_Pos); 572 573 if Info.Horizontal then 574 Boxes (Get_Index (Current)).Y := New_Pos; 575 Lowest := New_Pos + Current_B.H + Current_B.Space_After; 576 else 577 Boxes (Get_Index (Current)).X := New_Pos; 578 Lowest := New_Pos + Current_B.W + Current_B.Space_After; 579 end if; 580 end loop; 581 end Do_Iteration; 582 583 C2 : Vertex_Lists.Cursor; 584 Pos : Gdouble := 0.0; 585 Lowest : Gdouble; 586 Max_Size : Gdouble; 587 V : Vertex_Access; 588 Current_B : Box; -- size for Current 589 begin 590 -- Compute the coordinates for each layer, and an initial position for 591 -- items within each layer. 592 593 for P in Info.In_Layers'Range loop 594 Lowest := 0.0; 595 Max_Size := 0.0; 596 597 C2 := Info.In_Layers (P).First; 598 while Has_Element (C2) loop 599 V := Element (C2); 600 601 if V.all in Base_Dummy_Vertex'Class then 602 Current_B.W := Dummy_Node_Size; 603 Current_B.H := Dummy_Node_Size; 604 Current_B.Space_After := 0.0; 605 else 606 Get_Size (V, Width => Current_B.W, Height => Current_B.H); 607 Current_B.Space_After := Info.Space_Between_Items; 608 end if; 609 610 if Info.Horizontal then 611 Max_Size := Gdouble'Max (Max_Size, Current_B.W); 612 Current_B.X := Pos; 613 Current_B.Y := Lowest; 614 Lowest := Lowest + Current_B.H + Current_B.Space_After; 615 else 616 Max_Size := Gdouble'Max (Max_Size, Current_B.H); 617 Current_B.X := Lowest; 618 Current_B.Y := Pos; 619 Lowest := Lowest + Current_B.W + Current_B.Space_After; 620 end if; 621 622 Boxes (Get_Index (V)) := Current_B; 623 624 Next (C2); 625 end loop; 626 627 Pos := Pos + Max_Size + Info.Space_Between_Layers; 628 end loop; 629 630 -- Try to adjust position of nodes to align with parents and children 631 632 for Iteration in 0 .. 8 loop 633 if Iteration mod 2 = 0 then 634 for P in 635 reverse Info.In_Layers'First .. Info.In_Layers'Last - 1 636 loop 637 Do_Iteration (P, Downward => True); 638 end loop; 639 else 640 for P in Info.In_Layers'First + 1 .. Info.In_Layers'Last loop 641 Do_Iteration (P, Downward => False); 642 end loop; 643 end if; 644 end loop; 645 646 declare 647 Vit : Vertex_Iterator := First (G); 648 V : Vertex_Access; 649 begin 650 while not At_End (Vit) loop 651 V := Get (Vit); 652 if V'Tag /= Base_Dummy_Vertex'Tag then 653 Current_B := Boxes (Get_Index (V)); 654 Set_Position (V, Current_B.X, Current_B.Y); 655 end if; 656 Next (Vit); 657 end loop; 658 end; 659 end Adjust_Positions; 660 661 --------------- 662 -- Init_Rank -- 663 --------------- 664 665 procedure Init_Rank 666 (G : Graph; 667 Info : in out Layout_Info) 668 is 669 Max_I : constant Integer := Max_Index (G); 670 Vit : Vertex_Iterator := First (G); 671 Queue : array (0 .. Max_I) of Vertex_Access; 672 Q_Index : Integer := Queue'First; 673 Q_Last : Integer := Queue'First; 674 -- The queue of nodes to visit 675 676 S, D : Vertex_Access; 677 In_Degree : array (0 .. Max_I) of Integer := (others => 0); 678 -- Number of remaining in-edges that have not been analyzed for 679 -- each node. 680 681 Layer : Integer; 682 Eit : Edge_Iterator; 683 Edge : Edge_Access; 684 Deg : Natural; 685 begin 686 Info.Min_Layer := Default_Layer; 687 Info.Max_Layer := Default_Layer; 688 689 while not At_End (Vit) loop 690 S := Get (Vit); 691 692 Deg := 0; 693 Eit := First (G, Dest => S); 694 while not At_End (Eit) loop 695 -- Ignore self links 696 if Get_Src (Get (Eit)) /= S then 697 Deg := Deg + 1; 698 end if; 699 Next (Eit); 700 end loop; 701 702 In_Degree (Get_Index (S)) := Deg; 703 if In_Degree (Get_Index (S)) = 0 then 704 Queue (Q_Last) := S; 705 Q_Last := Q_Last + 1; 706 end if; 707 Next (Vit); 708 end loop; 709 710 while Q_Index < Q_Last loop 711 S := Queue (Q_Index); 712 Q_Index := Q_Index + 1; 713 714 -- Compute layer based on ancestors' own layers 715 716 Layer := Default_Layer; 717 Eit := First (G, Dest => S); 718 while not At_End (Eit) loop 719 Edge := Get (Eit); 720 Layer := Integer'Max 721 (Layer, 722 Info.Layers (Get_Index (Get_Src (Edge))) 723 + Preferred_Length); 724 Next (Eit); 725 end loop; 726 727 Info.Layers (Get_Index (S)) := Layer; 728 Info.Max_Layer := Integer'Max (Info.Max_Layer, Layer); 729 730 -- Mark all outgoing edges as scanned, which might lead to new 731 -- nodes to analyze. 732 733 Eit := First (G, Src => S); 734 while not At_End (Eit) loop 735 Edge := Get (Eit); 736 D := Get_Dest (Edge); 737 In_Degree (Get_Index (D)) := In_Degree (Get_Index (D)) - 1; 738 if In_Degree (Get_Index (D)) = 0 then 739 Queue (Q_Last) := D; 740 Q_Last := Q_Last + 1; 741 end if; 742 Next (Eit); 743 end loop; 744 end loop; 745 end Init_Rank; 746 747 -------------------- 748 -- Organize_Nodes -- 749 -------------------- 750 751 procedure Organize_Nodes 752 (G : Graph; 753 Info : in out Layout_Info) 754 is 755 Nodes : constant Depth_Vertices_Array := Depth_First_Search (G); 756 V : Vertex_Access; 757 begin 758 Info.In_Layers := new Layer_Info_Array 759 (Info.Min_Layer .. Info.Max_Layer); 760 761 for N in Nodes'Range loop 762 V := Nodes (N).Vertex; 763 Info.In_Layers (Layer (Info, V)).Append (V); 764 end loop; 765 766 Sort_Nodes_Within_Layers (G, Info); 767 Adjust_Positions (G, Info); 768 end Organize_Nodes; 769 770 ------------------- 771 -- Feasible_Tree -- 772 ------------------- 773 774 procedure Feasible_Tree 775 (G : Graph; 776 Info : in out Layout_Info; 777 Spanning : out Tree) 778 is 779 function Add_Edge_And_Recurse 780 (E : Edge_Access; V : Vertex_Access) return Boolean; 781 function Search (V : Vertex_Access) return Boolean; 782 -- These functions return True if the tree is complete at this 783 -- point, and therefore we should stop searching. 784 785 procedure Add_Adjacent_Edge; 786 -- Add one adjacent edge to the tree, and change vertex layers to 787 -- tighten that edge 788 789 -------------------------- 790 -- Add_Edge_And_Recurse -- 791 -------------------------- 792 793 function Add_Edge_And_Recurse 794 (E : Edge_Access; V : Vertex_Access) return Boolean 795 is 796 begin 797 if not In_Tree (Spanning, V) and then Slack (Info, E) = 0 then 798 Add_Edge (Spanning, E); 799 if Is_Spanning (Spanning) or else Search (V) then 800 return True; 801 end if; 802 end if; 803 return False; 804 end Add_Edge_And_Recurse; 805 806 ------------ 807 -- Search -- 808 ------------ 809 810 function Search (V : Vertex_Access) return Boolean is 811 Eit : Edge_Iterator; 812 E : Edge_Access; 813 begin 814 Eit := First (G, Src => V); 815 while not At_End (Eit) loop 816 E := Get (Eit); 817 if Add_Edge_And_Recurse (E, Get_Dest (E)) then 818 return True; 819 end if; 820 Next (Eit); 821 end loop; 822 823 Eit := First (G, Dest => V); 824 while not At_End (Eit) loop 825 E := Get (Eit); 826 if Add_Edge_And_Recurse (E, Get_Src (E)) then 827 return True; 828 end if; 829 Next (Eit); 830 end loop; 831 832 -- We force the edge into the tree (it might have been an edge 833 -- with no in or out edges). 834 Add_Vertex (Spanning, V); 835 return Is_Spanning (Spanning); 836 end Search; 837 838 ----------------------- 839 -- Add_Adjacent_Edge -- 840 ----------------------- 841 842 procedure Add_Adjacent_Edge is 843 Vit : Vertex_Iterator := First (G); 844 V : Vertex_Access; 845 Eit : Edge_Iterator; 846 E : Edge_Access; 847 848 Last_Vertex_Not_In_Tree : Vertex_Access; 849 850 Layer_Delta : Integer; 851 Min_Slack : Integer := Integer'Last; 852 Vertex_To_Add : Vertex_Access; 853 Edge_To_Add : Edge_Access; 854 Sl : Integer; 855 856 Dummy : Boolean; 857 pragma Unreferenced (Dummy); 858 859 begin 860 For_Each_Vertex_Not_In_Tree : 861 while not At_End (Vit) loop 862 V := Get (Vit); 863 if not In_Tree (Spanning, V) then 864 Last_Vertex_Not_In_Tree := V; 865 866 Eit := First (G, Src => V); 867 while not At_End (Eit) loop 868 E := Get (Eit); 869 if In_Tree (Spanning, Get_Dest (E)) then 870 Sl := Slack (Info, E); 871 if Sl < Min_Slack then 872 Min_Slack := Sl; 873 Vertex_To_Add := V; 874 Edge_To_Add := E; 875 Layer_Delta := -Sl; 876 877 -- that will be the minimum anyway 878 exit For_Each_Vertex_Not_In_Tree when Sl = 1; 879 end if; 880 end if; 881 Next (Eit); 882 end loop; 883 884 Eit := First (G, Dest => V); 885 while not At_End (Eit) loop 886 E := Get (Eit); 887 if In_Tree (Spanning, Get_Src (E)) then 888 Sl := Slack (Info, E); 889 if Sl < Min_Slack then 890 Min_Slack := Sl; 891 Vertex_To_Add := V; 892 Edge_To_Add := E; 893 Layer_Delta := Sl; 894 895 -- that will be the minimum anyway 896 exit For_Each_Vertex_Not_In_Tree when Sl = 1; 897 end if; 898 end if; 899 Next (Eit); 900 end loop; 901 end if; 902 903 Next (Vit); 904 end loop For_Each_Vertex_Not_In_Tree; 905 906 -- Have we found an edge to tighten ? 907 908 if Vertex_To_Add /= null then 909 Vit := First (G); 910 while not At_End (Vit) loop 911 V := Get (Vit); 912 913 -- If the node is in the current component 914 if Spanning.Node_In_Tree (Get_Index (V)) = 915 Spanning.Disjoint_Components 916 then 917 Info.Layers (Get_Index (V)) := 918 Info.Layers (Get_Index (V)) + Layer_Delta; 919 end if; 920 921 Next (Vit); 922 end loop; 923 924 -- Add the edge only after we had adjusted layers 925 Add_Edge (Spanning, Edge_To_Add); 926 927 Info.Min_Layer := 928 Integer'Min (Info.Min_Layer, Info.Min_Layer + Layer_Delta); 929 Info.Max_Layer := 930 Integer'Max (Info.Max_Layer, Info.Max_Layer + Layer_Delta); 931 932 elsif Last_Vertex_Not_In_Tree /= null then 933 -- No adjacent vertex, and yet the tree is not spanning. We 934 -- start from a new node. 935 936 Spanning.Disjoint_Components := 937 Spanning.Disjoint_Components + 1; 938 Dummy := Search (Last_Vertex_Not_In_Tree); 939 end if; 940 end Add_Adjacent_Edge; 941 942 Vit : constant Vertex_Iterator := First (G); 943 Dummy : Boolean; 944 pragma Unreferenced (Dummy); 945 begin 946 if At_End (Vit) then 947 -- No nodes in graph 948 return; 949 end if; 950 951 Spanning.Disjoint_Components := 1; 952 953 Dummy := Search (Get (Vit)); -- initial tree (non-spanning) 954 955 while not Is_Spanning (Spanning) loop 956 Add_Adjacent_Edge; 957 end loop; 958 end Feasible_Tree; 959 960 ---------------- 961 -- Rank_Items -- 962 ---------------- 963 964 procedure Rank_Items (G : in out Graph; Info : in out Layout_Info) is 965 Max_I : constant Integer := Max_Index (G); 966 967 Spanning : Tree (Max_I); 968 969 begin 970 Init_Rank (G, Info); 971 972 Feasible_Tree (G, Info, Spanning); 973 974 -- ??? Should now compute cut values, and adjust layers for edges 975 -- with negative cut values. The idea is that a node with for 976 -- instance more incoming edges than outgoing edges, should 977 -- preferably shorten the incoming edges 978 979 Normalize_Layers (Spanning, Info); 980 981 -- ??? Could balance the layers: when a node can be in multiple 982 -- layers (same number of incomding and outgoing edges), it should be 983 -- moved to the layer which has the fewest nodes to reduce crowding. 984 985 end Rank_Items; 986 987 --------------------- 988 -- Layered_Layouts -- 989 --------------------- 990 991 package body Layered_Layouts is 992 993 procedure Insert_Dummy_Nodes 994 (G : in out Graph; Info : in out Layout_Info); 995 -- When an edge spans multiple layers, replace it with a chain of 996 -- edges, each of which only connects adjacent layers 997 998 ------------------------ 999 -- Insert_Dummy_Nodes -- 1000 ------------------------ 1001 1002 procedure Insert_Dummy_Nodes 1003 (G : in out Graph; Info : in out Layout_Info) 1004 is 1005 Eit : Edge_Iterator := First (G); 1006 E : Edge_Access; 1007 V1 : Vertex_Access; 1008 Start_Layer, End_Layer : Integer; 1009 begin 1010 while not At_End (Eit) loop 1011 E := Get (Eit); 1012 Next (Eit); 1013 1014 Start_Layer := Info.Layers (Get_Index (Get_Src (E))); 1015 End_Layer := Info.Layers (Get_Index (Get_Dest (E))); 1016 1017 if Start_Layer < End_Layer - 1 then 1018 declare 1019 Dummies : Vertices_Array 1020 (Start_Layer + 1 .. End_Layer - 1); 1021 begin 1022 V1 := Get_Src (E); 1023 for Layer in Start_Layer + 1 .. End_Layer - 1 loop 1024 -- We can't add the new layer to Layers, since there 1025 -- is not enough space there. 1026 1027 Dummies (Layer) := new Dummy_Vertex; 1028 Base_Dummy_Vertex (Dummies (Layer).all).Layer := Layer; 1029 Add_Vertex (G, Dummies (Layer)); 1030 Add_Edge (G, V1, Dummies (Layer)); 1031 1032 V1 := Dummies (Layer); 1033 end loop; 1034 Add_Edge (G, V1, Get_Dest (E)); 1035 1036 Replaced_With_Dummy_Vertices 1037 (Replaced_Edge => E, 1038 Dummies => Dummies); 1039 1040 Remove (G, E); 1041 end; 1042 end if; 1043 end loop; 1044 end Insert_Dummy_Nodes; 1045 1046 ------------ 1047 -- Layout -- 1048 ------------ 1049 1050 procedure Layout 1051 (G : in out Graph; 1052 Horizontal : Boolean := True; 1053 Space_Between_Layers : Gdouble := 20.0; 1054 Space_Between_Items : Gdouble := 10.0) 1055 is 1056 Info : Layout_Info; 1057 begin 1058 -- If the graph is empty, nothing to do 1059 if Max_Index (G) = -1 then 1060 return; 1061 end if; 1062 1063 Info.Horizontal := Horizontal; 1064 Info.Space_Between_Items := Space_Between_Items; 1065 Info.Space_Between_Layers := Space_Between_Layers; 1066 1067 Info.Layers := new Integer_Array (Min_Vertex_Index .. Max_Index (G)); 1068 1069 if not Is_Directed (G) then 1070 raise Program_Error 1071 with "Layer layout only applies to directed graphs"; 1072 end if; 1073 1074 Make_Acyclic (G); 1075 Rank_Items (G, Info); 1076 1077 if Add_Dummy_Nodes then 1078 Insert_Dummy_Nodes (G, Info); 1079 end if; 1080 1081 Organize_Nodes (G, Info); 1082 Free (Info); 1083 end Layout; 1084 1085 end Layered_Layouts; 1086 1087end Glib.Graphs.Layouts; 1088