How to apply Alternatives command to delete cases from a list?

Question

I have two lists let say

listF = {{7, 2}, {2, 6}, {8, 1}, {1, 7}, {11, 8}, {6, 11}};

and

newD = {{{2, 7}, {7, 9}, {9, 2}}, {{7, 2}, {2, 6}, {6, 7}}, {{7, 
 2}, {2, 6}, {6, 7}}, {{11, 6}, {6, 2}, {2, 11}}, {{8, 1}, {1, 
 7}, {7, 8}}, {{11, 1}, {1, 8}, {8, 11}}, {{1, 5}, {5, 7}, {7, 
 1}}, {{8, 1}, {1, 7}, {7, 8}}, {{11, 1}, {1, 8}, {8, 11}}, {{11, 
 8}, {8, 6}, {6, 11}}, {{11, 6}, {6, 2}, {2, 11}}, {{11, 8}, {8, 
 6}, {6, 11}}};

Question: How can I delete the parts listF from newD disregarding of the order of elements in the sub-list of listF. For example, I need to delete parts from newD that whether are in the form of {2,7} or {7,2}. I would prefer to Apply Alternative command but any solution would be appreciated.

Answer 1

You may use OrderlessPatternSequence and DeleteCases.

Build a set of Alternatives with OrderlessPatternSequence and Map DeleteCases over the sublists.

DeleteCases[Alternatives @@ ({OrderlessPatternSequence @@ #} & /@ listF)] /@ newD
(*
{
  {{7, 9}, {9, 2}},    {{6, 7}}, {{6, 7}}, 
  {{2, 11}},           {{7, 8}}, 
  {{11, 1}},           {{1, 5}, {5, 7}}, 
  {{7, 8}},            {{11, 1}}, 
  {{8, 6}},            {{2, 11}}, 
  {{8, 6}}
}
*)

Hope this helps.

Answer 2

foo[x_] := Sequence[x, Reverse@x];
DeleteCases[newD, Alternatives @@ (foo /@ listF), 2]

{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}},
{{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}

fun = ## & @@ (## &[{##}, {#2, #}] & @@@ #) &;
DeleteCases[newD, Alternatives@fun@listF, 2]

{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}},
{{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}

Update:

Is there any way that I can delete only one elements from each sub-list in newD

Yes... use the fourth argument of DeleteCases:

DeleteCases[#, Alternatives@fun@listF, 2, 1] & /@ newD

{{{7, 9}, {9, 2}}, {{2, 6}, {6, 7}}, {{2, 6}, {6, 7}}, {{6, 2}, {2, 11}},
{{1, 7}, {7, 8}}, {{11, 1}, {8, 11}}, {{1, 5}, {5, 7}}, {{1, 7}, {7, 8}},
{{11, 1}, {8, 11}}, {{8, 6}, {6, 11}}, {{6, 2}, {2, 11}}, {{8, 6}, {6, 11}}}

Answer 3

Table[Select[newD[[i]], 
  Complement[{#}, listF] != {} && Complement[{Reverse@#}, listF] != {} &]
, {i, Length[newD]}]

{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}}, {{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}

Remove only one element

Table[Select[newD[[i]],Complement[{#}, listF] == {} || 
  Complement[{Reverse@#}, listF] == {} &], {i, Length[newD]}];
del = %[[All, {1}]] (*choose the first repetition*)

Complement[newD[[#]], del[[#]]] & /@ Range[Length[newD]]

{{{7, 9}, {9, 2}}, {{2, 6}, {6, 7}}, {{2, 6}, {6, 7}}, {{2, 11}, {6, 2}}, {{1, 7}, {7, 8}}, {{8, 11}, {11, 1}}, {{1, 5}, {5, 7}}, {{1, 7}, {7, 8}}, {{8, 11}, {11, 1}}, {{6, 11}, {8, 6}}, {{2, 11}, {6, 2}}, {{6, 11}, {8, 6}}}

Answer 4

Since V 13.1 we have DeleteElements

del = Join[listF, Reverse /@ listF];

DeleteElements[#, del] & /@ newD

{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}}, {{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}

Answer 5

Using Delete and Position to delete cases from newD:

l1 = listF;
l2 = newD;

Delete[l2, Position[l2, Alternatives @@ Join[#, Reverse /@ #] &@l1]]

(*{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}}, {{1, 5}, {5, 7}}, 
{{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}*)

Answer 6

The following one-liner does the job.

Clear["Global`*"];
listF = {{7, 2}, {2, 6}, {8, 1}, {1, 7}, {11, 8}, {6, 11}};
newD = {{{2, 7}, {7, 9}, {9, 2}}, {{7, 2}, {2, 6}, {6, 7}}, {{7, 
     2}, {2, 6}, {6, 7}}, {{11, 6}, {6, 2}, {2, 11}}, {{8, 1}, {1, 
     7}, {7, 8}}, {{11, 1}, {1, 8}, {8, 11}}, {{1, 5}, {5, 7}, {7, 
     1}}, {{8, 1}, {1, 7}, {7, 8}}, {{11, 1}, {1, 8}, {8, 11}}, {{11, 
     8}, {8, 6}, {6, 11}}, {{11, 6}, {6, 2}, {2, 11}}, {{11, 8}, {8, 
     6}, {6, 11}}};
Pick[newD,
 Map[FreeQ[
    Sequence @@@ (Permutations[#, {Length@#}] & /@ listF)
    , #] &, newD, {-2}]
 ]

Results are at the end of the post.

The explanation is next.

---

Step 1

While comparing sublist entries in newD with listF, each point in listF is supposed to represent all its permutations of the same length as well. For instance:

{Permutations[{2, 7}, {2}], Permutations[{1, 5, 9}, {3}]} // Grid

To this end, let's define and augment the listF with the proper permutations:

listFnew = Sequence @@@ (Permutations[#, {Length@#}] & /@ listF)

{{7, 2}, {2, 7}, {2, 6}, {6, 2}, {8, 1}, {1, 8}, {1, 7}, {7, 1}, {11, 8}, {8, 11}, {6, 11}, {11, 6}}

---

Step2

A yet unknown function f can be directly applied to each entry in newD to determine if it (or one of its permutations) is part of/absent from the augmented list listFnew .

Map[f, newD, {-2}]

{{f[{2, 7}], f[{7, 9}], f[{9, 2}]}, {f[{7, 2}], f[{2, 6}], f[{6, 7}]}, {f[{7, 2}], f[{2, 6}], f[{6, 7}]}, {f[{11, 6}], f[{6, 2}], f[{2, 11}]}, {f[{8, 1}], f[{1, 7}], f[{7, 8}]}, {f[{11, 1}], f[{1, 8}], f[{8, 11}]}, {f[{1, 5}], f[{5, 7}], f[{7, 1}]}, {f[{8, 1}], f[{1, 7}], f[{7, 8}]}, {f[{11, 1}], f[{1, 8}], f[{8, 11}]}, {f[{11, 8}], f[{8, 6}], f[{6, 11}]}, {f[{11, 6}], f[{6, 2}], f[{2, 11}]}, {f[{11, 8}], f[{8, 6}], f[{6, 11}]}}

To this end a selector function assigns a True/False after checking absence of membership in the augmented list as required.

sel = Map[FreeQ[listFnew, #] &, newD, {-2}]

{{False, True, True}, {False, False, True}, {False, False, True}, {False, False, True}, {False, False, True}, {True, False, False}, {True, True, False}, {False, False, True}, {True, False, False}, {False, True, False}, {False, False, True}, {False, True, False}}

Step 3

Pick[newD, sel]

---

Result

{{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11,
1}}, {{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}}