2つの要素の差が1または11のサブリストを削除するにはどうすればよいですか？
の3要素サブセットのリストを作成したい $\{1,2,\cdots,12\}$ ここで、各サブセットの2つの要素の差が1または11になることはありません。次のことを解決しようとしています。
12辺のポリゴンの3点を選択して作成できるすべての可能な三角形の数を見つけますが、三角形の辺がポリゴンの辺でもないことを確認します。
次の試行は、制限なしですべてのサブセットのリストのみを返すため失敗します。
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) &]
編集
私は次のように解決策を得ましたが、それを単純化することはできますか？
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]
コメントの問題については、正多角形の中で、その多角形と辺を共有しない三角形の数は次のとおりです。 $n (n - 4) (n - 5)/6$ 提供 $n\ge6$。この結果をリストしてカウントするよりも、この結果を直接使用する方がはるかに効率的です。
を使用できますSubsetCount。これはバージョン12.1.1の実験的な機能であるため、動作が変わる可能性があります。
Select[
SubsetCount[#, {j_, k_} /; Or @@ Thread[j - k == {1, 11}]] == 0 &
]@Subsets[Range[12], {3}]
お役に立てれば。
答えではなく、レビューだけです。
問題はと同等です $$1\leq a < b <c \leq 12,b-a\geq 2,c-b\geq 2$$ そしていつ $a=1$、 $c\not=12$ またはいつ $c=12$、$a\not=1$
マッピングする場合 $\{a,b,c\}$ に $\{a,b-1,c-2\}=\{i,j,k\}$
問題はと同等です $$2\leq i < j <k \leq 9$$ または $$1=i,2\leq j<k\leq 9$$ または $$2\leq i<j\leq 9,k=10$$
したがって、サブセットの数は ${8\choose 3}+2{8 \choose 2}=112$
同様に、一般的な結果は次のとおりです。 ${n-4\choose 3}+2{n-4\choose 2}$ どこ $n$ サブセットの長さです $\{1,2,\cdots,n\}$ （ ここに $n=12$）
これは、元のソリューションよりもかなり高速になるはずです。
Select[Subsets[Range[12], {3}], ! MemberQ[Abs[ListCorrelate[{-1, 1}, #, 1]], 1 | 11] &]
いくつかの追加の選択肢：
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
flinty（res3）、JM（res4）、Edmund（res5）の回答のメソッドとの比較：
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