List of lists of lists how to make a map recursively

 list = {ab, ad, {be, br, pb, {cd, cr, ce, {fo}, {gf, gh, gv, gg},  ne, {ks, kd, kl}, {sa, sx, sr, {sdr, svd, {ssfrt, styi}, {sfc, sfb, smaa}, ja}}}}, aw}


I would like to produce all this outputs with a Fold or Nest or so but it's over my level ...

tdl1 = Table[
If[ListQ[list[[i]]], {i, Length[list[[i]]]}, list[[i]]],
{i, Length[list]}
]


tdl2 = Table[
If[ListQ[list[[3, i]]], {i, Length[list[[3, i]]]}, list[[3, i]]],
{i, tdl1[[3, 2]]}
]


{be, br, pb, {4, 8}}

tdl3 = Table[
If[ListQ[list[[3, 4, i]]], {i, Length[list[[3, 4, i]]]}, list[[3, 4, i]]],
{i, tdl2[[4, 2]]}
]


{cd, cr, ce, {4, 1}, {5, 4}, ne, {7, 3}, {8, 4}}

tdl4 = Table[
If[ListQ[list[[3, 4, 4, i]]], {i, Length[list[[3, 4, 4, i]]]},  list[[3, 4, 4, i]]],
{i, tdl3[[4, 2]]}
]


{fo}

tdl5 = Table[
If[ListQ[list[[3, 4, 5, i]]], {i, Length[list[[3, 4, 5, i]]]},  list[[3, 4, 5, i]]],
{i, tdl3[[5, 2]]}
]


{gf, gh, gv, gg}

tdl6 = Table[
If[ListQ[list[[3, 4, 7, i]]], {i, Length[list[[3, 4, 7, i]]]},  list[[3, 4, 7, i]]],
{i, tdl3[[7, 2]]}
]


{ks, kd, kl}

tdl7 = Table[
If[ListQ[list[[3, 4, 8, i]]], {i, Length[list[[3, 4, 8, i]]]}, list[[3, 4, 8, i]]],
{i, tdl3[[8, 2]]}
]


{sa, sx, sr, {4, 5}}

tdl8 = Table[
If[ListQ[list[[3, 4, 8, 4, i]]], {i, Length[list[[3, 4, 8, 4, i]]]}, list[[3, 4, 8, 4, i]]],
{i, tdl7[[4, 2]]}
]


{sdr, svd, {3, 2}, {4, 3}, ja}

tdl9 = Table[
If[ListQ[list[[3, 4, 8, 4, 3, i]]], {i, Length[list[[3, 4, 8, 4, 3, i]]]}, list[[3, 4, 8, 4, 3, i]]],
{i, tdl8[[3, 2]]}
]


{ssfrt, styi}

 tdl10 = Table[
If[ListQ[list[[3, 4, 8, 4, 4, i]]], {i, Length[list[[3, 4, 8, 4, 4, i]]]}, list[[3, 4, 8, 4, 4, i]]],
{i, tdl8[[4, 2]]}
]


{sfc, sfb, smaa}

ClearAll[f0, tdl1, tdl2]
f0 = Replace[#, x_List :> Flatten[{Position[#, x], Length @ x}], 1] &;


You can use f0 with Extract:

tdl1 = Extract[#, Sort@Position[#, _List], f0] &;
tdl1 @ list // Column // TeXForm


$$\begin{array}{l} \{\text{ab},\text{ad},\{3,4\},\text{aw}\} \\ \{\text{be},\text{br},\text{pb},\{4,8\}\} \\ \{\text{cd},\text{cr},\text{ce},\{4,1\},\{5,4\},\text{ne},\{7,3\},\{8,4\}\} \\ \{\text{fo}\} \\ \{\text{gf},\text{gh},\text{gv},\text{gg}\} \\ \{\text{ks},\text{kd},\text{kl}\} \\ \{\text{sa},\text{sx},\text{sr},\{4,5\}\} \\ \{\text{sdr},\text{svd},\{3,2\},\{4,3\},\text{ja}\} \\ \{\text{ssfrt},\text{styi}\} \\ \{\text{sfc},\text{sfb},\text{smaa}\} \\ \end{array}$$

or withTable:

tdl2 = Table[f0[#[[## & @@ i]]], {i, Sort@Position[#, _List]}] &;
tdl1@list == tdl2@list


True

Not very pretty but shorter:

foo // ClearAll
foo[list_List] := Module[{res}
, Sow @ MapIndexed[ If[ListQ @ #, Append[#2, Length @ #], #] &, list]
; foo /@ list;
]

Column @ Reap[foo@list][[-1, 1]]

{ab,ad,{3,4},aw}
{be,br,pb,{4,8}}
{cd,cr,ce,{4,1},{5,4},ne,{7,3},{8,4}}
{fo}
{gf,gh,gv,gg}
{ks,kd,kl}
{sa,sx,sr,{4,5}}
{sdr,svd,{3,2},{4,3},ja}
{ssfrt,styi}
{sfc,sfb,smaa}


p.s. I don't like the fact that foo needs to map list twice but otherwise the order is wrong.

• It's just the kind of solution I was looking for, that makes me study deeply your foo, Thank you, Eskerrik asko Commented Sep 28, 2018 at 22:12