diff --git a/lib/stdlib/src/erl_stdlib_errors.erl b/lib/stdlib/src/erl_stdlib_errors.erl index b5864c471f0..b7b168064dc 100644 --- a/lib/stdlib/src/erl_stdlib_errors.erl +++ b/lib/stdlib/src/erl_stdlib_errors.erl @@ -233,10 +233,17 @@ format_maps_error(get, [_Key,Map]) -> true -> [[],not_map] end; -format_maps_error(groups_from_list, [Fun, List]) -> - [must_be_fun(Fun, 1), must_be_list(List)]; -format_maps_error(groups_from_list, [Fun1, Fun2, List]) -> - [must_be_fun(Fun1, 1), must_be_fun(Fun2, 1), must_be_list(List)]; +format_maps_error(groups_from_list, [KeyFunOrFuns, List]) -> + [ + format_maps_groups_from_list_keyfun_error(KeyFunOrFuns), + must_be_list(List) + ]; +format_maps_error(groups_from_list, [KeyFunOrFuns, ValueFun, List]) -> + [ + format_maps_groups_from_list_keyfun_error(KeyFunOrFuns), + must_be_fun(ValueFun, 1), + must_be_list(List) + ]; format_maps_error(get, [_,_,_]) -> [[],not_map]; format_maps_error(intersect, [Map1, Map2]) -> @@ -285,6 +292,26 @@ format_maps_error(with, [List, Map]) -> format_maps_error(without, [List, Map]) -> [must_be_list(List), must_be_map(Map)]. +format_maps_groups_from_list_keyfun_error(KeyFun) when is_function(KeyFun, 1) -> + []; +format_maps_groups_from_list_keyfun_error([]) -> + []; +format_maps_groups_from_list_keyfun_error(KeyFuns) -> + try + lists:all(fun(KeyFun) -> is_function(KeyFun, 1) end, KeyFuns) + of + true -> + %% proper list of functions of arity 1 + []; + false -> + %% proper list containing at least one element which is not a function of arity 1 + <<"not a function or list of functions that take one argument">> + catch + error:_ -> + %% not a proper list + <<"not a function or list of functions that take one argument">> + end. + format_math_error(acos, Args) -> maybe_domain_error(Args); format_math_error(acosh, Args) -> diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index f48a5673af6..6c3c84d55e2 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -1145,41 +1145,68 @@ _Examples:_ ```erlang > EvenOdd = fun(X) -> case X rem 2 of 0 -> even; 1 -> odd end end, -maps:groups_from_list(EvenOdd, [1, 2, 3]). + maps:groups_from_list(EvenOdd, [1, 2, 3]). #{even => [2], odd => [1, 3]} > maps:groups_from_list(fun erlang:length/1, ["ant", "buffalo", "cat", "dingo"]). #{3 => ["ant", "cat"], 5 => ["dingo"], 7 => ["buffalo"]} ``` + +Since OTP-28, it is also possible to give a list of `KeyFun`s. The result is +a hierarchy of maps, where the keys of each tier are given by the respective +`KeyFun`. + +_Examples:_ + +```erlang +> Data = [#{continent => asia, country => japan, city => tokyo}, + #{continent => europe, country => germany, city => berlin}, + #{continent => europe, country => germany, city => munich}, + #{continent => europe, country => sweden, city => stockholm}], + ContinentFn = fun(#{continent := Continent}) -> Continent end, + CountryFn = fun(#{country := Country}) -> Country end, + maps:groups_from_list([ContinentFn, CountryFn], Data). +#{asia => + #{japan => + [#{continent => asia, country => japan, city => tokyo}]}, + europe => + #{germany => + [#{continent => europe, country => germany, city => berlin}, + #{continent => europe, country => germany, city => munich}], + sweden => + [#{continent => europe, country => sweden, city => stockholm}]}} +``` """. -doc(#{since => <<"OTP 25.0">>}). --spec groups_from_list(KeyFun, List) -> GroupsMap when +-spec groups_from_list(KeyFunOrFuns, List) -> Group | GroupsMap when + KeyFunOrFuns :: KeyFun | [KeyFun], KeyFun :: fun((Elem) -> Key), - GroupsMap :: #{Key => Group}, + GroupsMap :: #{Key => Group | GroupsMap}, Key :: term(), List :: [Elem], Group :: [Elem], Elem :: term(). -groups_from_list(Fun, List0) when is_function(Fun, 1) -> - try lists:reverse(List0) of - List -> - groups_from_list_1(Fun, List, #{}) +groups_from_list([], List) when is_list(List) -> + List; +groups_from_list([_|_], []) -> + #{}; +groups_from_list([_|_]=KeyFuns, [_|_]=List) -> + %% try/catching via ErrorTag is necessary in order to distinguish + %% invalid input (eg improper lists or non-functions in `KeyFuns`) + %% from errors caused by calling a `KeyFun` + ErrorTag = make_ref(), + try + gfl_1(KeyFuns, + gfl_maybe_reverse(KeyFuns, List, ErrorTag), + ErrorTag) catch - error:_ -> - badarg_with_info([Fun, List0]) + error:ErrorTag -> + badarg_with_info([KeyFuns, List]) end; -groups_from_list(Fun, List) -> - badarg_with_info([Fun, List]). - -groups_from_list_1(Fun, [H | Tail], Acc) -> - K = Fun(H), - NewAcc = case Acc of - #{K := Vs} -> Acc#{K := [H | Vs]}; - #{} -> Acc#{K => [H]} - end, - groups_from_list_1(Fun, Tail, NewAcc); -groups_from_list_1(_Fun, [], Acc) -> - Acc. +groups_from_list(KeyFun, List) when is_function(KeyFun, 1) -> + groups_from_list([KeyFun], List); +groups_from_list(KeyFunOrFuns, List) -> + badarg_with_info([KeyFunOrFuns, List]). -doc """ Partitions the given `List` into a map of groups. @@ -1204,40 +1231,143 @@ _Examples:_ ["ant", "buffalo", "cat", "dingo"]). #{3 => ["tna", "tac"],5 => ["ognid"],7 => ["olaffub"]} ``` + +Since OTP-28, it is also possible to give a list of `KeyFun`s. The result is +a hierarchy of maps, where the keys on each tier are given by the respective +`KeyFun`. + +_Examples:_ + +```erlang +> Data = [#{continent => asia, country => japan, city => tokyo}, + #{continent => europe, country => germany, city => berlin}, + #{continent => europe, country => germany, city => munich}, + #{continent => europe, country => sweden, city => stockholm}], + ContinentFn = fun(#{continent := Continent}) -> Continent end, + CountryFn = fun(#{country := Country}) -> Country end, + CityFn = fun(#{city := City}) -> City end, + maps:groups_from_list([ContinentFn, CountryFn], CityFn, Data). +#{asia => + #{japan => + [tokyo]}, + europe => + #{germany => + [berlin}, + munich], + sweden => + [stockholm]}} +``` """. -doc(#{since => <<"OTP 25.0">>}). --spec groups_from_list(KeyFun, ValueFun, List) -> GroupsMap when +-spec groups_from_list(KeyFunOrFuns, ValueFun, List) -> Group | GroupsMap when + KeyFunOrFuns :: KeyFun | [KeyFun], KeyFun :: fun((Elem) -> Key), ValueFun :: fun((Elem) -> Value), - GroupsMap :: #{Key := Group}, + GroupsMap :: #{Key := Group | GroupsMap}, Key :: term(), Value :: term(), List :: [Elem], Group :: [Value], Elem :: term(). -groups_from_list(Fun, ValueFun, List0) when is_function(Fun, 1), - is_function(ValueFun, 1) -> - try lists:reverse(List0) of - List -> - groups_from_list_2(Fun, ValueFun, List, #{}) +groups_from_list([], ValueFun, []) when is_function(ValueFun, 1) -> + []; +groups_from_list([], ValueFun, [_|_]=List) when is_function(ValueFun, 1) -> + %% try/catching via ErrorTag is necessary in order to distinguish + %% invalid input (eg improper lists or non-functions in `KeyFuns`) + %% from errors caused by calling the `ValueFun` + ErrorTag = make_ref(), + try + gfl_valuemap(ValueFun, List, ErrorTag) catch - error:_ -> - badarg_with_info([Fun, ValueFun, List0]) + error:ErrorTag -> + badarg_with_info([[], ValueFun, List]) end; -groups_from_list(Fun, ValueFun, List) -> - badarg_with_info([Fun, ValueFun, List]). - -groups_from_list_2(Fun, ValueFun, [H | Tail], Acc) -> - K = Fun(H), - V = ValueFun(H), - NewAcc = case Acc of - #{K := Vs} -> Acc#{K := [V | Vs]}; - #{} -> Acc#{K => [V]} - end, - groups_from_list_2(Fun, ValueFun, Tail, NewAcc); -groups_from_list_2(_Fun, _ValueFun, [], Acc) -> - Acc. +groups_from_list([_|_], ValueFun, []) when is_function(ValueFun, 1) -> + #{}; +groups_from_list([_|_]=KeyFuns, ValueFun, [_|_]=List) when is_function(ValueFun, 1) -> + %% try/catching via ErrorTag is necessary in order to distinguish + %% invalid input (eg improper lists or non-functions in `KeyFuns`) + %% from errors caused by calling a `KeyFun` or the `ValueFun` + ErrorTag = make_ref(), + try + gfl_valuemapping_1(KeyFuns, + ValueFun, + gfl_maybe_reverse(KeyFuns, List, ErrorTag), + ErrorTag) + catch + error:ErrorTag -> + badarg_with_info([KeyFuns, ValueFun, List]) + end; +groups_from_list(KeyFun, ValueFun, List) when is_function(KeyFun, 1) -> + groups_from_list([KeyFun], ValueFun, List); +groups_from_list(KeyFun, ValueFun, List) -> + badarg_with_info([KeyFun, ValueFun, List]). + +gfl_1([KeyFun], List, ErrorTag) when is_function(KeyFun, 1) -> + gfl_2(KeyFun, List, ErrorTag, #{}); +gfl_1([KeyFun|KeyFuns], List, ErrorTag) when is_function(KeyFun, 1) -> + #{K => gfl_1(KeyFuns, V, ErrorTag) + || + K := V <- gfl_2(KeyFun, List, ErrorTag, #{})}; +gfl_1(_, _, ErrorTag) -> + error(ErrorTag). + +gfl_2(KeyFun, [E|List], ErrorTag, Acc0) -> + K = KeyFun(E), + Acc1 = case Acc0 of + #{K := Old} -> Acc0#{K := [E|Old]}; + #{} -> Acc0#{K => [E]} + end, + gfl_2(KeyFun, List, ErrorTag, Acc1); +gfl_2(_, [], _, Acc) -> + Acc; +gfl_2(_, _, ErrorTag, _) -> + error(ErrorTag). + +gfl_valuemapping_1([KeyFun], ValueFun, List, ErrorTag) when is_function(KeyFun, 1) -> + gfl_valuemapping_2(KeyFun, ValueFun, List, ErrorTag, #{}); +gfl_valuemapping_1([KeyFun|KeyFuns], ValueFun, List, ErrorTag) when is_function(KeyFun, 1) -> + #{K => gfl_valuemapping_1(KeyFuns, ValueFun, V, ErrorTag) + || + K := V <- gfl_2(KeyFun, List, ErrorTag, #{})}; +gfl_valuemapping_1(_, _, _, ErrorTag) -> + error(ErrorTag). + +gfl_valuemapping_2(KeyFun, ValueFun, [E|List], ErrorTag, Acc0) -> + K = KeyFun(E), + V = ValueFun(E), + Acc1 = case Acc0 of + #{K := Old} -> Acc0#{K := [V|Old]}; + #{} -> Acc0#{K => [V]} + end, + gfl_valuemapping_2(KeyFun, ValueFun, List, ErrorTag, Acc1); +gfl_valuemapping_2(_, _, [], _, Acc) -> + Acc; +gfl_valuemapping_2(_, _, _, ErrorTag, _) -> + error(ErrorTag). + +gfl_valuemap(ValueFun, [E|List], ErrorTag) -> + [ValueFun(E) | gfl_valuemap(ValueFun, List, ErrorTag)]; +gfl_valuemap(_, [], _) -> + []; +gfl_valuemap(_, _, ErrorTag) -> + error(ErrorTag). + +gfl_maybe_reverse([], List, _) -> + List; +gfl_maybe_reverse([_, _], List, _) -> + List; +gfl_maybe_reverse(KeyFuns, List, ErrorTag) -> + try + case length(KeyFuns) rem 2 of + 0 -> List; + 1 -> lists:reverse(List) + end + catch + error:_ -> + error(ErrorTag) + end. error_type(M) when is_map(M) -> badarg; error_type(V) -> {badmap, V}. diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 0f203988038..bcb27586dc6 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -45,7 +45,8 @@ t_from_keys_check_trapping/1, t_keys_trapping/1, t_values_trapping/1, - t_groups_from_list/1]). + t_groups_from_list/1, + t_groups_from_list_2/1]). -define(badmap(V,F,Args), {'EXIT', {{badmap,V}, [{maps,F,Args,_}|_]}}). -define(badkey(K,F,Args), {'EXIT', {{badkey,K}, [{maps,F,Args,_}|_]}}). @@ -74,7 +75,8 @@ all() -> t_from_keys_check_trapping, t_keys_trapping, t_values_trapping, - t_groups_from_list]. + t_groups_from_list, + t_groups_from_list_2]. t_from_list_kill_process(Config) when is_list(Config) -> Killer = self(), @@ -932,6 +934,7 @@ t_size_1(Config) when is_list(Config) -> t_groups_from_list(_Config) -> #{} = maps:groups_from_list(fun erlang:length/1, []), + #{} = maps:groups_from_list(fun erlang:length/1, fun lists:reverse/1, []), #{3 := ["tna","tac"], 5 := ["ognid"], 7 := ["olaffub"]} = maps:groups_from_list( fun erlang:length/1, @@ -940,6 +943,57 @@ t_groups_from_list(_Config) -> ), #{0 := [2], 1 := [1, 3]} = maps:groups_from_list(fun(X) -> X rem 2 end, [1, 2, 3]). +t_groups_from_list_2(Config) when is_list(Config) -> + Rem2 = fun(X) -> X rem 2 end, + Rem3 = fun(X) -> X rem 3 end, + Sq = fun(X) -> X * X end, + List = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10], + [] = maps:groups_from_list([], []), + #{} = maps:groups_from_list([Rem2], []), + #{} = maps:groups_from_list([Rem3], []), + #{} = maps:groups_from_list([Rem2, Rem3], []), + [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10] = maps:groups_from_list([], List), + #{0 := [0, 2, 4, 6, 8, 10], + 1 := [1, 3, 5, 7, 9]} = maps:groups_from_list([Rem2], List), + #{0 := [0, 3, 6, 9], + 1 := [1, 4, 7, 10], + 2 := [2, 5, 8]} = maps:groups_from_list([Rem3], List), + #{0 := #{0 := [0, 6], + 1 := [4, 10], + 2 := [2, 8]}, + 1 := #{0 := [3, 9], + 1 := [1, 7], + 2 := [5]}} = maps:groups_from_list([Rem2, Rem3], List), + #{0 := #{0 := [0, 6], + 1 := [3, 9]}, + 1 := #{0 := [4, 10], + 1 := [1, 7]}, + 2 := #{0 := [2, 8], + 1 := [5]}} = maps:groups_from_list([Rem3, Rem2], List), + [] = maps:groups_from_list([], Sq, []), + #{} = maps:groups_from_list([Rem2], Sq, []), + #{} = maps:groups_from_list([Rem3], Sq, []), + #{} = maps:groups_from_list([Rem2, Rem3], Sq, []), + [0, 1, 4, 9, 16, 25, 36, 49, 64, 81, 100] = maps:groups_from_list([], Sq, List), + #{0 := [0, 4, 16, 36, 64, 100], + 1 := [1, 9, 25, 49, 81]} = maps:groups_from_list([Rem2], Sq, List), + #{0 := [0, 9, 36, 81], + 1 := [1, 16, 49, 100], + 2 := [4, 25, 64]} = maps:groups_from_list([Rem3], Sq, List), + #{0 := #{0 := [0, 36], + 1 := [16, 100], + 2 := [4, 64]}, + 1 := #{0 := [9, 81], + 1 := [1, 49], + 2 := [25]}} = maps:groups_from_list([Rem2, Rem3], Sq, List), + #{0 := #{0 := [0, 36], + 1 := [9, 81]}, + 1 := #{0 := [16, 100], + 1 := [1, 49]}, + 2 := #{0 := [4, 64], + 1 := [25]}} = maps:groups_from_list([Rem3, Rem2], Sq, List), + ok. + error_info(_Config) -> BadIterator = [-1|#{}], BadIterator2 = {x, y, z}, @@ -986,11 +1040,14 @@ error_info(_Config) -> {get, [key, {no,map}, default]}, {groups_from_list, [not_a_fun, []]}, - {groups_from_list, [fun hd/1, not_a_list]}, + {groups_from_list, [fun hd/1, not_a_list], [allow_rename]}, + {groups_from_list, [[fun hd/1], not_a_list]}, {groups_from_list, [not_a_fun, fun(_) -> ok end, []]}, - {groups_from_list, [fun(_) -> ok end, not_a_fun, []]}, - {groups_from_list, [fun(_) -> ok end, fun(_) -> ok end, not_a_list]}, + {groups_from_list, [fun(_) -> ok end, not_a_fun, []], [allow_rename]}, + {groups_from_list, [[fun(_) -> ok end], not_a_fun, []]}, + {groups_from_list, [fun(_) -> ok end, fun(_) -> ok end, not_a_list], [allow_rename]}, + {groups_from_list, [[fun(_) -> ok end], fun(_) -> ok end, not_a_list]}, {intersect, [#{a => b}, y]}, {intersect, [x, #{a => b}]},