# How to delete lists that contain sublists of different sizes?

I hope to have your help, if I have

listp = Permutations[Range[7]];


With the following functions, I delete the lists that contain {7,2} and {2,7} of the variable listp

filtro[num_List]:=If[Position[num,7]==Position[num,2]+1,False,True];
sfir[num_List]:=If[Position[num,7]==Position[num,2]-1,False,True];


For example in listp is the permutation {1,4,2,7,6,3,5}, which should be deleted from listp, since it contains {2,7}, also permutation {5,1,6,4 , 3,2,7} should be deleted from listp for the same reason. To make all permutations like those mentioned above be removed from listp I do the following:

ek = Select[listp, filtro];
{Length[listp], Length[ek]}


As you can see 720 permutations of listp have been eliminated, I have only used {2,7} as a criterion, now if I use {7,2} let's see how many permutations are eliminated

do = Select[ek, sfir];
{Length[listp], Length[ek], Length[do]}


You will have already noticed that 720 permutations were erased, in total 1440 permutations of listp have been eliminated.

What I did in the previous section was simply delete all the permutations of {2,7} which are

Permutations[{2,7}]


The problem is that for each permutation I had to build a function, besides I want to erase other permutations, which I enlist so that you know what they are.

Permutations[{1,3,5}];
Permutations[{2,4,6,7}];


If I have counted correctly, I would have to do 30 functions to erase all the permutations that I want from listp. I would like to ask you to please help me carry out this listp debugging, since I thought about using the DeleteCases command but I did not know how to assign the permutations that I want to delete within that command, maybe you know an alternative method to achieve my goal. Any help is welcome since I am stuck in this part. Thanks in advance.

I think OrderlessPatternSequence is the missing piece. For example,

DeleteCases[listp, {___, OrderlessPatternSequence[2, 7], ___}]


will delete any list inside listp that contains the sequence 2,7 or 7,2.

If there are other sequences to be deleted you could make a composite pattern with

patt = Alternatives[
OrderlessPatternSequence[2, 7],
OrderlessPatternSequence[1, 3, 5],
OrderlessPatternSequence[2, 4, 6, 7]
];


and

DeleteCases[listp, {___, patt, ___}]


will delete any list containing these orderless patterns.

If you are using a version prior to 10.1 then OrderlessPatternSequence is not defined, and you can implement it yourself as

OrderlessPatternSequence[args___] :=
Alternatives @@ PatternSequence @@@ Permutations@{args}

• First of all an apology for thanking you so far, the solution that you shared with me works wonderfully, I have tried it online and I get what I was looking for, thanks for your help. I do not know if you have any solution that works in MMA version 10.0, since in that version there is no command OrderlessPatternSequence, that would be extra because I have that version on desktop, thank you again Commented Jul 4, 2018 at 0:53
• No need to apologize at all. See the edit for an alternative definition. Commented Jul 4, 2018 at 1:58
list = Permutations[Range[4]];


Grabbing the @eldo's list and using SequencePosition:

Pick[list, Length@SequencePosition[#, {2, 4} | {4, 2}] === 0 & /@ list]

(*{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3},
{2, 3, 1,4}, {2, 3, 4, 1} {3, 2, 1, 4}, {3, 4, 1, 2},
{4, 1, 2, 3}, {4, 1, 3, 2}, {4, 3, 1, 2}, {4, 3, 2, 1}}*)


Sequence functions are much slower than Jason's answer (0.322 vs 0.014 sec for n = 7, but might be useful for short lists in some cases.

n = 4;

list = Permutations[Range @ n];


Using SequenceSplit (new in 11.3)

Cases[#, {Repeated[_, {n}]}, -1]& @
Map[SequenceSplit[#, {2, 4} | {4, 2}] &] @ list


{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {4, 1, 2, 3}, {4, 1, 3, 2}, {4, 3, 1, 2}, {4, 3, 2, 1}}

Using SequenceCases (new in 10.1)

Extract[list, Position[SequenceCases[#, {2, 4} | {4, 2}] & /@ list, {}]]


(* same result *)

Also:

n = 4; list = Permutations[Range @ n];
seq = {2, 4};


Using LongestCommonSubsequence

Cases[x_ /; (LongestCommonSubsequence[x, #] != # & /@ And @@ Permutations@seq)]@list


{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {4, 1, 2, 3}, {4, 1, 3, 2}, {4, 3, 1, 2}, {4, 3, 2, 1}}

In terms of performance, for the problem at hand, generating the permutations to be excluded and removing them from the whole list afterwards, seems to run even faster.

subsetPermutations[n_][seq_List] :=
Flatten /@ Permutations[{seq, Splice@Complement[Range@n, seq]}]

Complement[Permutations[Range@n], Flatten[subsetPermutations[n] /@ Permutations[seq], 1]]


{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {4, 1, 2, 3}, {4, 1, 3, 2}, {4, 3, 1, 2}, {4, 3, 2, 1}}

n = 4;

list = Permutations[Range @ n];


Using Splice (new in 12.1) to get the positions

p = Catenate @ Map[Position[list, {___, Splice[#], ___}] &, {{2, 4}, {4, 2}}]


{{2}, {3}, {11}, {12}, {13}, {16}, {4}, {5}, {14}, {18}, {21}, {22}}

Using Delete

Delete[p] @ list


{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {4, 1, 2, 3}, {4, 1, 3, 2}, {4, 3, 1, 2}, {4, 3, 2, 1}}

Using ReplaceAt (new in 13.1)

ReplaceAt[_ :> Nothing, p] @ list


output like above