Data update

This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions

View file

@ -0,0 +1,32 @@
private with Ada.Containers.Ordered_Maps;
generic
type t_Vertex is (<>);
package Dijkstra is
type t_Graph is limited private;
-- Defining a graph (since limited private, only way to do this is to use the Build function)
type t_Edge is record
From, To : t_Vertex;
Weight : Positive;
end record;
type t_Edges is array (Integer range <>) of t_Edge;
function Build (Edges : in t_Edges; Oriented : in Boolean := True) return t_Graph;
-- Computing path and distance
type t_Path is array (Integer range <>) of t_Vertex;
function Shortest_Path (Graph : in out t_Graph;
From, To : in t_Vertex) return t_Path;
function Distance (Graph : in out t_Graph;
From, To : in t_Vertex) return Natural;
private
package Neighbor_Lists is new Ada.Containers.Ordered_Maps (Key_Type => t_Vertex, Element_Type => Positive);
type t_Vertex_Data is record
Neighbors : Neighbor_Lists.Map; -- won't be affected after build
-- Updated each time a function is called with a new source
Previous : t_Vertex;
Distance : Natural;
end record;
type t_Graph is array (t_Vertex) of t_Vertex_Data;
end Dijkstra;

View file

@ -0,0 +1,91 @@
with Ada.Containers.Ordered_Sets;
package body Dijkstra is
Infinite : constant Natural := Natural'Last;
-- ----- Graph constructor
function Build (Edges : in t_Edges; Oriented : in Boolean := True) return t_Graph is
begin
return Answer : t_Graph := (others => (Neighbors => Neighbor_Lists.Empty_Map,
Previous => t_Vertex'First,
Distance => Natural'Last)) do
for Edge of Edges loop
Answer(Edge.From).Neighbors.Insert (Key => Edge.To, New_Item => Edge.Weight);
if not Oriented then
Answer(Edge.To).Neighbors.Insert (Key => Edge.From, New_Item => Edge.Weight);
end if;
end loop;
end return;
end Build;
-- ----- Paths / distances data updating in case of computation request for a new source
procedure Update_For_Source (Graph : in out t_Graph;
From : in t_Vertex) is
function Nearer (Left, Right : in t_Vertex) return Boolean is
(Graph(Left).Distance < Graph(Right).Distance or else
(Graph(Left).Distance = Graph(Right).Distance and then Left < Right));
package Ordered is new Ada.Containers.Ordered_Sets (Element_Type => t_Vertex, "<" => Nearer);
use Ordered;
Remaining : Set := Empty_Set;
begin
-- First, let's check if vertices data are already computed for this source
if Graph(From).Distance /= 0 then
-- Reset distances and remaining vertices for a new source
for Vertex in Graph'range loop
Graph(Vertex).Distance := (if Vertex = From then 0 else Infinite);
Remaining.Insert (Vertex);
end loop;
-- ----- The Dijkstra algorithm itself
while not Remaining.Is_Empty
-- If some targets are not connected to source, at one point, the remaining
-- distances will all be infinite, hence the folllowing stop condition
and then Graph(Remaining.First_Element).Distance /= Infinite loop
declare
Nearest : constant t_Vertex := Remaining.First_Element;
procedure Update_Neighbor (Position : in Neighbor_Lists.Cursor) is
use Neighbor_Lists;
Neighbor : constant t_Vertex := Key (Position);
In_Remaining : Ordered.Cursor := Remaining.Find (Neighbor);
Try_Distance : constant Natural :=
(if In_Remaining = Ordered.No_Element
then Infinite -- vertex already reached, this distance will fail the update test below
else Graph(Nearest).Distance + Element (Position));
begin
if Try_Distance < Graph(Neighbor).Distance then
-- Update distance/path data and reorder the remaining set
Remaining.Delete (In_Remaining);
Graph(Neighbor).Distance := Try_Distance;
Graph(Neighbor).Previous := Nearest;
Remaining.Insert (Neighbor);
end if;
end Update_Neighbor;
begin
Remaining.Delete_First;
Graph(Nearest).Neighbors.Iterate (Update_Neighbor'Access);
end;
end loop;
end if;
end Update_For_Source;
-- ----- Bodies for the interfaced functions
function Shortest_Path (Graph : in out t_Graph;
From, To : in t_Vertex) return t_Path is
function Recursive_Build (From, To : in t_Vertex) return t_Path is
(if From = To then (1 => From)
else Recursive_Build(From, Graph(To).Previous) & (1 => To));
begin
Update_For_Source (Graph, From);
if Graph(To).Distance = Infinite then
raise Constraint_Error with "No path from " & From'Img & " to " & To'Img;
end if;
return Recursive_Build (From, To);
end Shortest_Path;
function Distance (Graph : in out t_Graph;
From, To : in t_Vertex) return Natural is
begin
Update_For_Source (Graph, From);
return Graph(To).Distance;
end Distance;
end Dijkstra;

View file

@ -0,0 +1,39 @@
with Ada.Text_IO; use Ada.Text_IO;
with Dijkstra;
procedure Test_Dijkstra is
subtype t_Tested_Vertices is Character range 'a'..'f';
package Tested is new Dijkstra (t_Vertex => t_Tested_Vertices);
use Tested;
Graph : t_Graph := Build (Edges => (('a', 'b', 7),
('a', 'c', 9),
('a', 'f', 14),
('b', 'c', 10),
('b', 'd', 15),
('c', 'd', 11),
('c', 'f', 2),
('d', 'e', 6),
('e', 'f', 9)));
procedure Display_Path (From, To : in t_Tested_Vertices) is
function Path_Image (Path : in t_Path; Start : Boolean := True) return String is
((if Start then "["
elsif Path'Length /= 0 then ","
else "") &
(if Path'Length = 0 then "]"
else Path(Path'First) & Path_Image(Path(Path'First+1..Path'Last), Start => False)));
begin
Put ("Path from '" & From & "' to '" & To & "' = ");
Put_Line (Path_Image (Shortest_Path (Graph, From, To))
& " distance =" & Distance (Graph, From, To)'Img);
exception
when others => Put_Line("no path");
end Display_Path;
begin
Display_Path ('a', 'e');
Display_Path ('a', 'f');
New_Line;
for From in t_Tested_Vertices loop
for To in t_Tested_Vertices loop
Display_Path (From, To);
end loop;
end loop;
end Test_Dijkstra;

View file

@ -0,0 +1,240 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. DIJKSTRA.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> Maximum sizes
01 INF-VALUE PIC 9(6) VALUE 999999.
*> Edge table
01 EDGE-COUNT PIC 99 VALUE 0.
01 EDGE-TABLE.
05 EDGE OCCURS 50 TIMES.
10 EDGE-V1 PIC X(10).
10 EDGE-V2 PIC X(10).
10 EDGE-LEN PIC 9(4).
*> Vertex table
01 VERT-COUNT PIC 99 VALUE 0.
01 VERT-TABLE.
05 VERT OCCURS 20 TIMES.
10 VERT-NAME PIC X(10).
10 VERT-DIST PIC 9(6) VALUE 999999.
10 VERT-PREV PIC 99 VALUE 0.
10 VERT-IN-Q PIC X VALUE 'Y'.
*> Adjacency matrix
01 ADJ-MATRIX.
05 ADJ-ROW OCCURS 20 TIMES.
10 ADJ-COL OCCURS 20 TIMES.
15 ADJ-WEIGHT PIC 9(4) VALUE 0.
*> Source / Target
01 SOURCE-NAME PIC X(10).
01 TARGET-NAME PIC X(10).
01 SOURCE-IDX PIC 99 VALUE 0.
01 TARGET-IDX PIC 99 VALUE 0.
*> Working variables
01 I PIC 99 VALUE 0.
01 J PIC 99 VALUE 0.
01 U-IDX PIC 99 VALUE 0.
01 MIN-DIST PIC 9(6) VALUE 999999.
01 ALT-DIST PIC 9(6) VALUE 0.
01 Q-EMPTY PIC X VALUE 'N'.
01 FOUND PIC X VALUE 'N'.
01 V1-IDX PIC 99 VALUE 0.
01 V2-IDX PIC 99 VALUE 0.
01 PATH-LEN PIC 9(6) VALUE 0.
*> Path reconstruction
01 PATH-COUNT PIC 99 VALUE 0.
01 PATH-TABLE.
05 PATH-NODE OCCURS 20 TIMES PIC 99.
01 PATH-IDX PIC 99 VALUE 0.
01 TEMP-IDX PIC 99 VALUE 0.
*> Temp vertex name for lookup
01 LOOKUP-NAME PIC X(10).
01 LOOKUP-IDX PIC 99 VALUE 0.
PROCEDURE DIVISION.
MAIN-PARA.
PERFORM BUILD-GRAPH
PERFORM DIJKSTRA-ALGO
PERFORM PRINT-RESULT
STOP RUN.
*> -------------------------------------------------------
*> BUILD-GRAPH: Define edges and populate structures
*> -------------------------------------------------------
BUILD-GRAPH.
MOVE "a" TO SOURCE-NAME
MOVE "e" TO TARGET-NAME
MOVE "a" TO EDGE-V1(1)
MOVE "b" TO EDGE-V2(1)
MOVE 7 TO EDGE-LEN(1)
MOVE "a" TO EDGE-V1(2)
MOVE "c" TO EDGE-V2(2)
MOVE 9 TO EDGE-LEN(2)
MOVE "a" TO EDGE-V1(3)
MOVE "f" TO EDGE-V2(3)
MOVE 14 TO EDGE-LEN(3)
MOVE "b" TO EDGE-V1(4)
MOVE "c" TO EDGE-V2(4)
MOVE 10 TO EDGE-LEN(4)
MOVE "b" TO EDGE-V1(5)
MOVE "d" TO EDGE-V2(5)
MOVE 15 TO EDGE-LEN(5)
MOVE "c" TO EDGE-V1(6)
MOVE "d" TO EDGE-V2(6)
MOVE 11 TO EDGE-LEN(6)
MOVE "c" TO EDGE-V1(7)
MOVE "f" TO EDGE-V2(7)
MOVE 2 TO EDGE-LEN(7)
MOVE "d" TO EDGE-V1(8)
MOVE "e" TO EDGE-V2(8)
MOVE 6 TO EDGE-LEN(8)
MOVE "e" TO EDGE-V1(9)
MOVE "f" TO EDGE-V2(9)
MOVE 9 TO EDGE-LEN(9)
MOVE 9 TO EDGE-COUNT
*> Register all vertices and build adjacency matrix
PERFORM VARYING I FROM 1 BY 1
UNTIL I > EDGE-COUNT
MOVE EDGE-V1(I) TO LOOKUP-NAME
PERFORM GET-OR-ADD-VERTEX
MOVE LOOKUP-IDX TO V1-IDX
MOVE EDGE-V2(I) TO LOOKUP-NAME
PERFORM GET-OR-ADD-VERTEX
MOVE LOOKUP-IDX TO V2-IDX
MOVE EDGE-LEN(I) TO ADJ-WEIGHT(V1-IDX, V2-IDX)
MOVE EDGE-LEN(I) TO ADJ-WEIGHT(V2-IDX, V1-IDX)
END-PERFORM
*> Find source and target indices
PERFORM VARYING I FROM 1 BY 1
UNTIL I > VERT-COUNT
IF VERT-NAME(I) = SOURCE-NAME
MOVE 0 TO VERT-DIST(I)
MOVE I TO SOURCE-IDX
END-IF
IF VERT-NAME(I) = TARGET-NAME
MOVE I TO TARGET-IDX
END-IF
END-PERFORM.
*> -------------------------------------------------------
*> GET-OR-ADD-VERTEX
*> Input: LOOKUP-NAME
*> Output: LOOKUP-IDX (existing or newly added index)
*> -------------------------------------------------------
GET-OR-ADD-VERTEX.
MOVE 'N' TO FOUND
PERFORM VARYING J FROM 1 BY 1
UNTIL J > VERT-COUNT OR FOUND = 'Y'
IF VERT-NAME(J) = LOOKUP-NAME
MOVE J TO LOOKUP-IDX
MOVE 'Y' TO FOUND
END-IF
END-PERFORM
IF FOUND = 'N'
ADD 1 TO VERT-COUNT
MOVE LOOKUP-NAME TO VERT-NAME(VERT-COUNT)
MOVE INF-VALUE TO VERT-DIST(VERT-COUNT)
MOVE 0 TO VERT-PREV(VERT-COUNT)
MOVE 'Y' TO VERT-IN-Q(VERT-COUNT)
MOVE VERT-COUNT TO LOOKUP-IDX
END-IF.
*> -------------------------------------------------------
*> DIJKSTRA-ALGO: Main algorithm loop
*> -------------------------------------------------------
DIJKSTRA-ALGO.
MOVE 'N' TO Q-EMPTY
PERFORM UNTIL Q-EMPTY = 'Y'
MOVE INF-VALUE TO MIN-DIST
MOVE 0 TO U-IDX
PERFORM VARYING I FROM 1 BY 1
UNTIL I > VERT-COUNT
IF VERT-IN-Q(I) = 'Y' AND
VERT-DIST(I) < MIN-DIST
MOVE VERT-DIST(I) TO MIN-DIST
MOVE I TO U-IDX
END-IF
END-PERFORM
IF U-IDX = 0
MOVE 'Y' TO Q-EMPTY
ELSE
MOVE 'N' TO VERT-IN-Q(U-IDX)
IF U-IDX = TARGET-IDX
MOVE 'Y' TO Q-EMPTY
ELSE
PERFORM VARYING J FROM 1 BY 1
UNTIL J > VERT-COUNT
IF VERT-IN-Q(J) = 'Y' AND
ADJ-WEIGHT(U-IDX, J) > 0
COMPUTE ALT-DIST =
VERT-DIST(U-IDX) +
ADJ-WEIGHT(U-IDX, J)
IF ALT-DIST < VERT-DIST(J)
MOVE ALT-DIST TO VERT-DIST(J)
MOVE U-IDX TO VERT-PREV(J)
END-IF
END-IF
END-PERFORM
END-IF
END-IF
END-PERFORM.
*> -------------------------------------------------------
*> PRINT-RESULT: Reconstruct and display path
*> -------------------------------------------------------
PRINT-RESULT.
MOVE 0 TO PATH-COUNT
MOVE 0 TO PATH-LEN
MOVE TARGET-IDX TO PATH-IDX
PERFORM UNTIL PATH-IDX = 0
ADD 1 TO PATH-COUNT
MOVE PATH-IDX TO PATH-NODE(PATH-COUNT)
MOVE VERT-PREV(PATH-IDX) TO TEMP-IDX
IF TEMP-IDX > 0
ADD ADJ-WEIGHT(PATH-IDX, TEMP-IDX) TO PATH-LEN
END-IF
MOVE TEMP-IDX TO PATH-IDX
END-PERFORM
DISPLAY "Path: " WITH NO ADVANCING
PERFORM VARYING I FROM PATH-COUNT BY -1
UNTIL I < 1
DISPLAY FUNCTION TRIM(VERT-NAME(PATH-NODE(I)))
WITH NO ADVANCING
IF I > 1
DISPLAY " -> " WITH NO ADVANCING
END-IF
END-PERFORM
DISPLAY " "
DISPLAY "Length: " PATH-LEN.

View file

@ -0,0 +1,62 @@
(defvar path-list '((a b 7)
(a c 9)
(a f 14)
(b c 10)
(b d 15)
(c d 11)
(c f 2)
(d e 6)
(e f 9)))
(defun calculate-shortest-path (path-list)
(let (shortest-path)
(dolist (path path-list)
(add-to-list 'shortest-path (list (nth 0 path)
(nth 1 path)
nil
(nth 2 path))
't))
(dolist (path path-list)
(dolist (short-path shortest-path)
(when (equal (nth 0 path) (nth 1 short-path))
(let ((test-path (list (nth 0 short-path)
(nth 1 path)
(nth 0 path)
(+ (nth 2 path) (nth 3 short-path))))
is-path-found)
(dolist (short-path1 shortest-path)
(when (equal (seq-take test-path 2)
(seq-take short-path1 2))
(setq is-path-found 't)
(when (> (nth 3 short-path1) (nth 3 test-path))
(setcdr (cdr short-path1) (cddr test-path)))))
(when (not is-path-found)
(add-to-list 'shortest-path test-path 't))))))
shortest-path))
(defun find-shortest-route (from to path-list)
(let ((shortest-path-list (calculate-shortest-path path-list))
point-list matched-path distance)
(add-to-list 'point-list to)
(setq matched-path
(seq-find (lambda (path) (equal (list from to) (seq-take path 2)))
shortest-path-list))
(setq distance (nth 3 matched-path))
(while (nth 2 matched-path)
(add-to-list 'point-list (nth 2 matched-path))
(setq to (nth 2 matched-path))
(setq matched-path
(seq-find (lambda (path) (equal (list from to) (seq-take path 2)))
shortest-path-list)))
(if matched-path
(progn
(add-to-list 'point-list from)
(list 'route point-list 'distance distance))
nil)))
(format "%S" (find-shortest-route 'a 'e path-list))

View file

@ -0,0 +1,91 @@
struct Edge {
from string
to string
cost int
}
const graph := [
Edge{"a", "b", 7},
Edge{"a", "c", 9},
Edge{"a", "f", 14},
Edge{"b", "c", 10},
Edge{"b", "d", 15},
Edge{"c", "d", 11},
Edge{"c", "f", 2},
Edge{"d", "e", 6},
Edge{"e", "f", 9},
]
fn str_to_list(sg string) []string { return sg.split(" ") }
fn powerset(graph []Edge) []string {
nir := graph.len
max := 1 << nir
mut dgraph := []string{}
mut sg := ""
for ial in 1 .. max {
sg = ""
for jal in 0 .. nir {
if (ial & (1 << jal)) != 0 {
edge := graph[jal]
sg += "${edge.from} ${edge.to} ${edge.cost} "
}
}
sg = sg.trim_space()
dgraph << sg
}
return dgraph
}
fn main() {
dgraph := powerset(graph)
dbegin, dend := "a", "e"
mut lenold, mut sumold, mut sumnew := 10, 30, 0
mut dtemp, mut gend := [][]string{}, []string{}
mut sg := ""
mut flag := false
for sal in dgraph {
dtemp << str_to_list(sal)
}
for mut path in dtemp {
if path.len > 3 && path[0] == dbegin && path[path.len - 2] == dend {
flag = true
steps := path.len / 3
for mal in 0 .. steps - 1 {
if mal < steps - 1 {
// check if the "to" of current edge matches "from" of next edge
if path[mal * 3 + 1] != path[(mal + 1) * 3] {
flag = false
break
}
}
}
if flag {
lennew := path.len
if lennew <= lenold {
lenold = lennew
sumnew = 0
for mal in 0 .. steps {
sumnew += path[mal * 3 + 2].int()
}
if sumnew < sumold {
sumold = sumnew
gend = path.clone()
}
}
}
}
}
if gend.len == 0 {
println("No path found from $dbegin to $dend")
return
}
sg = "$dbegin $dend : "
steps := gend.len / 3
for mal in 0 .. steps {
sg += "${gend[mal * 3]} ${gend[mal * 3 + 1]} ${gend[mal * 3 + 2]} -> "
}
sg = sg[..sg.len - 4] // remove last arrow character
sg += " cost : $sumold\n"
print(sg)
}