Come rimuovere le sottoliste la cui differenza di due elementi è 1 o 11?

Question

Voglio creare un elenco di sottoinsiemi di 3 elementi di $\{1,2,\cdots,12\}$ dove due elementi in ogni sottoinsieme non possono avere differenze di 1 o 11. Sto cercando di risolvere quanto segue:

Trova il numero di tutti i triangoli possibili che possono essere creati scegliendo 3 punti di un poligono a 12 lati, ma nessun lato dei triangoli è anche il lato del poligono.

Il seguente tentativo fallisce perché restituisce solo un elenco di tutti i sottoinsiemi senza restrizioni.

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) &]

modificare

Ho appena ottenuto la soluzione come segue, ma può essere semplificata?

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]

Per il tuo problema nei commenti, il numero di triangoli in un poligono regolare che non condividono lati con quel poligono è $n (n - 4) (n - 5)/6$ fornito $n\ge6$. Sarebbe molto più efficiente utilizzare questo risultato direttamente che elencarli e contarli.

Answer 2

Puoi usare SubsetCount. Questa è una funzione sperimentale nella versione 12.1.1 quindi il comportamento potrebbe cambiare.

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

Spero che sia di aiuto.

Answer 3

Non una risposta, solo una recensione.

la domanda è l'equivalenza a $$1\leq a < b <c \leq 12,b-a\geq 2,c-b\geq 2$$ e quando $a=1$, $c\not=12$ o quando $c=12$,$a\not=1$

Se stiamo mappando $\{a,b,c\}$ per $\{a,b-1,c-2\}=\{i,j,k\}$

la domanda è l'equivalenza a $$2\leq i < j <k \leq 9$$ o $$1=i,2\leq j<k\leq 9$$ o $$2\leq i<j\leq 9,k=10$$

quindi il numero di sottoinsiemi è ${8\choose 3}+2{8 \choose 2}=112$

Allo stesso modo il risultato generale è ${n-4\choose 3}+2{n-4\choose 2}$ dove il $n$ è la lunghezza dei sottoinsiemi $\{1,2,\cdots,n\}$ ( Qui $n=12$)

Answer 4

Questo dovrebbe essere un po 'più veloce della tua soluzione originale:

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

Answer 5

Diverse alternative aggiuntive:

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 

Confronto con i metodi delle risposte di flinty ( res3), JM ( res4) e 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