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

flinty · Accepted Answer

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 $nge6$. It would be much more efficient to use this result directly than to list them and count them.

Edmund · Answer

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.

J. M.'s discontentment · Answer

This should be quite a bit faster than your original solution:
Select[Subsets[Range[12], {3}], ! MemberQ[Abs[ListCorrelate[{-1, 1}, #, 1]], 1 | 11] &]

cvgmt · Answer

Not an answer,only a review.
the question is equivalence to
$$1leq a < b <c leq 12,b-ageq 2,c-bgeq 2$$
and  when $a=1$, $cnot=12$ or when $c=12$,$anot=1$
If we mapping ${a,b,c}$ to ${a,b-1,c-2}={i,j,k}$
the question is equivalence to
$$2leq i < j <k leq 9$$
or
$$1=i,2leq j<kleq 9$$
or
$$2leq i<jleq 9,k=10$$
so the number of subsets  is ${8choose 3}+2{8 choose 2}=112$
Similarly the general result is ${n-4choose 3}+2{n-4choose 2}$ where the $n$ is the length of subsets ${1,2,cdots,n}$ ( here $n=12$)

kglr · Answer

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

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

Edit

5 Answers

Add your own answers!

Ask a Question