Add map.select_unselect and map.select_unselect_sorted_list.

library/map.m: As above. NEWS: Announce the new predicates. tests/hard_coded/map_select_test.{m,err_exp}: A test case for the new code. tests/hard_coded/Mmakefile: Enable the new test case.
2025-12-10 19:33:11 +00:00 · 2019-06-05 17:25:49 +02:00
parent a53174c767
commit 1afe6d2594
5 changed files with 166 additions and 18 deletions
--- a/2
+++ b/2
@@ -385,6 +385,8 @@ Changes to the Mercury standard library:
   - foldr5/12
   - intersect_list/4
   - union_list/4
+   - select_unselect/4
+   - select_unselect_sorted_list/4

 * The following predicate has been added to the set modules:

--- a/library/map.m
+++ b/library/map.m
@@ -338,12 +338,30 @@
 :- func select(map(K, V), set(K)) = map(K, V).
 :- pred select(map(K, V)::in, set(K)::in, map(K, V)::out) is det.

-    % select_sorted_list takes a map and a sorted list of keys, and returns
-    % a map containing the keys in the list and their corresponding values.
+    % select_sorted_list takes a map and a sorted list of keys without
+    % duplicates, and returns a map containing the keys in the list
+    % and their corresponding values.
    %
 :- func select_sorted_list(map(K, V), list(K)) = map(K, V).
 :- pred select_sorted_list(map(K, V)::in, list(K)::in, map(K, V)::out) is det.

+    % select_unselect takes a map and a set of keys, and returns two maps:
+    % the first containing the keys in the set and their corresponding values,
+    % the second containing the keys NOT in the set and their corresponding
+    % values.
+    %
+:- pred select_unselect(map(K, V)::in, set(K)::in,
+    map(K, V)::out, map(K, V)::out) is det.
+
+    % select_unselect_sorted_list takes a map and a sorted list of keys
+    % without duplicates, and returns two maps:
+    % the first containing the keys in the list and their corresponding values,
+    % the second containing the keys NOT in the list and their corresponding
+    % values.
+    %
+:- pred select_unselect_sorted_list(map(K, V)::in, list(K)::in,
+    map(K, V)::out, map(K, V)::out) is det.
+
    % Given a list of keys, produce a list of their corresponding
    % values in a specified map.
    %
@@ -1309,33 +1327,87 @@ overlay_large_map_2([K - V | AssocList], Map0, Map) :-

 %---------------------------------------------------------------------------%

-select(M1, S) = M2 :-
-    map.select(M1, S, M2).
+select(FullMap, KeySet) = SelectMap :-
+    map.select(FullMap, KeySet, SelectMap).

-select(Original, KeySet, NewMap) :-
+select(FullMap, KeySet, SelectMap) :-
    set.to_sorted_list(KeySet, Keys),
-    map.init(NewMap0),
-    map.select_loop(Keys, Original, NewMap0, NewMap).
+    select_sorted_list(FullMap, Keys, SelectMap).

-select_sorted_list(M1, S) = M2 :-
-    map.select_sorted_list(M1, S, M2).
+select_sorted_list(FullMap, Keys) = SelectMap :-
+    map.select_sorted_list(FullMap, Keys, SelectMap).

-select_sorted_list(Original, Keys, NewMap) :-
-    map.init(NewMap0),
-    map.select_loop(Keys, Original, NewMap0, NewMap).
+select_sorted_list(FullMap, Keys, SelectMap) :-
+    map.select_loop(Keys, FullMap, [], RevSelectAL),
+    map.from_rev_sorted_assoc_list(RevSelectAL, SelectMap).

 :- pred select_loop(list(K)::in, map(K, V)::in,
-    map(K, V)::in, map(K, V)::out) is det.
+    assoc_list(K, V)::in, assoc_list(K, V)::out) is det.
 :- pragma type_spec(map.select_loop/4, K = var(_)).

