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. will be back soon 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}} *)
$\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}}
$\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}}}

$\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}}}

$\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.