Hot moo shuffle: milk an array

Question

Background

Milking the deck is the name given to the following card shuffling method:

1. 'Pinch' the deck to remove the top and bottom cards simultaneously. (With lots of imagination, this action resembles milking a cow.) This pair of cards forms the base of a new pile.
2. Repeat, adding each pair of cards to the top of the new pile, until the whole deck has been used.

Example

Suppose we start with a deck of six cards, [1, 2, 3, 4, 5, 6] (lower-indexed elements are nearer to the top). Let's milk the deck:

0. old = [1, 2, 3, 4, 5, 6], new = []
1. Remove [1, 6]: old = [2, 3, 4, 5], new = [1, 6]
2. Remove [2, 5]: old = [3, 4], new = [2, 5, 1, 6]
3. Remove [3, 4]: old = [], new = [3, 4, 2, 5, 1, 6]

After milking, the deck is therefore ordered [3, 4, 2, 5, 1, 6].

Challenge

Your task in this code-golf challenge is to implement the milking operation on a given array and output/return the result. The input array will contain only positive integers, not necessarily distinct. If the input array contains an odd number of elements, then the last milking step transfers only one element (the last one remaining) from the input to the output array.

Test cases

Input -> Output

[1, 2, 3, 4, 5, 6] -> [3, 4, 2, 5, 1, 6]
[1, 2, 3, 4, 5, 6, 7] -> [4, 3, 5, 2, 6, 1, 7]
[9, 7, 5, 3, 1, 2, 4, 6, 8, 10] -> [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
[1, 1, 2, 1, 2] -> [2, 1, 1, 1, 2]
[] -> []

Answer 1

R, 53 50 48 bytes

f=function(x,y=rev(x))if(c(y,F))c(f(y[-1]),y[1])

Try it online!

Repeatedly takes the bottom card & flips the deck.

Answer 2

R, 36 bytes

function(x)rbind(rev(x),x)[-seq(!x)]

Try it online!

Takes integer(0) (a length 0 integer vector) for empty input.

Stacks the reversed array onto itself, giving something like:

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    7    6    5    4    3    2    1
[2,]    1    2    3    4    5    6    7

And then removes the first n=length(x) elements, going down the columns, then across the rows.

Answer 3

Haskell, 38, 33 bytes

g(x:y)=f y++[x]
g x=x
f=g.reverse

Try it online!

-5 bytes thanks to @Zgarb.

Very simple port of Dominic van Essen's solution. Go upvote theirs instead.

I was going to put this as a reference to compare to in my other answer, but figured it was more in the spirit of cgcc to submit twice.

Answer 4

Haskell with -XParallelListComp, 52 49 bytes

f l=drop(length l)$id=<<[[x,y]|x<-reverse l|y<-l]

Try it online!

Explanation

This is for my old answer. The only difference is that the riffling has been golfed from a call to zip and a flattening step to a parallel list comprehension and a flattening step.

This works by taking two copies of the input deck. You reverse the first copy, then riffle it with the second. Then remove as many cards as there were in the input deck, leaving behind the answer. In the code,

f l=drop(length l)$(\(x,y)->[x,y])=<<zip(reverse l)l
                   (\(x,y)->[x,y])=<<zip(reverse l)l  riffling
                                     zip                riffle
                                         reverse l      the reversed deck
                                                   l    the deck
                   (\(x,y)->[x,y])=<<                 flattening
    drop(length l)                                    removing
    drop                                                discard (from top)
         length l                                       length of input

The flattening portion does as follows. When riffled, the deck looks like [(6,1),(5,2),(4,3),(3,4),(2,5),(1,6)] (list of tuples). We "flatten it" to look like [6,1,5,2,4,3,3,4,2,5,1,6].

I remain convinced that this approach might be shorter than the port of Dominic van Essen's answer. I think the (\(x,y)->[x,y]) function can be shortened or removed, as well as the annoying use of length.

Pointfree Haskell, 61 bytes

Just for fun; I initially thought it would be shorter.

foldr(pure tail).((\(x,y)->[x,y])=<<).(zip.reverse<*>id)<*>id

Answer 5

Perl 5 + -p, 33 bytes

$\=" $` $'".$\,$_=$1while/ (.+) /

Try it online!

Explanation

This approach utilises -p which allows work on input implicitly, by putting it in $_ for each line of STDIN and implicitly printing $_ at the end of the program. $\ is used as this magic variable is automatically printed after the contents passed to print. The main body is a while loop that checks if $_ m//atches (.+) (a space followed by one or more characters followed by another space), while $_ does march (m// implicitly checks $_ when not called via =~) $\ is set to a space, the remaining string after the match ($') followed by another space and the preceding string contents before the match ($` ), concatenated with the existing contents of $\. $_ is then set to the matched string (excluding the spaces) which is captured in $1. At the end of the script, this leaves the central characters (either one or two depending on whether the list has an even or odd number of entries) in $_, which is implicitly printed, followed by the content of $\, which contains a leading space and the rest of the list "milked".

Answer 6

Python 3, 36 bytes

M=lambda a:a and M(a[-2::-1])+a[-1:]

Try it online!

Uses Dominic van Essen's approach: repeatedly takes the bottom card and recurses on the reverse of the rest of the deck.

Answer 7

05AB1E, 9 8 7 bytes

Âsø˜2äθ

-1 byte thanks to @Neil

Try it online or verify all test cases.

Or alternatively, a port of @DominicVanEssen's approach is 7 bytes as well:

vRćˆ}¯R

