Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

How do I extract the middle element(s) of a given list?

Here is some code that works, but seems a little too long:

extract[x_] := 
      Part[x, If[IntegerQ[#], {#}, {Floor[#], Ceiling[#]}] & @ Median[Range[Length @ x]]]

Here is another, shorter routine, but for a list of even length, it only gives one value, not two. I think two values would be better for even lists:

extract[x_] := Part[x, Quantile[Range[Length @ x], 1/2]]

So is there concise, efficient code that will return two elements for a list of even length?

share|improve this question
    
haha, so many good answers, come on, guys. Feel free to add your interesting answers. –  HyperGroups Jun 8 '13 at 12:31
add comment

15 Answers 15

up vote 15 down vote accepted

Update #2, after reading the other answers:

mid[a_List] := a[[# ;; -#]] & @ ⌈Length@a/2⌉

mid /@ {{a, b, c}, {a, b, c, d}}
{{b}, {b, c}}

Update: better:

mid[a_List] := Take[a, Quotient[{1.5, 2.5} + Length@a, 2]]

I came up with this:

mid[a_List] := Take[a, Round[{-.1,.1} + (1 + Length@a)/2]]
share|improve this answer
3  
I think your Update #2 answer is hard to top! –  Aky Jun 8 '13 at 11:59
    
@Aky Thanks! We'll see. –  Mr.Wizard Jun 8 '13 at 12:02
1  
Your codes always impressed me. –  HyperGroups Jun 9 '13 at 4:59
    
@HyperGroups Thank you. –  Mr.Wizard Jun 9 '13 at 9:46
    
@Rojo Maybe later. :^) –  Mr.Wizard Jun 10 '13 at 0:01
add comment

Hm, no recursion solution yet? Strange... Here we go then:

extract[x_] := x; extract[{_, x__, _}] := extract[{x}]
extract /@ {{a}, {a, b}, {a, b, c}, {a, b, c, d}}
(*{{a}, {a, b}, {b}, {b, c}}*)
share|improve this answer
4  
I like it! Could also be written: {a, b, c, d} //. {_, x__, _} :> {x} As nice as this is it won't be efficient on long lists due to Mathematica lists being implemented as arrays. –  Mr.Wizard Jun 8 '13 at 13:18
    
Combined with my solution: middle[l_List] := If[Length[l] <= 2, l, middle[ArrayPad[l, -1]]] –  J. M. Jun 8 '13 at 13:19
1  
@Mr.Wizard I already anticipate the answer with time comparisons of all solutions to be made ;) –  swish Jun 8 '13 at 13:28
add comment
middle[li_List] := Part[li, Union@Through[{Floor, Ceiling}[(Length@li + 1)/2]]]

I wouldn't do it this way, but just for fun:

mid[li_List] := With[{len = Length@li}, li[[Nearest[Range[len], (len + 1)/2]]]]
share|improve this answer
1  
I like the Through and Nearest here. :) –  HyperGroups Jun 9 '13 at 5:01
add comment

This is the way I would do it. Not concise, but reasonably efficient and easy to understand.

middle[x_List] := Module[{s, t},
  t = Quotient[s = Length @ x, 2];
  If[EvenQ @ s, x[[t ;; t + 1]], {x[[t + 1]]}]]
share|improve this answer
add comment

It's a bit shorter (55 characters):

ext[x_] := Take[x, {f = Ceiling[Length@x/2], f + Boole@EvenQ@Length@x}]

It does give the desired two-numbers for even-length lists. If you are willing to live with only one value for even-length lists then

ext2[x_] := Take[x, {Ceiling[Length@x/2]}]

is even shorter.

share|improve this answer
add comment

A not-so-short, not-so-fast version with pattern matching.

extract[x_] := Module[{n = Repeated[_, {Ceiling[Length@x/2] - 1}]},
   x /. {n, m__, n} :> {m}
   ];

extract@Range@10    (* ==> {5, 6} *)
extract@Range@11    (* ==> {6} *)
share|improve this answer
add comment

You post my question that I ask you. ^_^

My code:

midextract[ls_List] := 
  Module[{L = Length[ls], d, r}, 
    d = Floor[L/2]; 
    r := Extract[ls, 1 + d] /; OddQ[L];
    r := Extract[ls, List /@ {d, 1 + d}] /; EvenQ[L];
    r]
share|improve this answer
add comment

Not-so-short:

middle[x_List] := NestWhile[ArrayPad[#, -1] &, x, Length[#] > 2 &]

Test:

middle[Array[C, 7]]
   {C[4]}

middle[Array[C, 8]]
   {C[4], C[5]}
share|improve this answer
add comment

Here's a short alternative (44 characters):

f = Union@{#[[p = Ceiling[Length@#/2]]], #[[-p]]} & ;

Now apply your function

f@yourinputlist

So for these sample input lists:

evenlist = CharacterRange["a", "z"]
oddlist = CharacterRange["a", "y"]
(* {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"} *)
(* {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y"} *)

you get the following results:

r@evenlist
r@oddlist
(* {m, n} *)
(* {m} *)
share|improve this answer
3  
If the two middle elements of an even-lengthed list happen to be the same, then your revised method only shows that element once. –  Aky Jun 8 '13 at 11:17
    
A valid criticism by Aky, but +1 for inspiration. –  Mr.Wizard Jun 8 '13 at 11:57
add comment

I'm late to the party and all the easy/good/low-hanging fruits are taken. Nevertheless, there's still a possibility to sneak something in, so here's one using DiscreteDelta:

mid[l_List] := With[{len = Length@l}, 
    Pick[l, Table[DiscreteDelta[Round[n - (len + 1)/2]], {n, len}], 1]]

mid /@ {{a, b, c}, {a, b, c, d}}
(* {{b}, {b, c}} *)
share|improve this answer
add comment

I want to propose another solution.

First my solution for an odd-length integer sequence.

If we look, for instance, at the results for Range[n] with $0 \le n \le 17$ where $n$ is odd we get:

0 -> 0, 1 -> 1, 3 -> 2, 5 -> 3, 7 -> 4, 9 -> 5, 11 -> 6, 13 -> 7, 15 -> 8, 17 -> 9

so the resulting sequence looks like this:

0, 1, 1, 3, 2, 5, 3, 7, 4, 9, 5, 11, 6, 13, 7, 15, 8, 17, 9

This integer sequence is Sloane's A026741 and for n > 1 it is generated with:

a(n) = gcd(tr(n), tr(n-1))

where tr is the triangular number. Turning this into Mma:

ClearAll[extract]
T[n_] := n (n + 1)/2
extract[1] := 1
extract[x_] := Print["no clever solution for this so far..."]
extract[x_ /; OddQ[x]] := GCD[T[x + 1], T[x]]

extract[#] & /@ Range[1, 19, 2]

=> {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

for the even-length list I'd write something like:

extract2[{x_}] := With[{n = Length[x]},
    elems = n/2 - 1;
    x[[1 + elems ;; n - elems]]
]

sorry i do this from my chromebook and i have nothing to test here if this is correct...

share|improve this answer
add comment

Here is another approach, which won't win a speed contest:

middle[l_List] := Pick[l, UnitStep[1. - Abs[# - Reverse@#]] &@ N @ Range @ Length @ l, 1]

I had come up with a pattern-matching solution, also not fast, when I notice I had been beaten by Mr.Wizard by a few hours. Anyway, just for fun:

middle[l_List] := 
 Pick[l, 0 & /@  l /. {x : 0 ..., Shortest[y__], x : 0 ...} :> 
    With[{y0 = 1 & /@ {y}}, {x, Sequence @@ y0, x}], 1];
share|improve this answer
    
I see my "fix" was already implemented here. +1 for playing the game. :-) –  Mr.Wizard Jun 9 '13 at 1:51
add comment

Definately the best solutions of all

(Reverse[%])

middle[l_List]:=Block[{x},
 l[[
   x /. {Reduce[# == MinValue[#, x, Integers], x, 
         Integers] &[(x - (Length@l + 1)/2)^2] // ToRules}]]
 ]

or

middle[l_List] := ListConvolve[#~UnitVector~((# + 1)/2) &[Length@l /. i_?EvenQ :> i - 1], l];
share|improve this answer
    
15 answers 15 votes. I can sleep now –  Rojo Jun 9 '13 at 13:45
add comment

It seems I have been remiss in not showing this other solution:

middle[l_List] := ArrayPad[l, -Quotient[(# - Boole[EvenQ[#]]) &[Length[l]], 2]]
share|improve this answer
add comment

I couldn't resist adding this "Rube Goldberg" solution, inspired by István's pattern matching:

rubeMiddle = 1& /@ # /. {r__, Shortest[x__], r__} :> Pick[#, Join[{r}, 2{x}, {r}], 2] &;

rubeMiddle /@ {{a, b, c}, {a, b, c, d}}
{{b}, {b, c}}
share|improve this answer
    
What happens if b == 0, say? –  Michael E2 Jun 8 '13 at 21:48
    
@MichaelE2 Good point. I'll fix it, and make it even more convoluted. :-) –  Mr.Wizard Jun 9 '13 at 1:49
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.