15
\$\begingroup\$

Your task is to find out how often you need to "shuffle" a given list with the following operation until you get back the original list.

start with a list:
(1 2 3 4 5 6 7 8 9) 
split it into the elements at odd and even indices
(1 3 5 7 9) (2 4 6 8)
concatenate these two list
(1 3 5 7 9 2 4 6 8)

Input: A list

Output: The number of iterations it takes until you get back the original list

Examples

(1 2 3) -> (1 3 2) -> (1 2 3)               => 2
(1 2 3 4 3 2 1) -> (1 3 3 1 2 4 2) -> ...   => 3
(1 2 3 4 5 6 7 8 9 10) -> ...               => 6
(1 2 3 4 5 6 7 8 9 10 11) -> ...            => 10
"abab" -> "aabb" -> "abab"                  => 2
"Hello, World!" -> "Hlo ol!el,Wrd" -> ...   => 12
(1 0 1 1 0 0 0 1 1 1) -> ...                => 6
(1 0 0 1 1 1 0 0 0 0 1) -> ...              => 10
(1 1 1 1 1 1 1) -> (1 1 1 1 1 1 1)          => 1

Rules

  • You can use lists of any type (that supports at least two distinct values)
  • You can assume the the list has at least two elements
  • The odd/even indices are determined using 1-based indexing
  • You have to apply the operation at least once
  • If your language has a built-in for finding fixed points consider adding a non-builtin solution as well
  • This is the shortest solution (per language) wins
\$\endgroup\$
2
  • 2
    \$\begingroup\$ Can we assume that the list has more than one element? \$\endgroup\$ Commented Aug 21, 2023 at 8:39
  • \$\begingroup\$ Related \$\endgroup\$
    – DJMcMayhem
    Commented Aug 21, 2023 at 22:22

18 Answers 18

8
\$\begingroup\$

K (ngn/k), 12 bytes

#{x@<2!!#x}\

Try it online!

{ ... }\ Iterate until reaching the first value again (or a fixed point). Collect intermediate values.
2!!#x 2 mod range of length x. Sequence of alternating 0s and 1s the same length as x.
x@< Grade up, then index into x. Sorts x by that sequence.

# Length. Counts the number of intermediate results.

\$\endgroup\$
3
  • 1
    \$\begingroup\$ "Iterate until reaching the first value again (or a fixed point)" -- Looks like the K builtin is much nicer than J's here. In J, only consecutive repeats count as a fixed point. In K, it sounds like at minimum "repeat consecutive" and "repeat first" trigger a break. What about "repeat some other intermediate value, but not consecitively"? Ie, stop when you see any previous value a 2nd time? (this makes the most sense to me) \$\endgroup\$
    – Jonah
    Commented Aug 20, 2023 at 18:33
  • 1
    \$\begingroup\$ @Jonah intermediate values are not checked, which can be a pain when cycles don't include the initial value. I think the justification is that quadratic complexity could be unwanted/unexpected \$\endgroup\$
    – ovs
    Commented Aug 20, 2023 at 19:02
  • 1
    \$\begingroup\$ Right. Ideally, it would be configurable (via an adverb perhaps in J-land), and you could even configure the check to use something like a hash table. \$\endgroup\$
    – Jonah
    Commented Aug 20, 2023 at 19:10
8
\$\begingroup\$

Thunno 2 L, 4 bytes

µ¥zS

Try it online! or verify all test cases

µ¥zḞ

Try it online! or verify all test cases

µ¥^ḥ

Try it online! or verify all test cases


Don't worry, the stack languages with single-byte uninterleave operators are going to be even shorter :P

lol

Explanation

      # Implicit input

µ¥    # Collect while unique:

  z   #  Uninterleave into two pieces
      #   [1,2,3,4,5,6]  ->  [[1,3,5],[2,4,6]]
   S  #  Then flatten the nested list
      #   [[1,3,5],[2,4,6]]  ->  [1,3,5,2,4,6]
   Ḟ  #  Alternative flatten built-in
      #   [[1,3,5],[2,4,6]]  ->  [1,3,5,2,4,6]

  ^   #  Or, uninterleave and push separately
      #   [1,2,3,4,5,6]  ->  [1,3,5] [2,4,6]
   ḥ  #  Then concatenate the two lists
      #   [1,3,5] [2,4,6]  ->  [1,3,5,2,4,6]

      # Finally, the L flag takes the length
      # Implicit output
\$\endgroup\$
7
\$\begingroup\$

J, 26 24 bytes

