# How to remove sublists whose difference of two elements is either 1 or 11?

I want to create a list of 3-element subsets of $$\{1,2,\cdots,12\}$$ where no two elements in each subset can have difference of 1 or 11. I am trying to solve the following:

Find the number of all possible triangles that can be created by choosing 3 points of a 12-sided polygon, but no sides of the triangles are also the sides of the polygon.

The following attempt fails because it returns just a list of all subsets without restriction.

Select[Subsets[Range[12], {3}]
, (Abs[#[[1]] - #[[2]]] != 1 || Abs[#[[1]] - #[[2]]] != 11) &&
(Abs[#[[1]] - #[[3]]] != 1 || Abs[#[[1]] - #[[3]]] != 11) &&
(Abs[#[[3]] - #[[2]]] != 1 || Abs[#[[3]] - #[[2]]] != 11) &]


# Edit

I just got the solution as follows, but can it be simplified?

Select[Subsets[Range[12], {3}]
, ! MemberQ[{1, 11}, Abs[#[[1]] - #[[2]]]] &&
! MemberQ[{1, 11}, Abs[#[[1]] - #[[3]]]] &&
! MemberQ[{1, 11}, Abs[#[[3]] - #[[2]]]] &] // Length


test[sublist_] := ContainsNone[Abs[Subtract @@@ Subsets[sublist,{2}]], {1,11}]

Select[Subsets[Range[12], {3}], test]


For your problem in the comments, the number of triangles in a regular polygon which do not share any sides with that polygon is $$n (n - 4) (n - 5)/6$$ provided $$n\ge6$$. It would be much more efficient to use this result directly than to list them and count them.

• If you want an anonymous function in select this is Select[Subsets[Range[12], {3}], ContainsNone[Abs[Subtract @@@ Subsets[#, {2}]], {1, 11}] &] Commented Aug 22, 2020 at 15:22
• Thank you. A nice idea! I am waiting for a couple of hours to accept. Commented Aug 22, 2020 at 15:23

You may use SubsetCount. This is an experimental function in version 12.1.1 so behaviour may change.

Select[
SubsetCount[#, {j_, k_} /; Or @@ Thread[j - k == {1, 11}]] == 0 &
]@Subsets[Range[12], {3}]


Hope this helps.

• Thank you very much! A nice info. Commented Aug 22, 2020 at 18:12

This should be quite a bit faster than your original solution:

Select[Subsets[Range[12], {3}], ! MemberQ[Abs[ListCorrelate[{-1, 1}, #, 1]], 1 | 11] &]

• Thank you very much! Commented Aug 23, 2020 at 10:16

the question is equivalence to $$1\leq a < b and when $$a=1$$, $$c\not=12$$ or when $$c=12$$,$$a\not=1$$

If we mapping $$\{a,b,c\}$$ to $$\{a,b-1,c-2\}=\{i,j,k\}$$

the question is equivalence to $$2\leq i < j or $$1=i,2\leq j or $$2\leq i

so the number of subsets is $${8\choose 3}+2{8 \choose 2}=112$$

Similarly the general result is $${n-4\choose 3}+2{n-4\choose 2}$$ where the $$n$$ is the length of subsets $$\{1,2,\cdots,n\}$$ ( here $$n=12$$)

• Where did $n$ come from? Commented Aug 24, 2020 at 5:42
• Thank you very much. Very good! Commented Aug 24, 2020 at 8:08

res0 = DeleteCases[{1, _, 12} | ({a_, b_, _} /; b == a + 1) |
({_, a_, b_} /; b == a + 1)] @ Subsets[Range[12], {3}]; // RepeatedTiming // First

 0.00042

res1 = Select[DeleteCases[{1, _, 12}] @ Subsets[Range[12], {3}], FreeQ[1] @* Differences];
// RepeatedTiming // First

 0.00047

res2 = Select[Union @ Join[Subsets[Range[2, 12], {3}], Subsets[Range[11], {3}]],
FreeQ[1] @* Differences]; // RepeatedTiming // First

0.00051


Comparison with methods from flinty's (res3), J.M.'s (res4) and Edmund's (res5) answers:

res3 = Select[Subsets[Range[12], {3}], test]; // RepeatedTiming // First

 0.0034

res4 = Select[Subsets[Range[12], {3}],
!MemberQ[Abs[ListCorrelate[{-1, 1}, #, 1]], 1 | 11] &]; // RepeatedTiming // First

 0.0016

res5 = Select[SubsetCount[#, {j_, k_} /; Or @@ Thread[j - k == {1, 11}]] ==  0 &]@
Subsets[Range[12], {3}]; // RepeatedTiming // First

 0.260

res0 == res1 == res2 == res3 == res4 == res5

 True

• Thank you very much! Commented Aug 24, 2020 at 8:07
list = Subsets[Range[12], {3}];


Using Delete and Partition

Delete[
list,
List @* First /@
Position[
MapApply[Abs @* Subtract] @ Partition[#, 2, 1, 1] & /@ list,
1 | 11]]


(* returns the accepted result *)

list = Subsets[Range[12], {3}];


Using Pick:

Pick[#, FreeQ[Abs@*Subtract @@@ Partition[#, 2, 1, 1], 1 | 11] & /@ #] &@list


returns the accepted result