2
$\begingroup$

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.

Improve this question
$\endgroup$
2
  • 2
    $\begingroup$ I'd normally retag, but I think I'm more interested in hearing you explain why you think this is a calculus problem. $\endgroup$
    – J. M.'s eventual burnout ♦
    Jul 27, 2017 at 17:18
  • $\begingroup$ Your perfectly true it's an algebra problem $\endgroup$
    – cyrille.piatecki
    Jul 27, 2017 at 19:05

5 Answers 5

Reset to default
3
$\begingroup$ 
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}} *)
Improve this answer
$\endgroup$
3
$\begingroup$

A variation of existing answers:

b = Sign[a];

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

{{0.5, 0.4}, {0.5, 0.4}, {0.6, 0.6}}
Improve this answer
$\endgroup$
2
$\begingroup$ 
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}}}

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

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

Improve this answer
$\endgroup$
0
$\begingroup$

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]
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.