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.

$\endgroup$
  • 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 technical difficulties Jul 27 '17 at 17:18
  • $\begingroup$ Your perfectly true it's an algebra problem $\endgroup$ – cyrille.piatecki Jul 27 '17 at 19:05
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$
  • $\begingroup$ @bbgodfrey It looks like he missed the final deletion of zeros, but otherwise isn't it as requested? $\endgroup$ – Mr.Wizard Jul 28 '17 at 15:28
  • $\begingroup$ @Mr.Wizard I may have been hasty in my comment. $\endgroup$ – bbgodfrey Jul 28 '17 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 '17 at 10:37
1
$\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$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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