New order #4: World

Introduction (may be ignored)

Putting all positive numbers in its regular order (1, 2, 3, ...) is a bit boring, isn't it? So here is a series of challenges around permutations (reshuffelings) of all positive numbers. This is the fourth challenge in this series (links to the first, second and third challenge).

In this challenge, we will explore not one permutation of the natural numbers, but an entire world of permutations!

In 2000, Clark Kimberling posed a problem in the 26th issue of Crux Mathematicorum, a scientific journal of mathematics published by the Canadian Mathematical Society. The problem was:

$$\\text{Sequence }a = \begin{cases} a_1 = 1\\ a_n = \lfloor \frac{a_{n-1}}{2} \rfloor\text{ if }\lfloor \frac{a_{n-1}}{2} \rfloor \notin \{0, a_1, ... , a_{n-1}\}\\ a_n = 3 a_{n-1}\text{ otherwise} \end{cases}\$$

Does every positive integer occur exactly once in this sequence?

In 2004, Mateusz Kwasnicki provided positive proof in the same journal and in 2008, he published a more formal and (compared to the original question) a more general proof. He formulated the sequence with parameters $$\p\$$ and $$\q\$$:

$$\\begin{cases} a_1 = 1\\ a_n = \lfloor \frac{a_{n-1}}{q} \rfloor\text{ if }\lfloor \frac{a_{n-1}}{q} \rfloor \notin \{0, a_1, ... , a_{n-1}\}\\ a_n = p a_{n-1}\text{ otherwise} \end{cases}\$$

He proved that for any $$\p, q>1\$$ such that $$\log_p(q)\$$ is irrational, the sequence is a permutation of the natural numbers. Since there are an infinite number of $$\p\$$ and $$\q\$$ values for which this is true, this is truly an entire world of permutations of the natural numbers. We will stick with the original $$\(p, q)=(3, 2)\$$, and for these paramters, the sequence can be found as A050000 in the OEIS. Its first 20 elements are:

1, 3, 9, 4, 2, 6, 18, 54, 27, 13, 39, 19, 57, 28, 14, 7, 21, 10, 5, 15

Since this is a "pure sequence" challenge, the task is to output $$\a(n)\$$ for a given $$\n\$$ as input, where $$\a(n)\$$ is A050000.

Given an integer input $$\n\$$, output $$\a(n)\$$ in integer format, where:

$$\\begin{cases} a(1) = 1\\ a(n) = \lfloor \frac{a(n-1)}{2} \rfloor\text{ if }\lfloor \frac{a(n-1)}{2} \rfloor \notin \{0, a_1, ... , a(n-1)\}\\ a(n) = 3 a(n-1)\text{ otherwise} \end{cases}\$$

Note: 1-based indexing is assumed here; you may use 0-based indexing, so $$\a(0) = 1; a(1) = 3\$$, etc. Please mention this in your answer if you choose to use this.

Input | Output
---------------
1     |  1
5     |  2
20    |  15
50    |  165
78    |  207
123   |  94
1234  |  3537
3000  |  2245
9999  |  4065
29890 |  149853

Rules

• Input and output are integers (your program should at least support input and output in the range of 1 up to 32767)
• Invalid input (0, floats, strings, negative values, etc.) may lead to unpredicted output, errors or (un)defined behaviour.
• Default I/O rules apply.
• Default loopholes are forbidden.
• This is , so the shortest answers in bytes wins
• I would answer this using TI-BASIC, but the input would be limited to $0<N<1000$ since lists are limited to 999 elements. Great challenge nonetheless! Apr 9 '19 at 14:27
• @Tau : although out-of-spec (and this non-competing), I'd be interested in your solution. Do your have one you can post? Apr 9 '19 at 16:50
• I deleted the program, but I should be able to recreate it. I'll post it as non-competing once I have redone it. Apr 9 '19 at 18:20
• @agtoever, "non-competing" doesn't cover invalid solutions; it was for solutions using languages or language features that were created after a challenge was posted. Apr 9 '19 at 22:19
• PP&CG meta is indeed very clear on this. I wasn't award of such a strict interpretation of "non-competing"... @Tau : it seems you can't post your TI-BASIC solution under these rules. Sorry. Apr 10 '19 at 5:22

JavaScript (ES6),  55 51  50 bytes

Saved 1 byte thanks to @EmbodimentofIgnorance
Saved 1 byte thanks to @tsh

n=>eval("for(o=[p=2];n--;)o[p=o[q=p>>1]?3*p:q]=p")

Try it online!

• 55 bytes Apr 7 '19 at 22:09
• @EmbodimentofIgnorance I usually avoid that trick, as the eval'ed code is much slower. But the difference is barely noticeable for that one, so I guess that's fine. Apr 7 '19 at 22:16
• But this is code-golf, we don't care about speed, as long as it gets the job done Apr 7 '19 at 22:22
• n=>eval("for(o=[p=2];n--;)o[p=o[q=p>>1]?3*p:q]=p")
– tsh
Apr 8 '19 at 2:34