Try it online or verify all test cases.

Explanation:

        # Bifurcate the (implicit) input-list (short for Duplicate & Reverse copy)
         #  i.e. [1,2,3,4,5,6,7] → [1,2,3,4,5,6,7] and [7,6,5,4,3,2,1]
 s       # Swap so the input-list is at the top again
         #  → [7,6,5,4,3,2,1] and [1,2,3,4,5,6,7]
  ø      # Zip/transpose the lists together to create pairs
         #  → [[7,1],[6,2],[5,3],[4,4],[3,5],[2,6],[1,7]]
   ˜     # Flatten it
         #  → [7,1,6,2,5,3,4,4,3,5,2,6,1,7]
    2ä   # Split it into 2 equal-sized parts
         #  → [[7,1,6,2,5,3,4],[4,3,5,2,6,1,7]]
      θ  # Pop and push just the last part
         #  → [4,3,5,2,6,1,7]
         # (after which it is output implicitly as result)

v        # Loop the (implicit) input-list amount of times:
         #   i.e. we'll loop 7 times for input [1,2,3,4,5,6,7]
 R       #  Reverse the list at the top of the stack,
         #  which will use the (implicit) input-list in the first iteration
         #   i.e. [1,2,3,4,5,6,7] → [7,6,5,4,3,2,1]
  ć      #  Extract head; pop and push remainder-list and first item separated
         #   → [6,5,4,3,2,1] and 7
   ˆ     #  Pop this first item, and add it to the global array
}¯       # After the loop: push the global array
         #  → [7,1,6,2,5,3,4]
  R      # Reverse it
         #  → [4,3,5,2,6,1,7]
         # (after which it is output implicitly as result)

Answer 8

C (gcc), 65 62 60 bytes

i;f(c,z)int*c;{for(i=0;i||(i=z-=2)>0;)*c^=c[i--]^=*c^=c[i];}

Try it online!

The loop iterates backwards from the last - 1 element and swaps it with the first element. Then it restarts iteration two elements backwards until finished.

Saved 3 using loop reset in loop check instead of recursion.

Saved 2 more because i>0 check is no more needed.

Example

1 2 3 4 5 6 7 8 => 4 5 3 6 2 7 1 8
7           1
6.        7
5.      6
4.    5
3.  4
2 3 4 5 6 7 1 8
6       2
5     6
4.  5
3 4 5 6 2 7 1 8
5   3
4 5

Answer 9

Pyth, ¹¹ 10 bytes

-1 byte thanks to @FryAmTheEggman

L&bay_Pbeb

port of Dominic van Essen's solution to Pyth.

Try it online!

Explanation

L&bay_Pbeb
L              define function named y with argument b which returns
 &b            short circuiting and of b and
   a    eb     the last element of b appended to
    y          the return value of y when called on
     _         the reverse of
      Pb       b without its last element

Answer 10

Pyth, 6 bytes

ec2.i_

Try it online!

Looking through the Pyth documentation reminded me of the interleave function .i, which is extremely useful here.

How it works:

• .i: Interleave the following two lists:

  • _: The reversal of the input (implicit), and

  • The input (implicit).

• c2: Split the result in half.

• e: Output the second half.

Answer 11

APL (Dyalog Classic), 7 bytes

-4 bytes thanks to Ada

-3 bytes thanks to Bubbler

-1 byte thanks to ngn!

≢↓∘∊⌽,⍪

Try it online!

Port of Kevin Cruijssen's 05AB1E answer and streetster's K solution - don't forget to upvote them!

Answer 12

Python 3, 45 bytes

M=lambda a:a and M(a[1:-1])+a[::len(a)-1or 1]

Try it online!

Performs milking in the same procedure as specified.

Answer 13

