[m-rev.] diff: fix relation.tsort

[Simon Taylor]

Estimated hours taken: 2
Branches: main

library/relation.m:
	Fix a bug in my last change which broke the Aditi tests;
	the output of tsort was in reverse order.

tests/hard_coded/relation_test.m:
	Add some more test cases.

Index: library//relation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/relation.m,v
retrieving revision 1.31
diff -u -u -r1.31 relation.m
--- library//relation.m	22 Dec 2003 11:21:48 -0000	1.31
+++ library//relation.m	23 Dec 2003 21:44:44 -0000
@@ -730,7 +730,7 @@
 		relation__lookup_key_set_from(Rel, Node, AdjSet),
 		insert(!.Visit, Node, !:Visit),
 
-		% Go and visit all a nodes children first
+		% Go and visit all of the node's children first
 		{!:Visit, !:DfsRev} = foldl(
 			(func(Adj, {!.Visit, !.DfsRev}) =
 					{!:Visit, !:DfsRev} :-
@@ -927,17 +927,9 @@
 	% relation__tsort returns a topological sorting
 	% of a relation.  It fails if the relation is cyclic.
 relation__tsort(Rel, Tsort) :-
-	relation__tsort_2(Rel, Tsort0),
-	list__map(relation__lookup_key(Rel), Tsort0, Tsort).
-
-:- pred relation__tsort_2(relation(T), list(relation_key)).
-:- mode relation__tsort_2(in, out) is semidet.
-
-relation__tsort_2(Rel, Tsort) :-
-	relation__domain_sorted_list(Rel, DomList),
-	init(Vis0),
-	relation__c_dfs(Rel, DomList, Vis0, _Vis, [], Tsort),
-	relation__check_tsort(Rel, Vis0, Tsort).
+	relation__dfsrev(Rel, Tsort0),
+	relation__check_tsort(Rel, init, Tsort0),
+	Tsort = list__map(relation__lookup_key(Rel), Tsort0).
 
 :- pred relation__check_tsort(relation(T), relation_key_set,
 		list(relation_key)).
@@ -950,31 +942,6 @@
 	empty(BackPointers),
 	relation__check_tsort(Rel, Vis1, Xs).
 
-:- pred relation__c_dfs(relation(T), list(relation_key), relation_key_set,
-	relation_key_set, list(relation_key), list(relation_key)).
-:- mode relation__c_dfs(in, in, in, out, in, out) is det.
-relation__c_dfs(_Rel, [], !Vis, !Dfs).
-relation__c_dfs(Rel, [X | Xs], !Vis, !Dfs) :-
-	( contains(!.Vis, X) ->
-		true
-	;
-		relation__c_dfs_2(Rel, X, !Vis, !Dfs)
-	),
-	relation__c_dfs(Rel, Xs, !Vis, !Dfs).
-
-:- pred relation__c_dfs_2(relation(T), relation_key, relation_key_set,
-	relation_key_set, list(relation_key), list(relation_key)).
-:- mode relation__c_dfs_2(in, in, in, out, in, out) is det.
-relation__c_dfs_2(Rel, X, !Vis, !Dfs) :-
-	insert(!.Vis, X, !:Vis),
-	relation__lookup_key_set_from(Rel, X, FromXs),
-	foldl(
-		(pred(FromX::in, {!.Vis, !.Dfs}::in,
-				{!:Vis, !:Dfs}::out) is det :-
-			relation__c_dfs_2(Rel, FromX, !Vis, !Dfs)
-		), FromXs, {!.Vis, !.Dfs}, {!:Vis, !:Dfs}),
-	!:Dfs = [X | !.Dfs].
-
 %------------------------------------------------------------------------------%
 
 	% relation__atsort returns a topological sorting
@@ -993,8 +960,7 @@
 	list__reverse(ATsort0, ATsort).
 
 :- pred relation__atsort_2(list(relation_key), relation(T),
-	relation_key_set, list(set(T)),
-	list(set(T))).
+	relation_key_set, list(set(T)), list(set(T))).
 :- mode relation__atsort_2(in, in, in, in, out) is det.
 
 relation__atsort_2([], _, _, ATsort, ATsort).
Index: tests/hard_coded/relation_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/relation_test.exp,v
retrieving revision 1.2
diff -u -u -r1.2 relation_test.exp
--- tests/hard_coded/relation_test.exp	22 Dec 2003 11:21:49 -0000	1.2
+++ tests/hard_coded/relation_test.exp	23 Dec 2003 04:32:12 -0000
@@ -1,62 +1,118 @@
 Rel =
 "a" - "b"
-"b" - "c"
-"c" - "d"
-"l1" - "l2"
-"l2" - "l3"
-"l3" - "l1"
-"x" - "x"
+	"b" - "c"
+	"c" - "d"
+	"l1" - "l2"
+	"l2" - "l3"
+	"l3" - "l1"
+	"x" - "x"
 
-tc of Rel =
+tc =
 "a" - "b"
-"a" - "c"
-"a" - "d"
-"b" - "c"
-"b" - "d"
-"c" - "d"
-"l1" - "l1"
-"l1" - "l2"
-"l1" - "l3"
-"l2" - "l1"
-"l2" - "l2"
-"l2" - "l3"
-"l3" - "l1"
-"l3" - "l2"
-"l3" - "l3"
-"x" - "x"
+	"a" - "c"
+	"a" - "d"
+	"b" - "c"
+	"b" - "d"
+	"c" - "d"
+	"l1" - "l1"
+	"l1" - "l2"
+	"l1" - "l3"
+	"l2" - "l1"
+	"l2" - "l2"
+	"l2" - "l3"
+	"l3" - "l1"
+	"l3" - "l2"
+	"l3" - "l3"
+	"x" - "x"
 
-rtc of Rel =
+rtc =
 "a" - "a"
+	"a" - "b"
+	"a" - "c"
+	"a" - "d"
+	"b" - "b"
+	"b" - "c"
+	"b" - "d"
+	"c" - "c"
+	"c" - "d"
+	"d" - "d"
+	"l1" - "l1"
+	"l1" - "l2"
+	"l1" - "l3"
+	"l2" - "l1"
+	"l2" - "l2"
+	"l2" - "l3"
+	"l3" - "l1"
+	"l3" - "l2"
+	"l3" - "l3"
+	"x" - "x"
+
+sc =
 "a" - "b"
-"a" - "c"
-"a" - "d"
-"b" - "b"
-"b" - "c"
-"b" - "d"
-"c" - "c"
-"c" - "d"
-"d" - "d"
-"l1" - "l1"
-"l1" - "l2"
-"l1" - "l3"
-"l2" - "l1"
-"l2" - "l2"
-"l2" - "l3"
-"l3" - "l1"
-"l3" - "l2"
-"l3" - "l3"
-"x" - "x"
+	"b" - "a"
+	"b" - "c"
+	"c" - "b"
+	"c" - "d"
+	"d" - "c"
+	"l1" - "l2"
+	"l1" - "l3"
+	"l2" - "l1"
+	"l2" - "l3"
+	"l3" - "l1"
+	"l3" - "l2"
+	"x" - "x"
 
+dfs =
+["d", "c", "b", "a", "l3", "l2", "l1", "x"]
+atsort =
+[["x"], ["l1", "l2", "l3"], ["a"], ["b"], ["c"], ["d"]]
+tsort failed
+is_dag failed
 Rel2 =
 "a" - "a1"
-"b" - "b1"
-"c" - "c1"
-"d" - "d1"
+	"b" - "b1"
+	"c" - "c1"
+	"d" - "d1"
+
+tc =
+"a" - "a1"
+	"b" - "b1"
+	"c" - "c1"
+	"d" - "d1"
+
+rtc =
+"a" - "a"
+	"a" - "a1"
+	"a1" - "a1"
+	"b" - "b"
+	"b" - "b1"
+	"b1" - "b1"
+	"c" - "c"
+	"c" - "c1"
+	"c1" - "c1"
+	"d" - "d"
+	"d" - "d1"
+	"d1" - "d1"
+
+sc =
+"a" - "a1"
+	"a1" - "a"
+	"b" - "b1"
+	"b1" - "b"
+	"c" - "c1"
+	"c1" - "c"
+	"d" - "d1"
+	"d1" - "d"
 
-composition of Rel1 and Rel2 =
+dfs =
+["a1", "a", "b1", "b", "c1", "c", "d1", "d"]
+atsort =
+[["d"], ["d1"], ["c"], ["c1"], ["b"], ["b1"], ["a"], ["a1"]]
+tsort =
+["d", "d1", "c", "c1", "b", "b1", "a", "a1"]
+is_dag succeeded
+composition of Rel and Rel2 =
 "a" - "b1"
-"b" - "c1"
-"c" - "d1"
+	"b" - "c1"
+	"c" - "d1"
 
-relation__is_dag(Rel) failed as expected
-relation__is_dag(Rel) succeeded
Index: tests/hard_coded/relation_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/relation_test.m,v
retrieving revision 1.2
diff -u -u -r1.2 relation_test.m
--- tests/hard_coded/relation_test.m	22 Dec 2003 11:21:49 -0000	1.2
+++ tests/hard_coded/relation_test.m	23 Dec 2003 04:26:59 -0000
@@ -23,24 +23,38 @@
 			"c" - "c1",
 			"d" - "d1"],
 			Rel2) },
