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

Question

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?

haha, so many good answers, come on, guys. Feel free to add your interesting answers. — HyperGroups, Jun 08 '13 at 12:31

Mr.Wizard · Accepted Answer · 2013-06-08T11:56:08.600

20

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

edited Jun 08 '13 at 11:56

answered Jun 08 '13 at 11:43

Mr.Wizard

271,378
34
587
1,371

3

I think your Update #2 answer is hard to top! – Aky Jun 08 '13 at 11:59
@Aky Thanks! We'll see. – Mr.Wizard Jun 08 '13 at 12:02
2

Your codes always impressed me. – HyperGroups Jun 09 '13 at 04:59
@HyperGroups Thank you. – Mr.Wizard Jun 09 '13 at 09: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 01 '15 at 21:07
@garej If I recall correctly I did not reject it, I simply chose Part, possibly for brevity but probably simply for variety. – Mr.Wizard Dec 02 '15 at 07:36

score 11 · Answer 2 · answered Jun 08 '13 at 13:15

11

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

answered Jun 08 '13 at 13:15

swish

7,881
26
48

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 08 '13 at 13:18
Combined with my solution: middle[l_List] := If[Length[l] <= 2, l, middle[ArrayPad[l, -1]]] – J. M.'s missing motivation Jun 08 '13 at 13:19
1

@Mr.Wizard I already anticipate the answer with time comparisons of all solutions to be made ;) – swish Jun 08 '13 at 13:28

score 9 · Answer 3 · edited Dec 05 '13 at 01:29

9

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

edited Dec 05 '13 at 01:29

mmal

3,508
2
18
38

answered Jun 08 '13 at 07:56

Aky

2,719
12
19

1

I like the Through and Nearest here. :) – HyperGroups Jun 09 '13 at 05:01

score 7 · Answer 4 · answered Jun 08 '13 at 07:39

7

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

answered Jun 08 '13 at 07:39

István Zachar

47,032
20
143
291

m_goldberg · Answer 5 · 2013-06-09T03:25:33.997

7

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

edited Jun 09 '13 at 03:25

answered Jun 08 '13 at 10:29

m_goldberg

107,779
16
103
257

bill s · Answer 6 · 2013-06-08T07:38:45.957

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.

edited Jun 08 '13 at 07:38

answered Jun 08 '13 at 07:19

bill s

68,936
4
101
191

TransferOrbit · Answer 7 · 2017-10-10T06:59:17.463

6

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

edited Oct 10 '17 at 06:59

answered Jun 08 '13 at 07:52

TransferOrbit

3,547
13
26

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 08 '13 at 11:17
A valid criticism by Aky, but +1 for inspiration. – Mr.Wizard Jun 08 '13 at 11:57

score 6 · Answer 8 · edited Jun 08 '13 at 09:31

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]

edited Jun 08 '13 at 09:31

m_goldberg

107,779
16
103
257

answered Jun 08 '13 at 08:53

esetlzn

61
2

score 5 · Answer 9 · answered Jun 08 '13 at 07:47

5

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

answered Jun 08 '13 at 07:47

J. M.'s missing motivation

124,525
11
401
574

Mr.Wizard · Answer 10 · 2013-06-09T01:49:34.777

5

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

edited Jun 09 '13 at 01:49

answered Jun 08 '13 at 12:20

Mr.Wizard

271,378
34
587
1,371

What happens if b == 0, say? – Michael E2 Jun 08 '13 at 21:48
@MichaelE2 Good point. I'll fix it, and make it even more convoluted. :-) – Mr.Wizard Jun 09 '13 at 01:49

score 5 · Answer 11 · answered Jun 08 '13 at 22:30

5

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

answered Jun 08 '13 at 22:30

Michael E2

235,386
17
334
747

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

Rojo · Answer 12 · 2013-06-09T14:07:14.417

5

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

edited Jun 09 '13 at 14:07

answered Jun 09 '13 at 13:08

Rojo

42,601
7
96
188

1

15 answers 15 votes. I can sleep now – Rojo Jun 09 '13 at 13:45

score 4 · Answer 13 · answered Jun 08 '13 at 13:27

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

score 4 · Answer 14 · answered Jun 08 '13 at 13:39

4

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

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

answered Jun 08 '13 at 13:39

J. M.'s missing motivation

124,525
11
401
574

score 4 · Answer 15 · answered Jun 08 '13 at 17:16

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

score 2 · Answer 16 · answered Nov 19 '23 at 09:09

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

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

16 Answers16

Linked