How to do a Hierarchical GroupBy?

Consider a simple expr as an example:

expr = {
{a},{a,b},{a,c},{a,b,c,d},{a,b,c,f},
{b,c},{b,d}
};


I want to GroupBy as much as possible keeping the hierarchy of Keys intact then apply a function func on the leaves.

hierarchicalGroupBy[expr, func]

{
a->{b->{c->{func[d],func[f]}},func[c]},
b->{func[c],func[d]}
}


I forgot the case of a (long) branch with a single leaf (below is the updated example):

{
{a},{a,b},{a,b,c,d},{a,b,c,f},{a,b,d,e},{a,b,e,d,c,f},{a,c},
{b,c},{b,d},
{c}
}


This should convert to:

{
a->{b->{c->{func[d],func[f]},d->func[e],e->d->c->func[f]},func[c]},
b->{func[c],func[d]},
func[c]
}


Proceed in two steps: first, recursive GroupBy with pruning at the leaves (DeleteCases[{}]) and generating lists-of-rules instead of associations (Normal):

hgb[A_] := Normal@GroupBy[A, First -> Rest, hgb@*DeleteCases[{}]]


Then, at the end apply the function F to the leaves, being careful to delay the application (:>) just in case F needs it:

HierarchicalGroupBy[A_, F_] := hgb[A] /. (x_ -> {}) :> F[x]


Try it out:

expr = {{a}, {a, b}, {a, c}, {a, b, c, d}, {a, b, c, f}, {b, c}, {b, d}};
HierarchicalGroupBy[expr, func]

(*    {a -> {b -> {c -> {func[d], func[f]}}, func[c]},
b -> {func[c], func[d]}}                           *)


To do the updated example, we can still use the above GroupBy recursion and redefine

HierarchicalGroupBy[A_, F_] := hgb[A] //. {(x_ -> {y_}) -> (x -> y),
(x_ -> {}) :> F[x]}


so that

expr2 = {{a}, {a, b}, {a, b, c, d}, {a, b, c, f}, {a, b, d, e},
{a, b, e, d, c, f}, {a, c}, {b, c}, {b, d}, {c}};
HierarchicalGroupBy[expr2, func]

(*    {a -> {b -> {c -> {func[d], func[f]}, d -> func[e],
e -> d -> c -> func[f]}, func[c]}, b -> {func[c], func[d]},
func[c]}                                                       *)

• Can you please try on the updated example if your solution works properly for a branch with a single leaf. – user13892 Feb 14 '20 at 21:57
• Here's my code in @kglr's one-line style as an anonymous recursion using the #0 slot: HierarchicalGroupBy = Normal@GroupBy[#,First->Rest,#0@*DeleteCases[{}]]&@#//.{(x_->{y_})->(x->y),(x_->{}):>#2@x}& – Roman Feb 15 '20 at 8:47

A variation on Roman's idea:

ClearAll[hG]
hG = Normal @ GroupBy[# /. {} -> Nothing , First -> Rest,  Function[x, hG[x, #2]]] /.
{Rule[a_, {b_}] :> Rule[a, b], Rule[a_, {}] :> #2[a]} &;

hG[expr, func]


{a -> {b -> c -> {func[d], func[f]}, func[c]}, b -> {func[c], func[d]}}

hG[expr2, func]


{a -> {b -> {c -> {func[d], func[f]}, d -> func[e], e -> d -> c -> func[f]}, func[c]}, b -> {func[c], func[d]}, func[c]}

• Interesting use of a pure function with a free variable to avoid the need for an auxiliary function! If I understand correctly your modification didn't need ReplaceRepeated because you are making replacement at each step of the GroupBy recursion itself right? – user13892 Feb 14 '20 at 23:52