i.~_:0}(\:2|#\)^:(3<@^#)

Try it online!

Accepts numeric lists

The maximum number of iterations until we return to the input is bounded by Landau's function \$g(n)\$, and it can be shown that:

$$ {\displaystyle g(n)\leq e^{n/e}} $$

For golf reasons, I simply round that to:

$$ {\displaystyle g(n)\leq 3^{n}} $$

and iterate that many times. Note I could trade bytes for efficiency here and iterate until I see the input again, but this approach was shorter.

  • (\:2|#\) Apply the needed permutation -- equivalent to sorting down by 1 0 1 0...
  • ^:(3<@^#) Do that \$3^n\$ times, saving results
  • _:0} Convert the first item on the list, which is the input itself, to infinity, so that match will be skipped.
  • i.~ Index of the input within that list.
\$\endgroup\$
6
\$\begingroup\$

Jelly, 6 bytes

ŒœẎ$ƬL

Try it online!

Don't worry, the stack languages with single-byte uninterleave operators are going to be even shorter :P

    Ƭ     Repeat while unique, collecting all results:
Œœ        Split into odd and even-indexed elements,
  Ẏ$      and concatenate.
     L    How many results are there?
\$\endgroup\$
5
\$\begingroup\$

05AB1E, 8 bytes

vDÅ≠})Ùg

Try it online or verify all test cases (the test suite uses the faster alternative ι˜ instead of Å≠).

Explanation:

Although 05AB1E has an unshuffle builtin Å≠ (even though ι˜ does the same and is faster..), it unfortunately lacks a "Repeat until unique" builtin..

v     # Loop the (implicit) input-length amount of times:
 D    #  Duplicate the current list
      #  (which will be the implicit input-list in the first iteration)
  Å≠  #  Unshuffle it
})    # After the loop: wrap all lists on the stack into a list
  Ù   # Uniquify this list of lists
   g  # Pop and push its length
      # (which is output implicitly as result)

  ι   #  Uninterleave it into a pair of lists
   ˜  #  Flatten it to a single list
\$\endgroup\$
5
\$\begingroup\$

Google Sheets, 107 bytes

=let(d,torow(A:A,3),_,lambda(_,a,n,sort(let(b,torow(wrapcols(a,2),3),if(and(b=d),n,_(_,b,1+n))))),_(_,d,1))

Put the input in cells A1:A and the formula in B1.

The formula is self-contained. Uses singularize(wrap()) like the Excel answer but does not depend on named functions or named ranges.

Try it.

\$\endgroup\$
1
  • \$\begingroup\$ Welcome to Code Golf, and nice answer! \$\endgroup\$
    – rydwolf
    Commented Aug 22, 2023 at 15:34
4
\$\begingroup\$

Python, 65 bytes

lambda s,j=1:j*((t:=s[:len(s)-1|1])==(t*2**j)[::2**j])or f(s,j+1)

Attempt This Online!

How?

This is based on the observation that in zero-based indexing the reshuffle can be written as n -> 2n mod N where N is the largest odd number not greater than the length of the input. (If the length is even the last point is a fixed point, so it can be ignored.)

\$\endgroup\$
4
\$\begingroup\$

Nekomata + -n, 6 bytes

