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
  • 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 torpor
    Jul 27 '17 at 17:18
  • $\begingroup$ Your perfectly true it's an algebra problem $\endgroup$ 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$
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 '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.