Association of Associations : how to permute level 1 and level 2 keys?

Question

I have a ragged Association of Association, say :

assoc = Association[
  "1" -> Association["a" -> "x", "b" -> "y"], 
  "2" -> Association[            "b" -> "z", "c" -> "k"]
                   ]  

I would like to transform it into a Association where level 1 and level 2 keys are reversed, that is to say :

Association[
      "a" -> Association["1" -> "x"], 
      "b" -> Association["1" -> "y", "2" -> "z"],
      "c" -> Association[            "2" -> "k"]
           ]

My solution is :

keysExplodedList = Reap[MapIndexed[Sow[Reverse[#2] -> #1] &, assoc, {2}]][[2, 1]]
groupedLevel1 = GroupBy[#[[1, 1]] &] @ keysExplodedList
groupedLevel2 = GroupBy[#[[1, 2]] &] /@ groupedLevel1
result = Map[#[[1, 2]] &, groupedLevel2, {2}]

<|"a" -> <|"1" -> "x"|>, "b" -> <|"1" -> "y", "2" -> "z"|>, "c" -> <|"2" -> "k"|>|>

Is there something more elegant ?

Answer 1

Mathematica 10.1 almost supports this operation directly:

assoc // Query[Transpose]

(*
<| "a" -> <|"1" -> "x", "2" -> Missing["KeyAbsent", "a"]|>,
   "b" -> <|"1" -> "y", "2" -> "z"|>,
   "c" -> <|"1" -> Missing["KeyAbsent", "c"], "2" -> "k"|>
|>
*)

All that remains is to delete the unwanted Missing elements:

assoc // Query[Transpose] // DeleteMissing[#, 2]&

(*
<| "a" -> <|"1" -> "x"|>,
   "b" -> <|"1" -> "y", "2" -> "z"|>, 
   "c" -> <|"2" -> "k"|>
|>
*)

We can see that Query uses the undocumented function GeneralUtilities`AssociationTranspose to do the heavy-lifting:

Query[Transpose] // Normal

(* GeneralUtilities`AssociationTranspose *)

assoc // GeneralUtilities`AssociationTranspose

(*
<| "a" -> <|"1" -> "x", "2" -> Missing["KeyAbsent", "a"]|>,
   "b" -> <|"1" -> "y", "2" -> "z"|>,
   "c" -> <|"1" -> Missing["KeyAbsent", "c"], "2" -> "k"|>
|>
*)

An Imperative Solution

The words "elegant" and "imperative" rarely appear together these days, but an imperative solution can express the transposition directly:

Module[{r = <| |>}
, Do[r = Merge[{r, <| j -> <| i -> assoc[[i, j]] |> |>}, Association]
  , {i, Keys[assoc]}
  , {j, Keys[assoc[[i]]]}
  ]
; r
]

(*
<| "a" -> <|"1" -> "x"|>,
   "b" -> <|"1" -> "y", "2" -> "z"|>, 
   "c" -> <|"2" -> "k"|>
|>
*)

A ScanIndexed operator would come in handy here (the undocumented one in GeneralUtilities` is not, well, general enough).

Answer 2

Not as nice as what WReach posted but this is what I came up with:

GroupBy[
  Join @@ Thread /@ Normal //@ assoc,
  {First@*Last, First}
][[All, All, 1, 2, 2]]

<|"a" -> <|"1" -> "x"|>, "b" -> <|"1" -> "y", "2" -> "z"|>, "c" -> <|"2" -> "k"|>|>

Answer 3

Here is another version, using KeyValueMap (needs 10.1):

regroup = 
  Composition[
    Map[Association],
    GroupBy[First -> Last],
    Flatten,
    Normal,
    KeyValueMap[Function[{k, v}, Map[k -> # &, v]]]
  ];

So that

regroup @ assoc

(* <|"a" -> <|"1" -> "x"|>, "b" -> <|"1" -> "y", "2" -> "z"|>, "c" -> <|"2" -> "k"|>|> *)

Answer 4

Just for completeness:

assoc // Query[ Transpose /* Map[ DeleteMissing ] ]

<|"a" -> <|"1" -> "x"|>, "b" -> <|"1" -> "y", "2" -> "z"|>, "c" -> <|"2" -> "k"|>|>

Answer 5

DeleteMissing /@ GeneralUtilities`AssociationTranspose[assoc]

<|a-><|1->x|>,b-><|1->y,2->z|>,c-><|2->k|>|>

---

I have not noted WReach have mentioned this method here.But I think this is a bug behavior in function Transpose when it process Association.And I have report it to Wolfram Research before this.And there is workaround to avoid this bug

DeleteMissing /@ Normal[Transpose[Dataset[assoc]]]

<|a-><|1->x|>,b-><|1->y,2->z|>,c-><|2->k|>|>