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

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?

-

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]]

-
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
Your codes always impressed me. – HyperGroups Jun 9 '13 at 4:59
@HyperGroups Thank you. – Mr.Wizard Jun 9 '13 at 9:46
@Mr.Wizard, why have you rejected mid[a_List] := Take[a, {#, -#}] &@\[LeftCeiling]Length@a/2\[RightCeiling]? Is Part in general faster than Take? – garej Dec 1 '15 at 21:07

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}}*)

-
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
@Mr.Wizard I already anticipate the answer with time comparisons of all solutions to be made ;) – swish Jun 8 '13 at 13:28
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]]]]

-
I like the Through and Nearest here. :) – HyperGroups Jun 9 '13 at 5:01

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]]}]]

-

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.

-

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} *)

-

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]

-

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]}

-

Here's a short alternative (44 characters):

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


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} *)

-
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

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}} *)

-

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...

-

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];

-
I see my "fix" was already implemented here. +1 for playing the game. :-) – Mr.Wizard Jun 9 '13 at 1:51

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];

-
15 answers 15 votes. I can sleep now – Rojolalalalalalalalalalalalala Jun 9 '13 at 13:45

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

middle[l_List] := ArrayPad[l, -Quotient[(# - Boole[EvenQ[#]]) &[Length[l]], 2]]

-

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}}

-
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