unlisting a nested list

Question

I have a list like this:

list = {{a,{1,2,3}},{b,{1,2,4}},{c,{{1,4,5,5},{6,3,2,1}}}}

This is a nested list which each element has a name. I want to export it to CSV so I want to un-nest it to look like:

unlist = {{a,{1,2,3}},{b,{1,2,4}},{c1,{1,4,5}},{c2,{6,3,2,1}}}

As the list is very dynamic, the solution solution should be dynamic as well. I mean in different files the list has different lengths but the nesting structure is the same.

How can I deal with this?

Answer 1

Here is the solution proposed by Kuba, I just deleted the second part of list since it has no use here.

list = {{a, {1, 2, 3}}, {c, {{1, 4, 5, 5}, {6, 3, 2, 1}}}};
list /. {s_, x : {__List}} :> 
  (## & @@  Table[{Symbol[SymbolName[s] <> ToString[i]], x[[ i]]}, {i, Length@x}])

---

And here is an attempt to explain it:

list = {{a, {1, 2, 3}}, {c, {{1, 4, 5, 5}, {6, 3, 2, 1}}}};
Module[{foo = Cases[list, {s_, x : {__List}} :> {s, x}], x, s, table},
 Print@foo;
 s = foo[[1, 1]]; Print@s;
 x = foo[[1, 2]]; Print@x;
 Print@{Symbol[SymbolName[s] <> ToString[1]], x[[1]]};
 table = Table[{Symbol[SymbolName[s] <> ToString[i]], x[[i]]}, {i, Length@x}]; Print@table;
 ]

{{c, {{1, 4, 5, 5}, {6, 3, 2, 1}}}}
c
{{1, 4, 5, 5}, {6, 3, 2, 1}}
{c1, {1, 4, 5, 5}}
{{c1, {1, 4, 5, 5}}, {c2, {6, 3, 2, 1}}}

Then list /. x :> y means "take x in list and replace it by y". Thus

list /. foo :> (## & @@ table)

means "take foo in list and replace it by (## & @@ table)" where ## & @@ is a trick to elegantly insert the Lists under the {ci, {li}} form.

Key points:

• Pattern,
• Symbol and SymbolName,
• Replace.

Answer 2

Since I cannot explain Kuba's elegant solution here is a step for step approach to your problem:

list = {{a, {1, 2, 3}}, {b, {1, 2, 4}}, {c, {{1, 4, 5, 5}, {6, 3, 2, 1}, {7, 4, 5}}}};

Find the position of the last symbol (c):

p = First@Last@Position[list, s_Symbol /; s =!= List]

3

(Since List is a Symbol I excluded it in the above statement).

Now get the matrix prepended by the last symbol:

q = list[[p, 2]]

{{1, 4, 5, 5}, {6, 3, 2, 1}, {7, 4, 5}}

Prepend q with c1... ci:

tab = Table[{ToExpression["c" <> ToString[i]], q[[i]]}, {i, 1, Length@q}]

{{c1, {1, 4, 5, 5}}, {c2, {6, 3, 2, 1}}, {c3, {7, 4, 5}}}

Find the positions of entries which already had symbols:

h = Most@Range@p

{1, 2}

list[[h]]~Join~tab

{{a, {1, 2, 3}}, {b, {1, 2, 4}}, {c1, {1, 4, 5, 5}}, {c2, {6, 3, 2, 1}}, {c3, {7, 4, 5}}}

Put everything together:

fun[list_] :=
 With[{p = First@Last@Position[list, s_Symbol /; s =!= List]},
  list[[Most@Range@p]]~Join~
     Table[{ToExpression["c" <> ToString[i]], #[[i]]}, {i, 1, 
       Length@#}] &[list[[p, 2]]]]

fun@list

{{a, {1, 2, 3}}, {b, {1, 2, 4}}, {c1, {1, 4, 5, 5}}, {c2, {6, 3, 2, 1}}, {c3, {7, 4, 5}}}

Answer 3

My interpretation of what you want. These are equivalent; take your pick for readability or flexibility.

list /. {x_, a : {__List}} :> Thread @ {Array[x, Length@a], a}

list /. {x_, a : {__List}} :> Array[{x[#], a[[#]]} &, Length @ a]

list /. {x_, a : {__List}} :> MapIndexed[{x[First @ #2], #} &, a]

{{a, {1, 2, 3}}, {b, {1, 2, 4}}, {{c[1], {1, 4, 5, 5}}, {c[2], {6, 3, 2, 1}}}}

You can use Replace with a levelspec if you need to restrict the replacement to a particular depth.