-select_loop([], _Original, !New).
-select_loop([K | Ks], Original, !New) :-
-    ( if map.search(Original, K, V) then
-        map.det_insert(K, V, !New)
+select_loop([], _FullMap, !RevSelectAL).
+select_loop([K | Ks], FullMap, !RevSelectAL) :-
+    ( if map.search(FullMap, K, V) then
+        !:RevSelectAL = [K - V | !.RevSelectAL]
    else
        true
    ),
-    map.select_loop(Ks, Original, !New).
+    map.select_loop(Ks, FullMap, !RevSelectAL).
+
+%---------------------%
+
+select_unselect(FullMap, KeySet, SelectMap, UnselectMap) :-
+    set.to_sorted_list(KeySet, Keys),
+    select_unselect_sorted_list(FullMap, Keys, SelectMap, UnselectMap).
+
+select_unselect_sorted_list(FullMap, Keys, SelectMap, UnselectMap) :-
+    map.to_assoc_list(FullMap, FullAL),
+    map.select_unselect_loop(FullAL, Keys, [], RevSelectAL, [], RevUnselectAL),
+    map.from_rev_sorted_assoc_list(RevSelectAL, SelectMap),
+    map.from_rev_sorted_assoc_list(RevUnselectAL, UnselectMap).
+
+:- pred select_unselect_loop(assoc_list(K, V)::in, list(K)::in,
+    assoc_list(K, V)::in, assoc_list(K, V)::out,
+    assoc_list(K, V)::in, assoc_list(K, V)::out) is det.
+
+select_unselect_loop([], _, !RevSelectAL, !RevUnselectAL).
+select_unselect_loop(FullAL @ [FullK - FullV | TailFullAL], KeysAL,
+        !RevSelectAL, !RevUnselectAL) :-
+    (
+        KeysAL = [],
+        % There are no keys left in the key set.
+        % Move FullK - FullV (and every pair after them) to the unselect list.
+        NextFullAL = TailFullAL,
+        NextKeysAL = KeysAL,
+        !:RevUnselectAL = [FullK - FullV | !.RevUnselectAL]
+    ;
+        KeysAL = [KeyK | TailKeysAL],
+        compare(Result, KeyK, FullK),
+        (
+            Result = (<),
+            % KeyK does not occur in the full map. Consume it.
+            NextFullAL = FullAL,
+            NextKeysAL = TailKeysAL
+        ;
+            Result = (=),
+            % KeyK does occur in the full map. Consume both it
+            % and the matching FullK - FullV pair, and move the pair
+            % to the select list.
+            NextFullAL = TailFullAL,
+            NextKeysAL = TailKeysAL,
+            !:RevSelectAL = [FullK - FullV | !.RevSelectAL]
+        ;
+            Result = (>),
+            % We don't yet know whether KeyK occurs in the full map,
+            % but we know that FullK is not in the key set.
+            % Move the FullK - FullV pair to the unselect list.
+            NextFullAL = TailFullAL,
+            NextKeysAL = KeysAL,
+            !:RevUnselectAL = [FullK - FullV | !.RevUnselectAL]
+        )
+    ),
+    map.select_unselect_loop(NextFullAL, NextKeysAL,
+        !RevSelectAL, !RevUnselectAL).

 %---------------------------------------------------------------------------%

--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -237,6 +237,7 @@ ORDINARY_PROGS = \
 	loop_inv_test3 \
 	loop_inv_test4 \
 	map_fold \
+	map_select_test \
 	mapped_module \
 	merge_and_remove_dups \
 	mode_check_clauses \
--- a/tests/hard_coded/map_select_test.err_exp
+++ b/tests/hard_coded/map_select_test.err_exp
@@ -0,0 +1,2 @@
+[10 - 100, 15 - 1500, 20 - 200, 30 - 300, 40 - 400, 45 - 4500, 50 - 500, 60 - 600, 70 - 700, 75 - 7500, 80 - 800, 90 - 900, 100 - 1000]
+[2 - 20, 3 - 300, 4 - 40, 6 - 60, 8 - 80, 9 - 900, 12 - 120, 14 - 140, 16 - 160, 18 - 180, 21 - 2100, 22 - 220, 24 - 240, 26 - 260, 27 - 2700, 28 - 280, 32 - 320, 33 - 3300, 34 - 340, 36 - 360, 38 - 380, 39 - 3900, 42 - 420, 44 - 440, 46 - 460, 48 - 480, 51 - 5100, 52 - 520, 54 - 540, 56 - 560, 57 - 5700, 58 - 580, 62 - 620, 63 - 6300, 64 - 640, 66 - 660, 68 - 680, 69 - 6900, 72 - 720, 74 - 740, 76 - 760, 78 - 780, 81 - 8100, 82 - 820, 84 - 840, 86 - 860, 87 - 8700, 88 - 880, 92 - 920, 93 - 9300, 94 - 940, 96 - 960, 98 - 980, 99 - 9900]
--- a/tests/hard_coded/map_select_test.m
+++ b/tests/hard_coded/map_select_test.m
@@ -0,0 +1,71 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module map_select_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module require.
+
+%---------------------------------------------------------------------------%
+
+main(!IO) :-
+    init_map(100, 1, [], Pairs),
+    map.from_assoc_list(Pairs, FullMap),
+    init_keys(100, 5, [], UnsortedKeys),
+    list.sort(UnsortedKeys, SortedKeys),
+
+    map.select_sorted_list(FullMap, SortedKeys, SelectedMapA),
+    map.select_unselect_sorted_list(FullMap, SortedKeys,
+        SelectedMapB, UnselectedMapB),
+    map.to_sorted_assoc_list(SelectedMapA, SelectedAssocListA),
+    map.to_sorted_assoc_list(SelectedMapB, SelectedAssocListB),
+    map.to_sorted_assoc_list(UnselectedMapB, UnselectedAssocListB),
+    expect(unify(SelectedAssocListA, SelectedAssocListB), $pred,
+        "SelectedAssocListA != SelectedAssocListB"),
+    io.write_line(SelectedAssocListB, !IO),
+    io.write_line(UnselectedAssocListB, !IO).
+
+:- pred init_map(int::in, int::in,
+    assoc_list(int, int)::in, assoc_list(int, int)::out) is det.
+
+init_map(Max, Cur, !AssocList) :-
+    ( if Cur > Max then
+        true
+    else
+        ( if Cur mod 2 = 0 then
+            !:AssocList = [Cur - Cur * 10 | !.AssocList]
+        else if Cur mod 3 = 0 then
+            !:AssocList = [Cur - Cur * 100 | !.AssocList]
+        else
+            true
+        ),
+        init_map(Max, Cur + 1, !AssocList)
+    ).
+
+:- pred init_keys(int::in, int::in, list(int)::in, list(int)::out) is det.
+
+init_keys(Max, Cur, !List) :-
+    ( if Cur > Max then
+        true
+    else
+        !:List = [Cur | !.List],
+        init_keys(Max, Cur + 5, !List)
+    ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%