Jelly, 15 bytes

µ×3żHḞḢḟȯ1Ṫ;µ¡Ḣ

A full program accepting the integer, n (1-based), from STDIN which prints the result.

Try it online!

How?

µ×3żHḞḢḟȯ1Ṫ;µ¡Ḣ - Main Link: no arguments (implicit left argument = 0)
µ           µ¡  - repeat this monadic chain STDIN times (starting with x=0)
-                   e.g. x = ...  0      [1,0]            [9,3,1,0]
×3             -   multiply by 3                 0      [3,0]            [27,9,3,0]
H           -   halve                         0      [1.5,0]          [4.5,1.5,0.5,0]
ż            -   zip together                  [0,0]  [[3,1.5],[0,0]]  [[27,4.5],[9,1.5],[3,0.5],[0,0]]
Ḟ          -   floor                         [0,0]  [[3,1],[0,0]]    [[27,4],[9,1],[3,0],[0,0]]
Ḣ         -   head                          0      [3,1]            [27,4]
ḟ        -   filter discard if in x        []                   [27,4]
ȯ1      -   logical OR with 1             1                    [27,4]
Ṫ     -   tail                          1      3                4
;    -   concatenate with x            [1,0]  [3,1,0]          [4,9,3,1,0]
Ḣ - head                            1      3                4
- implicit print

05AB1E, 16 15 bytes

Saved 1 byte thanks to Kevin Cruijssen.
0-indexed.

¾ˆ$FDˆx3*‚;ï¯Kн Try it online! Explanation Using n=1 as example ¾ˆ # initialize global array as $                # initialize stack with 1, input
F               # input times do:
Dˆ             # duplicate current item (initially 1) and add one copy to global array
# STACK: 1, GLOBAL_ARRAY: [0, 1]
x            # push Top_of_stack*2
# STACK: 1, 2, GLOBAL_ARRAY: [0, 1]
3*          # multiply by 3
# STACK: 1, 6, GLOBAL_ARRAY: [0, 1]
‚;ï       # pair and integer divide both by 2
# STACK: [0, 3], GLOBAL_ARRAY: [0, 1]
¯K     # remove any numbers already in the global array
# STACK: , GLOBAL_ARRAY: [0, 1]
н    # and take the head
# STACK: 3
• 15 bytes Apr 8 '19 at 12:50
• @KevinCruijssen: Thanks! I thought of using the global array, but assumed it would be the same length as a list on the stack and never tried it :/ Apr 8 '19 at 13:18

Perl 6, 49 bytes

-2 bytes thanks to nwellnof

{(1,3,{(3*@_[*-1]Xdiv 6,1).max(*∉@_)}...*)[$_]} Try it online! Returns the 0-indexed element in the sequence. You can change this to 1-indexed by changing the starting elements to 0,1 instead of 1,3 Explanation: { } # Anonymous code block ( ...*)[$_]   # Index into the infinite sequence
1,3                                            # That starts with 1,3
,{                             }            # And each element is
(                 ).max(    )             # The first of
@_[*-1]X                               # The previous element
3*        div 6                          # Halved and floored
3*        div  ,1                        # Or tripled
*∉@_             # That hasn't appeared in the sequence yet

Japt, 15 14 bytes

1-indexed.

@[X*3Xz]kZ Ì}g

Try it

@[X*3Xz]kZ Ì}g     :Implicit input of integer U
g     :Starting with the array [0,1] do the following U times, pushing the result to the array each time
@                  :  Pass the last element X in the array Z through the following function
[                 :    Build an array containing
X*3              :      X multiplied by 3
Xz            :      X floor divided by 2
]           :    Close array
kZ         :    Remove all elements contained in Z
Ì       :    Get the last element
}      :  End function
:Implicit output of the last element in the array

J, 47 40 bytes