+	test_rel("Rel", Rel),
+	test_rel("Rel2", Rel2),
+	{ relation__compose(Rel, Rel2, ComposedRel) },
+	print("composition of Rel and Rel2 ="), nl,
+			print_rel(ComposedRel), nl.
+
+:- pred test_rel(string::in, relation(T)::in,
+		io__state::di, io__state::uo) is det.
+
+test_rel(Name, Rel) -->
+	{ relation__dfs(Rel, DfsKeys) },
+	{ list__map(relation__lookup_key(Rel), DfsKeys, Dfs) },
 	{ relation__tc(Rel, TC_Rel) },
 	{ relation__rtc(Rel, RTC_Rel) },
-	{ relation__compose(Rel, Rel2, ComposedRel) },
-	print("Rel ="), nl, print_rel(Rel), nl,
-	print("tc of Rel ="), nl, print_rel(TC_Rel), nl,
-	print("rtc of Rel ="), nl, print_rel(RTC_Rel), nl,
-	print("Rel2 ="), nl, print_rel(Rel2), nl,
-	print("composition of Rel1 and Rel2 ="), nl,
-			print_rel(ComposedRel), nl,
-	( { relation__is_dag(Rel) } ->
-		io__write_string("Error: relation__is_dag(Rel) succeeded\n")
+	{ relation__sc(Rel, SC_Rel) },
+	{ relation__atsort(Rel, ATSort) },
+	print(Name),
+	print(" ="), nl, print_rel(Rel), nl,
+	print("tc ="), nl, print_rel(TC_Rel), nl,
+	print("rtc ="), nl, print_rel(RTC_Rel), nl,
+	print("sc ="), nl, print_rel(SC_Rel), nl,
+	print("dfs ="), nl, print(Dfs), nl,
+	print("atsort ="), nl, print(ATSort), nl,
+	( { relation__tsort(Rel, TSort) } ->
+		print("tsort ="), nl, print(TSort), nl
 	;
-		io__write_string("relation__is_dag(Rel) failed as expected\n")
+		print("tsort failed\n")
 	),
-	( { relation__is_dag(Rel2) } ->
-		io__write_string("relation__is_dag(Rel) succeeded\n")
+	( { relation__is_dag(Rel) } ->
+		io__write_string("is_dag succeeded\n")
 	;
-		io__write_string("Error: relation__is_dag(Rel2) failed\n")
+		io__write_string("is_dag failed\n")
 	).
 
 :- pred print_rel(relation(T), state, state).
@@ -49,5 +63,5 @@
 print_rel(Relation) -->
 	{ relation__to_assoc_list(Relation, AssocList0) },
 	{ list__sort(AssocList0, AssocList) },
-	write_list(AssocList, "\n", print), nl.
+	write_list(AssocList, "\n\t", print), nl.
 
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------