# How do I transpose the first and deepest levels of an arbitrarily nested array?

Is there a straightforward way to convert

arr = {
{a, b}, {a, b}, {{{a, b}, {a, b}, {a, b}}, {{a, b}, {a, b}, {a, b}}}
};


to:

{{a, a, {{a, a, a}, {a, a, a}}}, {b, b, {{b, b, b}, {b, b, b}}}}


?

I need to swap the first and last dimension. Which should in principle be possible, because, although arr does not have a fixed structure, the 'bottom' is always uniform:

Level[arr, {-2}]

{{a, b}, {a, b}, {a, b}, {a, b}, {a, b}, {a, b}, {a, b}, {a, b}}


Had Transpose/Flatten/MapThread accepted a negative level specification, it would have been easy. That is not the case.

One can think about that question as: How do I create arr2 so that arr[[whatever__, y_]] == arr2[[y, whatever__]]?

EDIT:

In general Level[arr, {-2}] should be a rectangular array, but rows do not need to be the same.

So this:

{{a1, b1}, {{{a2, b2}, {a3, b3}}, {{a4, b4}, {a5, b5}, {a6, b6}}}, {{{{a7,b7}}}} };


should end up:

{ {a1, {{a2, a3}, {a4, a5, a6}}, {{{a7}}} }, ...};

• Not a solution, but Flatten[MapIndexed[RotateRight[#2] -> #1 &, arr, {-1}]] gives you a list of rules of what needs to be constructed. I don't know of a way to construct it though: SparseArray does not construct ragged structures. – Roman Mar 29 at 19:41
• Maybe something along the lines of arr /. {{{a,b}->a},{{a,b}->b}}? Or perhaps more generally, arr /. {{a_?VectorQ :> First@a}, {a_?VectorQ :> Last@a}}? – Carl Woll Mar 29 at 19:43
• @Kuba maybe you can come up with a recursion that constructs the result from the list of rules I gave 4 lines up? That would be a handy tool to have in any case. – Roman Mar 29 at 19:52

arr = {{a, b}, {a, b}, {{{a, b}, {a, b}, {a, b}}, {{a, b}, {a, b}, {a, b}}}};

SetAttributes[f1, Listable]
Apply[f1, arr, {0, -3}] /. f1 -> List


{{a, a, {{a, a, a}, {a, a, a}}}, {b, b, {{b, b, b}, {b, b, b}}}}

This is what the list at the lowest level looks like:

el = First@Level[list, {-2}];


Using this, we can solve it with a rules-based approach:

list /. el -> # & /@ el


or a recursive approach like this:

walk[lists : {__List}, i_] := walk[#, i] & /@ lists
walk[atoms : {__}, i_] := i
walk[list, #] & /@ el


Terrible solution using Table but works:

Table[Map[#[[i]] &, arr, {-2}], {i, Last[Dimensions[Level[arr, {-2}]]]}]


This is a bit roundabout but very versatile. First convert the structure arr into a list of rules, then reassemble these rules (after proper modification using RotateRight to transpose first and deepest levels) into a new structure.

Using the toTree function from this answer (thanks to @b3m2a1 !):

arr = {{a, b}, {a, b}, {{{a, b}, {a, b}, {a, b}}, {{a, b}, {a, b}, {a, b}}}};
toTree[Flatten[MapIndexed[RotateRight[#2] -> #1 &, arr, {-1}]]]


{{a, a, {{a, a, a}, {a, a, a}}}, {b, b, {{b, b, b}, {b, b, b}}}}