[:{:0 1(],<.@-:@{:@](e.{[,3*{:@])])^:[~]

Try it online!

ungolfed

[: {: 0 1 (] , <.@-:@{:@] (e. { [ , 3 * {:@]) ])^:[~ ]

Direct translation of the definition into J. It builds bottom up by using ^: to iterate from the starting value the required number of times.

Java 10, 120 99 bytes

n->{var L=" 1 0 ";int r=1,t;for(;n-->0;L+=r+" ")if(L.contains(" "+(r=(t=r)/2)+" "))r=t*3;return r;}

Try it online.

Explanation:

n->{                              // Method with integer as both parameter and return-type
var L=" 1 0 ";                  //  Create a String that acts as 'List', starting at [1,0]
int r=1,                        //  Result-integer, starting at 1
t;                          //  Temp-integer, uninitialized
for(;n-->0;                     //  Loop the input amount of times:
L+=r+" "))                  //    After every iteration: add the result to the 'List'
t=r     //   Create a copy of the result in t
r=(...)/2  //   Then integer-divide the result by 2
if(L.contains(" "+(...)+" ")) //   If the 'List' contains this result//2:
r=t*3;                      //    Set the result to t multiplied by 3 instead
return r;}                      //  Return the result

(h[1,0]!!)
h l@(a:o)|elem(div a 2)o=a:h(3*a:l)|1>0=a:h(div a 2:l)

Try it online!

Uses 0-based indexing.

EDIT: saved 2 bytes by using elem instead of notElem and switching conditions

Ø.;0ị×3$:2$:2eɗ?Ɗ$⁸¡Ṫ Try it online! A monadic link that takes zero-indexed $$\n\$$ as the argument and returns $$\a(n)\$$. Ruby, 5452 48 bytes ->n{*s=0;j=2;n.times{s<<j=s==s-[j/2]?j/2:j*3};j} Try it online! C++ (gcc), 189 180 bytes -9 bytes to small golfing #import<vector> #import<algorithm> int a(int n){std::vector<int>s={1};for(int i=0;i<n;++i)s.push_back(i&&std::find(s.begin(),s.end(),s[i]/2)==s.end()?s[i]/2:3*s[i]);return s[n-1];} Try it online! Computes the sequence up to n, then returns the desired element. Slow for larger indices. • @ceilingcat Unfortunately that affects operator precedence and changes the output of the function. Apr 9 '19 at 23:13 Python 2, 66 bytes l=lambda n,p=1,s=:p*(n<len(s))or l(n,3*p*(p/2in s)or p/2,[p]+s) Try it online! Uses zero-based indexing. The lambda does little more than recursively building up the sequence and returning as soon as the required index is reached. Stax, 14 bytes üÑα↕○Ü1∟¡f↑ô┬♥ Run and debug it Zero-indexed. Wolfram Language (Mathematica), 63 bytes (L=Last)@Nest[{##,If[FreeQ[#,x=⌊L@#/2⌋],x,3L@#]}&,{0,1},#]& Try it online! This is 0-indexed (In TIO I added -1 in every test case) Haskell, 55 bytes (1%!!) a%o|b<-div a 2=a:last(b:[3*a|elem b o])%(a:o) Try it online! Same length: (1%!!) a%o=a:[x|x<-[div a 2,a*3],all(/=x)o]!!0%(a:o) Try it online! Python 2, 62 bytes a=lambda n:n<1or a(n-1)*6**(a(n-1)//2in+map(a,range(n)))//2 Try it online! Returns True for a(0). 0-indexed. Python 3, 10510310095 83 bytes -2 bytes thanks to agtoever -12 bytes thanks to ArBo def f(n): s=0,1 while len(s)<=n:t=s[-1]//2;s+=(t in s)*3*s[-1]or t, return s[-1] Try it online! • You can replace the for loop with while len(s)<=n and replace the i's with -1. This should shave off one of two characters. Apr 8 '19 at 12:14 • @agtoever that's so clever - thanks! :) Apr 8 '19 at 13:46 • 83 bytes by working with a tuple instead of a list, and removing the if from the while loop to allow one-lining that loop – ArBo Apr 8 '19 at 19:30 • @ArBo wow! absolutely brilliant - thanks :) Apr 8 '19 at 22:38 Gaia, 22 20 bytes 2…@⟨:):3×¤ḥ⌋,;D)+⟩ₓ) Try it online! 0-based index. Credit to Shaggy for the approach 2… | push [0 1] @⟨ ⟩ₓ | do the following n times: :): | dup the list L, take the last element e, and dup that 3×¤ḥ⌋, | push [3*e floor(e/2)] ;D | take the asymmetric set difference [3*e floor(e/2)] - L )+ | take the last element of the difference and add it to the end of L (end of loop) ) | finally, take the last element and output it ;D Husk, 18 bytes !t¡(→S-o§e*3÷2→)ŀ2 Try it online! Not sure why I'm unable to compose the iteration function, but I was only able to get it working with parentheses. +1 byte after fixing the list. • Nice to see that you’re having a take on all my CG challenges, but this one seems to go wrong. Using you tio link and giving 1234 as input, this gives 7074 instead of 3537... I’m not poficient in Husk, so I really have no clue where this goes wrong... Oct 30 '20 at 6:25 • @agtoever oh, there's a 0 at the beginning, just needed to remove that: Try it online! Oct 30 '20 at 6:27 • Yay! You fixed it! Oct 31 '20 at 11:25 Lua, 78 bytes x,y=1,3 u={}for _=2,...do u[x]=0 x,y=y,y//2 if u[y]then y=3*x end end print(x) Try it online! • 68 bytes through removing some whitespace, removing the z variable and changing the if statement to ternary – Jo King Apr 10 '19 at 12:50 Vyxal, 22 bytes 0⅛3?(:½⌊¾$ḟu=[½⌊|3*]:⅛

Try it Online!

1-indexed.

0⅛                     # Push 0 to glob. arr.
3                    # Push 3
?(                  # Iteration times
[     ]   # If...
:½⌊               # Top of stack, halved and floored
¾\$ḟu=          # Is in global array?
½⌊       # Halved and floored
|      # Else
3*    # Tripled
:⅛ # And pushed to glob. arr.