Find the longest constant sublist

Question

Given a list

list = {1,2,2,2,2,5,1,3,2,6,6,6,6,6,6,6,6,6,6,6,10,-3};

how to find the longest constant sublist (or equivalently the element and the number of times it is repeated)?

(in this example, {6,6,6,6,6,6,6,6,6,6,6} or {6,11})

Answer 1

Concisely and reasonably efficiently:

Last @ Sort @ Split @ list

{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}

More efficiently:

# ~Extract~ Ordering[#, -1] & @ Split @ list

{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}

Multiple longest runs:

longestRuns[x_List] :=
  With[{sp = Split[x]},
    sp ~Extract~ Position[#, Max@#] &[Length /@ sp] & @ x
  ]

{1, 2, 2, 3, 4, 4, 5, 6} // longestRuns

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

Less efficiently but having fun with patterns:

list /. {___, seq : Longest[x_ ..], ___} :> {seq}

{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}

Answer 2

I post this somewhat ridiculous answer for 'fun', acknowledging all the given answers directly answer the question, esp Mr. Wizard. I post just ways of 'visualizing' longest run:

list = {1, 2, 2, 2, 2, 5, 1, 3, 2, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 
   10, -3};
With[{w = Union@list},
 ArrayPlot[Map[Function[x, Unitize[# - x] & /@ list], w], 
  FrameTicks -> {{Thread[{Range[Length@w], w}], 
     None}, {Range[Length@list], None}}]]

Of course you could ArrayPlot with your own color scheme.

Increasing the overkill:

ind = Range[Length@list];
gg = With[{pt = Partition[ind, 2, 1]}, 
   UndirectedEdge @@@ Pick[pt, Length@Union[list[[#]]] == 1 & /@ pt]];
gp = Graph[ind, gg, 
  VertexLabels -> 
   Thread[ind -> (Placed[
         Framed[#, Background -> Yellow, RoundingRadius -> 4], 
         Center] & /@ list)], 
  GraphLayout -> "HighDimensionalEmbedding", VertexSize -> 0, 
  PlotRangePadding -> {1, 2}, EdgeStyle -> Directive[Thick, Red]]

Note:

comp = ConnectedComponents[gp] /. Thread[ind -> list]

yields:

{{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}, {2, 2, 2, 
  2}, {5}, {3}, {1}, {10}, {1}, {2}, {-3}}

or increasing the overkill using CommunityGraphPlot:

CommunityGraphPlot[
 Graph[ind, gg, 
  VertexLabels -> 
   Thread[ind -> (Placed[
         Style[#, White, Bold, FontFamily -> "Kartika", 12], 
         Center] & /@ list)], VertexSize -> 1.5, 
  EdgeStyle -> Directive[Thick, Red]], ConnectedComponents[gp], 
 Method -> "Hierarchical", CommunityRegionStyle -> Green]

or showing the 'chain':

CommunityGraphPlot[
 Graph[UndirectedEdge @@@ Partition[ind, 2, 1], 
  VertexLabels -> 
   Thread[ind -> (Placed[
         Style[#, White, Bold, FontFamily -> "Kartika", 10], 
         Center] & /@ list)], VertexSize -> 1, EdgeStyle -> Thick], 
 ConnectedComponents[gp], CommunityRegionStyle -> Green, 
 ImageSize -> 800]

Answer 3

In Version 10 you can use the new function MaximalBy:

Split@list~MaximalBy~Length

{{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}}

You can also use it in the operator form:

MaximalBy[Length]@Split@list 

Answer 4

Faster, properly returns multiple sublists if there are more than one sequence with maximal length:

Module[{l = #, 
        sa = Append[SparseArray[Differences@#]["AdjacencyLists"], Length@#],
        sap, p},

   sap = Prepend[Most@sa + 1, 1];
   p = Pick[Transpose[{sap, sa}], sa - sap, Max[sa - sap]];
   l[[Span @@ #]] & /@ p] &[targetListHere]

Answer 5

Another way, maybe not so efficient:

With[{list = {1, 2, 3, 2, 3, 3, 3, 3}}, 
LongestCommonSubsequence[list, 
ConstantArray[#, Length@list]] & /@ (DeleteDuplicates@list)]