# How to select some sublist in a list of list?

Hopping to be clear, I ask this question after some hour of unsucceeded work I have this list

a={{{0., 0.5, 0.4}, {-0.5, 0., -0.1}, {-0.4, 0.1,
0.}}, {{0., -0.5, -0.1}, {0.5, 0., 0.4}, {0.1, -0.4, 0.}}, {{0.,
0., -0.6}, {0., 0., -0.6}, {0.6, 0.6, 0.}}}


associated with its sign matrix

b={{{0, 1, 1}, {-1, 0, -1}, {-1, 1, 0}}, {{0, -1, -1}, {1, 0,
1}, {1, -1, 0}}, {{0, 0, -1}, {0, 0, -1}, {1, 1, 0}}}


The first task is to replace all the sublists in b by the sum of their element to arrive to

{{2,-2,0},{-2,2,0},{-1,-1,2}}


Then in a I want to keep only the elements corresponding to 2 in fact the length of the row minus 1 that is as a final result

c={{{0., 0.5, 0.4}}, {{0.5, 0., 0.4}}, {{0.6, 0.6, 0.}}}


and to finish I want to delete the 0 in c.

I have tried with Select, but obviously all the pure function I have tried fails. Incidentely I wonder if there is a simple way, without transposing to find the sum of all the sublists of a list.

• I'd normally retag, but I think I'm more interested in hearing you explain why you think this is a calculus problem. Commented Jul 27, 2017 at 17:18
• Your perfectly true it's an algebra problem Commented Jul 27, 2017 at 19:05

Map[Total, b, {2}]
(* {{2, -2, 0}, {-2, 2, 0}, {-1, -1, 2}} *)

c = Extract[a, Position[Map[Total, b, {2}], 2]]
(* {{0., 0.5, 0.4}, {0.5, 0., 0.4}, {0.6, 0.6, 0.}} *)

DeleteCases[c, 0., {2}]
(* {{0.5, 0.4}, {0.5, 0.4}, {0.6, 0.6}} *)

Total[b, {3}]


{{2, -2, 0}, {-2, 2, 0}, {-1, -1, 2}}

Pick[a, Total[b, {3}], 2] == c


True

Pick[a, Total[b, {3}], 2] /. 0 | 0. -> Nothing


{{{0.5, 0.4}}, {{0.5, 0.4}}, {{0.6, 0.6}}}

• @bbgodfrey It looks like he missed the final deletion of zeros, but otherwise isn't it as requested? Commented Jul 28, 2017 at 15:28
• @Mr.Wizard I may have been hasty in my comment. Commented Jul 28, 2017 at 15:36
• Just for fun, a variation of the Pick method given by Coolwater & Mr Wizard: b // Total[#, {3}] & // Pick[a, #, 2] & // Pick[#, Unitize@#, 1] & Commented Jul 29, 2017 at 10:37

b = Sign[a];

Join @@@ Pick[a, Unitize[b]*Total[b, {3}], 2]

{{0.5, 0.4}, {0.5, 0.4}, {0.6, 0.6}}

Pick[#, Positive[Abs[#]]] &[Pick[a, Total[b, {3}], 2]]


{{{0.5, 0.4}}, {{0.5, 0.4}}, {{0.6, 0.6}}}

Borrowing the Unitize usage from the page:

Map[Select[AllTrue[NonNegative]], a] // Pick[#, Unitize[#], 1] &


{{{0.5, 0.4}}, {{0.5, 0.4}}, {{0.6, 0.6}}}

For some time, I tried variations around these ideas as well:

f = Pick[#, Map[Total@*Sign]@#, 2] &
f /@ a // Pick[#, Unitize@#, 1] &


or the equivalent:

Composition[Map[f], Pick[#, Unitize[#], 1] &][a]

a =
{{{0., 0.5, 0.4}, {-0.5, 0., -0.1}, {-0.4, 0.1, 0.}},
{{0., -0.5, -0.1}, {0.5, 0., 0.4}, {0.1, -0.4, 0.}},
{{0., 0., -0.6}, {0., 0., -0.6}, {0.6, 0.6, 0.}}};

b =
{{{0, 1, 1}, {-1, 0, -1}, {-1, 1, 0}},
{{0, -1, -1}, {1, 0, 1}, {1, -1, 0}},
{{0, 0, -1}, {0, 0, -1}, {1, 1, 0}}};


Using MapApply (new in 13.1)

p = Position[2][MapApply[Plus] /@ b]


{{1, 1}, {2, 2}, {3, 3}}

Select[# \[Element] PositiveReals &] /@ Extract[a, p]


{{0.5, 0.4}, {0.5, 0.4}, {0.6, 0.6}}