Brachylog, 10 bytes

Same approach as Dominic van Essen's answer, so upvote that.

Ė|tT&k↔↰,T

Try it online!

Ė|tT&k↔↰,T
Ė          input is an empty list
 |         or
  tT       save the input's last element as T
    &      and
     k     the input without the last element
      ↔    reverse it
       ↰   recursively call this predicate
        ,T and append T 

Answer 14

Charcoal, 14 bytes

Ｉ⮌Ｅθ§⎇﹪κ²θ⮌θ⊘κ

Try it online! Link is to verbose version of code. Works by calculating the reverse of the first half of the flattened zip of the reversed list with itself. Explanation:

   θ            Input array
  Ｅ             Map over elements
       κ        Current index
      ﹪ ²       Modulo literal 2
         θ      Input array
     ⎇          If index was odd otherwise
          ⮌     Reverse of
           θ    Input array
    §           Indexed by
             κ  Current index
            ⊘   Halved
 ⮌              Reverse the result
Ｉ               Cast to string
                Implicitly print

Answer 15

Brainfuck, 64 Bytes

,[>,]<[[->>+<<]<[<]>[-<+>]<[->>[>]>+<<[<]<]>>[[-<+>]>]<<]>>>[.>]

Try it online!

,[>,] Read input array into memory
<[[->>+<<] Move last number of input to the right of the input array
<[<]>[-<+>] Move the first number of input to the left the input array
<[->>[>]>+<<[<]<] Move the number left of the input array to the left side of the number(s) to the right of the input array
>>[[-<+>]>]<<] Move the input array to the left to make some space, then repeat
>>>[.>] Print output array

Answer 16

C (gcc), 88 71 62 60 59 bytes

Saved 9 bytes thanks to ceilingcat!!!

Saved a byte thanks to G. Sliepen!!!

t;i;f(l,n)int*l;{for(;n>1;l[n]=t)t=*l,wmemcpy(l,l+1,n-=2);}

Try it online!

Inputs a pointer to the array and its length and milks the array in place.

Code actually does the moo-shuffle: tucking the first element away, shifting all but the last down one, and putting the first one just in front of the last. This is repeated, shifting down 2 elements from the end each time, until there are only two elements left and we're done.

Answer 17

K (oK), 16 15 bytes

Solution:

