6
$\begingroup$ 
list = {{1,0,x-y},{1,0,0},{0,2x,x-y}, {x-y,x,1}, {0,2x,1}, {-1,-y+x,0}, {1,y,0}, {y-x,2y,0}, {0,x+y,-x}, {1,y-2x,0},{-1,2(x+y),-1},{0,3x,0},{3x,2y,0},{0,-x-y,-1},{-x+3y,0,0},{2x-3y,0,1}, {3x,-x,1}}

From the list I would like to drop all the tuples which contain any ax+by where $a\geq0$, $b\geq0$, and $a$ and $b$ are not both zero at the same time.

For example, we can drop {x-y,x,1},{y-x,2y,0},{0,x+y,-x}, because these contain respectively x, 2y, x+y. But we cannot drop {1,0,x-y},{-1,-y+x,0},{2x-3y,0,1},{0,-x-y,-1},{-x+3y,0,0}}, because these do not contain any ax+by in the stated form.

After dropping, the list should have elements:

reducedlist={{1,0,x-y},{1,0,0},{-1,-y+x, 0},{1,y-2x,0},{0,-x-y,-1},{-x+3y,0,0},{2x-3y,0,1}}
Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ I do not really understand the criterion you want to impose, or more precisely the example you give. You wrote that we can delete {x-y,x,1} but NOT {1,0,x-y}, yet both elements contain the same x-y for which a=1 and b=-1 in your notation. Have I misunderstood something? Could you elaborate a bit? $\endgroup$
    – user49048
    Commented May 29, 2021 at 18:05
  • 1
    $\begingroup$ Somewhat related: mathematica.stackexchange.com/questions/186157/… and mathematica.stackexchange.com/questions/208861/… $\endgroup$
    – user49048
    Commented May 29, 2021 at 18:07
  • 1
    $\begingroup$ Thanks for question @– DiSp0sablE_H3r0 "The criterion is to drop any tuples which contain ANY ax+by in the form as stated. In the examples {x-y,x-1} and {1,0,x-y}, the second tuple does not contain any such ax+by (the element x-y is not in this form because b<0), but the first tuple does (the element x has a=1,b=0)." $\endgroup$
    – gunes
    Commented May 29, 2021 at 18:16
  • 1
    $\begingroup$ Ok, I see. Thanks for the clarification $\endgroup$
    – user49048
    Commented May 29, 2021 at 18:19

2 Answers 2

Reset to default
5
$\begingroup$ 
coeffsNotBothZero = Not @* FreeQ[x | y]; 

coeffsNotBothNonNegative = FreeQ[{__?NonNegative}]@
   Outer[Coefficient, Select[coeffsNotBothZero] @ #, {x, y}] &;

Select[coeffsNotBothNonNegative] @ list

{{1, 0, x - y}, {1, 0, 0}, {-1, x - y, 0}, {1, -2 x + y, 0}, 
 {0, -x - y, -1}, {-x + 3 y, 0, 0}, {2 x - 3 y, 0, 1}}

You can also do:

coeffsNotBothNonNegative2 = FreeQ[_?Positive][
    Select[coeffsNotBothZero][#] /. {i_Integer :> Sign[i], x | y -> 1}] &;

Select[coeffsNotBothNonNegative2] @ list == Select[coeffsNotBothNonNegative] @ list

True

Improve this answer
$\endgroup$
2
  • $\begingroup$ many thanks for the above code. How can we adapt your code using for loop?. I think we will start like that ,but dont know the rest pointed with ??? a=Length[list] ReducedList = ConstantArray[0., a]; For[i = 1, i <= a, i++, ?? $\endgroup$
    – gunes
    Commented Jun 4, 2021 at 5:08
  • 1
    $\begingroup$ @gunes, if you really have to use a For loop, you can try: reducedList = {}; For[i = 1, i < Length[list], i++, If[coeffsNotBothNonNegative@list[[i]], AppendTo[reducedList, list[[i]]]]]; reducedList $\endgroup$
    – kglr
    Commented Jun 4, 2021 at 5:59
5
$\begingroup$

We may use "DeleteCases" and a pattern like:

list = {{1, 0, x - y}, {1, 0, 0}, {0, 2 x, x - y}, {x - y, x, 1}, {0, 
    2 x, 1}, {-1, -y + x, 0}, {1, y, 0}, {y - x, 2 y, 0}, {0, 
    x + y, -x}, {1, y - 2 x, 0}, {-1, 2 (x + y), -1}, {0, 3 x, 
    0}, {3 x, 2 y, 0}, {0, -x - y, -1}, {-x + 3 y, 0, 0}, {2 x - 3 y, 
    0, 1}, {3 x, -x, 1}};

pattern = ({___, (a_ : 1)  x + (b_ : 1)  y, ___} /; 
     a > 0 && b > 0) | ({___, (a_ : 1) x, ___} /; 
     a > 0 ) | ({___, (b_ : 1) y, ___} /; b > 0);
DeleteCases[list // Expand, pattern]

This gives:

{{1, 0, x - y}, {1, 0, 0}, {-1, x - y, 0}, {1, -2 x + y, 
  0}, {0, -x - y, -1}, {-x + 3 y, 0, 0}, {2 x - 3 y, 0, 1}}
Improve this answer
$\endgroup$

Your Answer

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

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