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$
  • $\begingroup$ I think you want to delete {{-2, -1}, {-1, -2}, {1, 2}, {2, 1}} $\endgroup$ – J42161217 Nov 17 '18 at 1:10
1
$\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, privacy policy and cookie policy

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