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

Question

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?

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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.

Answer 7

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]

Answer 8

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:

f@evenlist
f@oddlist
(* {m, n} *)
(* {m} *)

Answer 9

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

Answer 10

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

Answer 11

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

Answer 12

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

Answer 13

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

Answer 14

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

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

Answer 15

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

Answer 16

To avoid code repetition I define a helper finction p

p[x_, y_] := Partition[x, Ceiling[Length[x]/2] + y]

mid[x_] /; EvenQ @ Length @ x := p[x, 1][[1, -2 ;; -1]]
mid[x_] := {p[x, 0][[1, -1]]}

Examples

mid @ CharacterRange["a", "z"]

{"m", "n"}

mid @ CharacterRange["a", "y"]

{"m"}

mid @ Array[#1 &, {3, 4}]

{{2, 2, 2, 2}}