{(#x)_,/|x,'|x}

Try it online!

Port of Kevin's solution.

Explanation:

{(#x)_,/|x,'|x} / the solution
{             } / lambda taking implicit x
            |x  / reverse x
         x,'    / join each with x
        |       / reverse
      ,/        / flatten
     _          / drop
 (  )           / do this together
  #x            / count x

Extra:

• -1 byte thanks to @ngn

Answer 18

JavaScript (ES6), 43 bytes

Using a variant of Dominic van Essen's approach:

f=(a,x=a.pop())=>x?[...f(a.reverse()),x]:[]

Try it online!

---

JavaScript (ES6),  41  40 bytes

If we can take the length of the array as an extra parameter, the following non-recursive algorithm is shorter:

n=>a=>a.map((_,k)=>a[n+++n%2*(~k-k)>>1])

Try it online!

Answer 19

GNU sed (-E), 54 bytes

:l;s/(\w+, )(.* )(\w+.*)\]/\2\]\1\3/;tl;s/\]//;s/$/\]/

This assumes the array is passed over stdin as text in exactly the same format as in the problem statement (in particular, whitespace is important).

Explanation/Example

Let's consider the input [1, 2, 3, 4, 5, 6] and look at the script statement-by-statement.

1. :l: Create a label called l to branch to later.
2. s/(\w+, )(.* )(\w+.*)\]/\2\]\1\3/: [1, 2, 3, 4, 5, 6] -> [2, 3, 4, 5, ]1, 6.
3. tl: did the last s command do something? Yes, so branch to l.
4. s/(\w+, )(.* )(\w+.*)\]/\2\]\1\3/: [2, 3, 4, 5, ]1, 6 -> [3, 4, ]2, 5, 1, 6.
5. tl: did the last s command do something? Yes, so branch to l.
6. s/(\w+, )(.* )(\w+.*)\]/\2\]\1\3/: pattern doesn't match!
7. tl: did the last s command do something? No, so don't branch.
8. s/\]//: [3, 4, ]2, 5, 1, 6 -> [3, 4, 2, 5, 1, 6.
9. s/$/\]/: [3, 4, 2, 5, 1, 6 -> [3, 4, 2, 5, 1, 6].

Note that this works for arrays of text consisting of alphanumeric characters or underscores, not just positive integers.

Try it online!

Answer 20

APL+WIN, 40 bytes

Prompts for input of a vector if indices:

(,⊖⍉(2,n)⍴(n↑(-n)↓m),⌽(-n←⌈.5×⍴m)↑m←⎕)~0

Try it online! Courtesy of Dyalog Classic

A simpler approach, 26 bytes

m[(-⍴m)↑,⌽⍉n,[.1]⌽n←⍳⍴m←⎕]

Try it online! Courtesy of Dyalog Classic

Answer 21

Japt, 6 bytes

Looking through the rest of the solutions after posting this, I feel like I must be missing something.

ÊÆÔvÃÔ

Try it or run all test cases

JavaScript "translation":

U=>[...Array(U.length)].map(_=>U.reverse().shift()).reverse()

ÊÆÔvÃÔ     :Implicit input of array U
Ê          :Length
 Æ         :Map range
  Ô        :  Reverse U
   v       :  Remove and return first element
    Ã      :End map
     Ô     :Reverse

Mapping the original array would be one byte shorter but, as both methods used in the map modify that array, it wouldn't work.

Answer 22

x86-16 machine code, 21 20 bytes

Binary:

00000000: 8bde 03f1 4e03 f94f fda4 e201 c38a 0743  ....N..O.......C
00000010: aae2 f6c3                                ....

Listing:

8B DE       MOV  BX, SI             ; BX = beginning of input array 
03 F1       ADD  SI, CX             ; SI = end of input array  
4E          DEC  SI                 ; adjust to last element 
03 F9       ADD  DI, CX             ; DI = end of output array 
4F          DEC  DI                 ; adjust to last element 
FD          STD                     ; set direction flag to descend 
        MILKLAST:
A4          MOVSB                   ; write end of input array value to output array
E2 01       LOOP MILKFIRST          ; if not end of array, move first value
C3          RET                     ; otherwise, return to caller
        MILKFIRST:
8A 07       MOV  AL, BYTE PTR[BX]   ; AL = start of input array value 
43          INC  BX                 ; increment pointer 
AA          STOSB                   ; write to output array 
E2 F6       LOOP MILKLAST           ; loop until end of array
C3          RET                     ; return to caller

Callable function, input array in [SI], length in CX. Output array to buffer at [DI].

Tests using DOS DEBUG:

Answer 23

Husk, 8 bytes

↓L¹Σze↔¹

Try it online!

↓L¹Σze↔¹
    z     Zip 
      ↔¹  the list with its reverse
     e    into a list of 2 elements
   Σ      Flatten it
↓         Drop
 L¹       the first n elements

Answer 24

Io, 53 bytes

Port of @Neil's Charcoal answer.

method(x,x map(i,v,x at(if(i%2>0,i,-i-1)>>1))reverse)

Try it online!

Io, 68 bytes

Port of @DominicvanEssen's answer.

f :=method(x,if(x size>0,list(x pop,f(x reverse))reverse flatten,x))

Try it online!

Answer 25

Dyalog APL, 28 bytes

{⍵≡⍬:⍬⋄0~⍨(∇¯1↓1↓⍵),¯2↑1⌽⌽⍵}

Try it online!

Answer 26

C# (Visual C# Interactive Compiler), 102 bytes

IEnumerable<int>f(int[]o)=>o.Length==0?new int[0]:o.Length==1?o:f(o[1..^1]).Concat(new[]{o[0],o[^1]});

Try it online!

Answer 27

Keg, 34 bytes

÷(!½;|")!2%[!1>[$]. ,]{!|$(2|. ,)'

Try it online!

+5 due to bug fix

Answer 28

Clojure, 40 bytes

#(drop(count %)(mapcat vector(rseq %)%))

Try it online!

Answer 29

Wolfram Language (Mathematica), 36 bytes

f@a___:=a
f[a_,b__,c_]:=##&[f@b,a,c]

Try it online!

Boring, but less boring approaches seem to be more verbose. Returns a Sequence containing the deck.

Answer 30

Brachylog, 7 bytes

↔;?zcḍt

Try it online!

Explanation

Same idea as Kevin's 05AB1E answer (the first one). Suppose the input list is [1,2,3,4,5]:

↔        Reverse                      [5,4,3,2,1]
 ;?      Pair with the input again    [[5,4,3,2,1],[1,2,3,4,5]]
   z     Zip                          [[5,1],[4,2],[3,3],[2,4],[1,5]]
    c    Concatenate sublists         [5,1,4,2,3,3,2,4,1,5]
     ḍ   Split into two halves        [[5,1,4,2,3],[3,2,4,1,5]]
      t  Take the second half         [3,2,4,1,5]