Subsequences with distinct values

Question

(this question was modified after initial answers)

For a sequence

x = {6,4,2,4,2,4,6}

y = Subsequences[x]

gives the list of all subsequences, I would like to find the subset m of these subsequences which have distinct values, where each subsequence is composed of consecutive values in x. Or at most z repeat values.

subset m of subsequences of x with distinct values:

6
6,4
6,4,2
4
4,2
2
2,4
2,4,6
4,6

How can I remove the subsequences with duplicate values?

Is it possible to give the starting list position in x for each of the m?

Answer 1

This is an iterative approach:

(*input*)
x = {6, 4, 2, 4, 2, 4, 6};
z = 2;

$sizeOfSetX = Length[x];
$subsetM = {};

Do[
  maximumSubsequenceLength = $sizeOfSetX - startOfSubsequence + 1;

  Do[
    endOfSubsequence = startOfSubsequence + lengthOfSubsequence - 1;
    candidateSubsequence = x[[startOfSubsequence ;; endOfSubsequence]];

    (* check constraint of max repeated values*)
    If[ Count[candidateSubsequence, x[[endOfSubsequence]]] > z , Break[] ];

    (* check constraint of uniqueness*)
    If[ Not@MemberQ[$subsetM, candidateSubsequence] , AppendTo[$subsetM, candidateSubsequence] ]
    ,
    {lengthOfSubsequence, maximumSubsequenceLength}
  ]

  ,
  {startOfSubsequence, $sizeOfSetX}
];

$subsetM (*{{6}, {6, 4}, {6, 4, 2}, {6, 4, 2, 4}, {6, 4, 2, 4, 2}, {4}, {4, 
  2}, {4, 2, 4}, {4, 2, 4, 2}, {2}, {2, 4}, {2, 4, 2}, {2, 4, 2, 
  4}, {2, 4, 2, 4, 6}, {4, 2, 4, 6}, {2, 4, 6}, {4, 6}}*)

Answer 2

x = {6, 4, 2, 4, 2, 4, 6};
subs = Subsequences[Union[x]]

{{}, {2}, {4}, {6}, {2, 4}, {4, 6}, {2, 4, 6}}

You can remove the empty set by selecting the nonempty elements

Select[subs, # != {} &]

Answer 3

x = {6, 4, 2, 4, 2, 4, 6}

uniqueElemsQ is a helper function that returns True if all list elements are distinct.

uniqueElemsQ[k_List] := Not@(Union[(Last /@ Tally[k])] != {1})

The ReplaceList command generates all consecutive non-empty sublists.

Select[ReplaceList[x, {___, a__, ___} :> {a}], 
  uniqueElemsQ] // DeleteDuplicates

{{6}, {6, 4}, {6, 4, 2}, {4}, {4, 2}, {2}, {2, 4}, {2, 4, 6}, {4, 6}}

Answer 4

Subsequences[x]//Select[DuplicateFreeQ]//Union

Also, SequencePosition will give you the location of a subsequence.

Answer 5

Yet another solution:

subseqs[x_,z_]:=Flatten[Rest[FoldWhileList[Select[
  DeleteDuplicates[Subsequences[x,{#2}]],
    (Max[Values[Counts[#]]]<=z)&]&,0,Range[Length[x]],(#=!={})&]],1];

Example:

subseqs[{6,4,2,4,2,4,6},2]
(* {{6},{4},{2},
    {6,4},{4,2},{2,4},{4,6},
    {6,4,2},{4,2,4},{2,4,2},{2,4,6},
    {6,4,2,4},{4,2,4,2},{2,4,2,4},{4,2,4,6},
    {6,4,2,4,2},{2,4,2,4,6}} *)

Note. The goal was to be somewhat efficient in the case when x is a long list, but contains only a small number of distinct elements. This situation was mentioned by OP in a previous version of the question. An artificial example is:

SeedRandom[1];
x=RandomChoice[Range[6],1000000];

AbsoluteTiming[Length[subseqs[x,1]]]
{9.8393, 1956}

AbsoluteTiming[Length[subseqs[x,2]]]
{52.5905, 622610}

For comparison, the current version of the currently accepted answer takes 45 seconds in the first case on my machine, and $>360$ seconds in the second case.