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

Question

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

Answer 1

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.

Answer 2

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.

Answer 3

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

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

Answer 4

Not an answer,only a review.

the question is equivalence to $$1\leq a < b <c \leq 12,b-a\geq 2,c-b\geq 2$$ 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 <k \leq 9$$ or $$1=i,2\leq j<k\leq 9$$ or $$2\leq i<j\leq 9,k=10$$

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$)

Answer 5

Several additional alternatives:

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

Answer 6

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 *)

Answer 7

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

---

Using Pick:

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

returns the accepted result