ᶦ{ĭ,ᵖ≠

Attempt This Online!

Nekomata has a single-byte uninterleave operator, but still can't beat Jelly, because it doesn't have a "repeat while unique" operator.

ᶦ{ĭ,ᵖ≠
ᶦ{          Repeat until failure:
  ĭ             Uniterleave
   ,            Join
    ᵖ≠          Check if the result is unequal to the input

-n counts the number of iterations.

\$\endgroup\$
4
\$\begingroup\$

Excel, 93 bytes

Define:

a as =$A$1# (7 bytes)

z as =LAMBDA(p,q,LET(x,TOCOL(WRAPROWS(p,2),2,1),y,q+1,IF(SUM(N(x<>a))=0,y,z(x,y)))) (79 bytes)

Within the worksheet: =z(a,0) (7 bytes)

$A$1# is a spilled, vertical range comprising the list entries.

\$\endgroup\$
4
\$\begingroup\$

R, 70 bytes

f=\(x,l=0,y=c(x[!0:1],x[!1:0]),`-`=list)`if`(-y%in%l,0,1+f(y,c(l,-y)))

Attempt This Online!

\$\endgroup\$
4
\$\begingroup\$

Ruby, 55 bytes

->l{k=*l;1.step.find{w=-2;l==k=k.map{k[w+=2]||k[w=1]}}}

Try it online!

\$\endgroup\$
1
  • \$\begingroup\$ -1 byte by upgrading to 2.6 for endless range. Also, since you're reassigning instead of modifying k you can skip the splat and just do a shallow assignment at the start. Attempt This Online \$\endgroup\$
    – Value Ink
    Commented Aug 21, 2023 at 20:54
4
\$\begingroup\$

Vyxal l, 31 bitsv2, 3.875 bytes

yJ)↲

Try it Online!

the stack languages with single-byte uninterleave operators are going to be even shorter

~ some jelly answer, probably

\$\endgroup\$
0
4
\$\begingroup\$

R, 54 52 51 bytes

Edit: -3 bytes thanks to @Dominic van Essen.

\(x,y=x){while(sd((y[]=matrix(y,2,,T))-x))T=T+1;+T}

Attempt This Online!

\$\endgroup\$
4
  • \$\begingroup\$ Nice! What on earth was I thinking collecting all the intermediate values...? Doh! Well done. \$\endgroup\$ Commented Aug 21, 2023 at 10:19
  • 1
    \$\begingroup\$ 52 bytes... \$\endgroup\$ Commented Aug 21, 2023 at 10:42
  • \$\begingroup\$ 51 bytes...(y-x can never be all-the-same unless it's all-zero, I think...) \$\endgroup\$ Commented Aug 21, 2023 at 21:14
  • \$\begingroup\$ @DominicvanEssen Nice observation! \$\endgroup\$
    – pajonk
    Commented Aug 22, 2023 at 4:43
3
\$\begingroup\$

Charcoal, 27 bytes

⊞υθW‹№υθ²⊞υ⭆²Φ§υ±¹﹪⁺κν²I⊖Lυ

Try it online! Link is to verbose version of code. Only works on strings. Explanation:

⊞υθ

Push the string to the predefined empty list.

W‹№υθ²

Repeat until a second copy of the string is found.

⊞υ⭆²Φ§υ±¹﹪⁺κν²

Shuffle the most recent string and push it to the list.

I⊖Lυ

Output the number of shuffles taken.

28 bytes to work on strings or lists:

⊞υθW‹№υθ²⊞υΣE²Φ§υ±¹﹪⁺κν²I⊖Lυ

Attempt This Online! Link is to verbose version of code.

\$\endgroup\$
3
\$\begingroup\$

sclin, 45 bytes

=$a $a"2/` tpose flat"itr1dp"$a !=`"tk* len1+

Try it here! Takes a list.

For testing purposes:

[1 2 3 4 5 6 7 8 9 10 11] ;
=$a $a"2/` tpose flat"itr1dp"$a !=`"tk* len1+

NOTE: for string-based inputs, use e.g. ["a" "b" "a" "b"].

Explanation

Prettified code:

=$a $a.
( 2/` tpose flat ) itr 1dp ( $a !=` ) tk* len 1+
  • =$a $a Input list a
  • (...) itr generate infinite list from successive modifications of a...
    • 2/` tpose flat chunk into pairs, transpose, flatten
  • 1dp drop first item to prevent tk* from exiting early
  • ( $a !=` ) tk* take while not equal to a
  • len 1+ length + 1
\$\endgroup\$
3
\$\begingroup\$

JavaScript (ES6), 64 bytes

Expects a list of positive integers.

a=>(g=a=>(g[a]^=i=-2)&&1+g(a.map(_=>a[!a[i+=2]|i%a.length])))(a)

Try it online!

How?

We can apply the shuffle by doing:

a.map((_, i) => a[!a[i * 2] | i * 2 % a.length])

This code first collects all values at even (0-based) indices. When a[i * 2] is not defined anymore, it starts collecting values at odd indices.

For golfing reasons, we rather start with \$i=-2\$ and do:

a.map(_ => a[!a[i += 2] | i % a.length])

We stop as soon as the same array has been encountered twice and return the number of iterations.

\$\endgroup\$
0
3
\$\begingroup\$

Arturo, 49 bytes

$->a[1x:a while[i:0arrange'x=>[i%2'i+1]x<>a][1+]]

Try it!

$->a[                         ; a function taking an input a
    1                         ; push 1 -- this is our output (count)
    x:a                       ; assign a to x
    while[                    ; while...
        i:0                   ; assign 0 to i
        arrange'x=>[i%2'i+1]  ; sort x by its indices' parities
        x<>a                  ; x doesn't equal a...
    ]                         ; end while predicate
    [1+]                      ; ...then increment the output
]                             ; end function
\$\endgroup\$
1
\$\begingroup\$

Haskell, 77 bytes

o(x:s)=x:e s
o _=[]
e=o.drop 1
a!b|a==b=1|0<1=1+a!(o b++e b)
f a=a!(o a++e a)

Try it online!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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