1
$\begingroup$
n = 2
list = Permutations[Range[-n, n], {2}];
list = {{-2, -1}, {-2, 0}, {-2, 1}, {-2, 2}, {-1, -2}, {-1, 0}, {-1, 1}, {-1,
   2}, {0, -2}, {0, -1}, {0, 1}, {0, 2}, {1, -2}, {1, -1}, {1, 0}, {1,
   2}, {2, -2}, {2, -1}, {2, 0}, {2, 1}}

How can I delete the cases where Abs[a+b]>n and {a,b} are elements of the list? In the example above, I would like to delete {{-2, -1}, {-1, -2}, {1, 2}, {2, 1}} from the list.

$\endgroup$
1
  • $\begingroup$ I think you want to delete {{-2, -1}, {-1, -2}, {1, 2}, {2, 1}} $\endgroup$
    – ZaMoC
    Nov 17, 2018 at 1:10

4 Answers 4

2
$\begingroup$
Select[list, Abs@Total@# <= n &]     

{{-2, 0}, {-2, 1}, {-2, 2}, {-1, 0}, {-1, 1}, {-1, 2}, {0, -2}, {0, -1}, {0, 1}, {0, 2}, {1, -2}, {1, -1}, {1, 0}, {2, -2}, {2, -1}, {2, 0}}

$\endgroup$
1
$\begingroup$

Also PatternTest and Condition with Cases and DeleteCases:

Cases[list, _?(Abs@Total@# <= n &)]
DeleteCases[list, _?(Abs@Total@# > n &)]
Cases[list, x_ /; Abs@Total@x <= n]
DeleteCases[list, x_ /; Abs@Total@x > n]
$\endgroup$
0
$\begingroup$
If[Abs@Total@# <= n, #, Nothing] & /@ list
If[Abs[#1 + #2] <= n, {#1, #2}, Nothing] & @@@ list

{{-2, 0}, {-2, 1}, {-2, 2}, {-1, 0}, {-1, 1}, {-1, 2}, {0, -2}, {0, -1}, {0, 1}, {0, 2}, {1, -2}, {1, -1}, {1, 0}, {2, -2}, {2, -1}, {2, 0}}

$\endgroup$
0
$\begingroup$
Pick[#, UnitStep[n - Abs @ Total @ Transpose @ #], 1] & @ list

{{-2, 0}, {-2, 1}, {-2, 2}, {-1, 0}, {-1, 1}, {-1, 2}, {0, -2}, {0, -1}, {0, 1}, {0, 2}, {1, -2}, {1, -1}, {1, 0}, {2, -2}, {2, -1}, {2, 0}}

Timings for n = 100:

n = 100;
list = Permutations[Range[-n, n], {2}];
Length @ list

40200

functions =  {Pick[#, UnitStep[n - Abs@Total@Transpose@#], 1] &, 
    Select[#, Abs@Total@# <= n &] &, (* J42161217 *)
    Cases[#, _?(Abs@Total@# <= n &)] &, (* Mike Honeychurch *)
    DeleteCases[#, _?(Abs@Total@# > n &)] &,  (* Mike Honeychurch *)
    Cases[#, x_ /; Abs@Total@x <= n] &, (* Mike Honeychurch *)
    DeleteCases[#, x_ /; Abs@Total@x > n] &, (* Mike Honeychurch *)
    If[Abs@Total@# <= n, #, Nothing] & /@ # &, (* OkkesDulgerci *)
    If[Abs[#1 + #2] <= n, {#1, #2}, Nothing] & @@@ # & (* OkkesDulgerci *)};
results = ConstantArray[0, Length@functions];
timings = Table[First[RepeatedTiming[results[[i]] = functions[[i]]@list]],
  {i, Length@functions}];
Equal @@ results

True

Grid[Transpose[{Prepend[functions, "function"], 
   Prepend[ timings, "timing"]}], Dividers -> All]

enter image description here

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