21
\$\begingroup\$

Given a positive integer number \$n\$ output its perfect radical.

Definition

A perfect radical \$r\$ of a positive integer \$n\$ is the lowest integer root of \$n\$ of any index \$i\$:

$$r = \sqrt[i]{n}$$

where \$r\$ is an integer.

In other words \$i\$ is the maximum exponent such that \$r\$ raised to \$i\$ is \$n\$:

$$n = r^i$$

This is OEIS A052410.

Special cases

For \$n = 1\$ we don't really care about the degree \$i\$ as we are asked to return \$r\$ in this challenge.

  • Just take \$r=1\$ for \$n=1\$.
  • Since there is an OEIS for this and it starts from 1 you don't have to handle \$n=0\$.

Note

A positive integer \$n\$ is expressed in the form \$100...000\$ if we convert it to base \$r\$ For example the perfect radical of \$128\$ is \$2\$ which is \$1000000\$ in base \$2\$, a \$1\$ followed by \$i -1\$ \$0\$s.

Input: a positive integer. You don't not have to handle inputs not supported by your language (obviously, abusing this is a standard loophole.)

Output: the perfect radical of that number.

You may instead choose to take a positive integer \$n\$ and output the radicals of the first \$n\$ positive integers, or to output the infinite list of radicals.

Test cases

This is a list of all numbers \$n \le 10000\$ where \$n \ne r\$ (expect for \$n = 1\$, included as an edge case, included also some cases where r==n for completeness sake ) :

[n, r]
[1, 1],
[2,2],
[3,3],
[4, 2],
[5,5],
[6,6],
[7,7],
[8, 2],
[9, 3],
[10,10],
[16, 2],
[25, 5],
[27, 3],
[32, 2],
[36, 6],
[49, 7],
[64, 2],
[81, 3],
[100, 10],
[121, 11],
[125, 5],
[128, 2],
[144, 12],
[169, 13],
[196, 14],
[216, 6],
[225, 15],
[243, 3],
[256, 2],
[289, 17],
[324, 18],
[343, 7],
[361, 19],
[400, 20],
[441, 21],
[484, 22],
[512, 2],
[529, 23],
[576, 24],
[625, 5],
[676, 26],
[729, 3],
[784, 28],
[841, 29],
[900, 30],
[961, 31],
[1000, 10],
[1024, 2],
[1089, 33],
[1156, 34],
[1225, 35],
[1296, 6],
[1331, 11],
[1369, 37],
[1444, 38],
[1521, 39],
[1600, 40],
[1681, 41],
[1728, 12],
[1764, 42],
[1849, 43],
[1936, 44],
[2025, 45],
[2048, 2],
[2116, 46],
[2187, 3],
[2197, 13],
[2209, 47],
[2304, 48],
[2401, 7],
[2500, 50],
[2601, 51],
[2704, 52],
[2744, 14],
[2809, 53],
[2916, 54],
[3025, 55],
[3125, 5],
[3136, 56],
[3249, 57],
[3364, 58],
[3375, 15],
[3481, 59],
[3600, 60],
[3721, 61],
[3844, 62],
[3969, 63],
[4096, 2],
[4225, 65],
[4356, 66],
[4489, 67],
[4624, 68],
[4761, 69],
[4900, 70],
[4913, 17],
[5041, 71],
[5184, 72],
[5329, 73],
[5476, 74],
[5625, 75],
[5776, 76],
[5832, 18],
[5929, 77],
[6084, 78],
[6241, 79],
[6400, 80],
[6561, 3],
[6724, 82],
[6859, 19],
[6889, 83],
[7056, 84],
[7225, 85],
[7396, 86],
[7569, 87],
[7744, 88],
[7776, 6],
[7921, 89],
[8000, 20],
[8100, 90],
[8192, 2],
[8281, 91],
[8464, 92],
[8649, 93],
[8836, 94],
[9025, 95],
[9216, 96],
[9261, 21],
[9409, 97],
[9604, 98],
[9801, 99],
[10000, 10]

Rules

  • Input/output can be given by any convenient method.
  • You can print it to STDOUT, return it as a function result or error message/s.
  • Either a full program or a function are acceptable.
  • Standard loopholes are forbidden.
  • This is so all usual golfing rules apply, and the shortest code (in bytes) wins.

Sandbox

\$\endgroup\$
9
  • 2
    \$\begingroup\$ I believe this is A052410 \$\endgroup\$
    – Giuseppe
    Dec 1 '20 at 21:36
  • 1
    \$\begingroup\$ Suggest adding \$0 \to 0\$ and \$1 \to 1\$ to the testcases. \$\endgroup\$
    – Noodle9
    Dec 1 '20 at 22:31
  • 1
    \$\begingroup\$ I have edited the question: since there is an OEIS and it starts from 1 you don't have to handle n=0, I'll add a test for n=1 \$\endgroup\$
    – AZTECCO
    Dec 1 '20 at 23:11
  • 3
    \$\begingroup\$ If we don't need to handle one it should say "positive" rather than "non-negative". \$\endgroup\$ Dec 2 '20 at 3:45
  • 2
    \$\begingroup\$ Suggest adding a test case where r == n \$\endgroup\$
    – Stef
    Dec 2 '20 at 9:20

27 Answers 27

10
\$\begingroup\$

J, 14 bytes

(%+./)&.(_&q:)

Try it online!

(%+./)&.(_&q:)
      &.(_&q:) number to prime exponents
(%+./)         divide them by their GCD
      &.(_&q:) prime exponents to number
\$\endgroup\$
1
  • \$\begingroup\$ Beautiful use of under. \$\endgroup\$
    – Jonah
    Dec 1 '20 at 23:22
8
\$\begingroup\$

Jelly, 10 bytes

ÆEgƒ0:@ƊÆẸ

Try it online!

ÆE:g/$ÆẸ errors given 1.

ÆE            Take the exponents of the input's prime factorization.
     :@Ɗ      Divide each exponent by
  gƒ0         the exponents' GCD (or 0 in the case that there are none).
        ÆẸ    Let the result be the exponents of the output's prime factorization.
\$\endgroup\$
3
  • 1
    \$\begingroup\$ Unfortunately, this errors for 1: Try it online! \$\endgroup\$ Dec 1 '20 at 23:27
  • 2
    \$\begingroup\$ As impressive as this answer is (and I‘ve dropped a +1 because it is a nice answer), I will never understand how an answer twice the length of mine got almost twice as many upvotes. Guess it‘ll stay a mystery \$\endgroup\$ Dec 6 '20 at 3:56
  • 1
    \$\begingroup\$ @cairdcoinheringaahing Indeed... \$\endgroup\$ Dec 6 '20 at 21:31
8
\$\begingroup\$

Brachylog, 6 bytes

1|~^hℕ

Try it online!

1|~^hℕ  with the implicit input n
1       input and output is 1
 |      or
  ~^    find two numbers [r, i] so that r^i = n
    h   return r
     ℕ  to limit the search space: r must be positive

Search tries lowest i first, so we get the maximum r for free.

\$\endgroup\$
4
  • \$\begingroup\$ I spent the last ten minutes trying to get this working with ... I have too little faith in CLP(FD)! \$\endgroup\$ Dec 1 '20 at 21:41
  • 1
    \$\begingroup\$ @UnrelatedString I had ℕᵐ≜h and a >. first, but just before posting tried deleting stuff in true codegolf fashion and it kept working. :-) \$\endgroup\$
    – xash
    Dec 1 '20 at 21:45
  • 1
    \$\begingroup\$ This outputs 0 for 1 (should output 1): Try it online! \$\endgroup\$ Dec 1 '20 at 23:30
  • 1
    \$\begingroup\$ @cairdcoinheringaahing Ah, I only checked 0 -> 0 earlier. Pesky special cases, increasing bytes by 50%. :-) Thanks! \$\endgroup\$
    – xash
    Dec 1 '20 at 23:45
8
\$\begingroup\$

Python 3, 55 \$\cdots\$ 59 57 bytes

Added 7 bytes to fix an error kindly pointed by user.
Saved 3 bytes thanks to user!!!

lambda n:{r**i:r for i in range(n)for r in range(n+1)}[n]

Try it online!

\$\endgroup\$
2
  • \$\begingroup\$ 59 bytes if you're fine with being wasteful \$\endgroup\$
    – rues
    Dec 1 '20 at 22:32
  • 4
    \$\begingroup\$ @user Wasteful's fine by me if it saves bytes - thanks! :D \$\endgroup\$
    – Noodle9
    Dec 1 '20 at 22:37
7
\$\begingroup\$

Husk, 8 bytes

VȯεΣ`B¹ḣ

Try it online!

V           # index of first truthy element of
 ȯ          # applying 3 functions to
       ḣ    # 1...input
    `B¹     # convert input to this base
   Σ        # sum of digits
  ε         # is at most 1
\$\endgroup\$
7
\$\begingroup\$

05AB1E, 8 11 8 bytes

-3 thanks to @ovs!

L¦BíCXkÌ

Try it online!

I am trying to somehow implement a log function to check whether a number matches the regex 10*, but that is too mathematical for me...

Wait, how?

L              # Push all numbers natural numbers up to input          [1, 2, 3 ... I]
 ¦             # What is that 1 doing there? Remove it!                [2, 3, 4 ... I]
  B            # Convert the input to each of the bases e.g input: 9   [1001, 100, 21...]
   í           # Reverse each string                                   [1001, 001, 12...]
    C          # Convert each from binary to decimal                   [9, 1, 4...]              (How though! Can someone explain?)
     Xk        # Get first index of 1                                  1
       Ì       # Add 2                                                 3
\$\endgroup\$
3
  • 3
    \$\begingroup\$ This hangs for input of 0 and returns 2 for input of 1. \$\endgroup\$
    – Giuseppe
    Dec 1 '20 at 22:44
  • 1
    \$\begingroup\$ i,} can be ≠i for -1. \$\endgroup\$ Dec 2 '20 at 9:30
  • 1
    \$\begingroup\$ i,}∞ can be L for -3 ;) (For n=1 Xk returns -1, and -1+2=1) \$\endgroup\$
    – ovs
    Dec 2 '20 at 10:36
6
\$\begingroup\$

Jelly, 8 6 5 bytes

bR§i1

Try it online!

Uses the fact that n in base r has the format 100...000, meaning that the sum of the digits only equals 1 in base r

-1 byte (indirectly) thanks to Dominic van Essen's answer, make sure to give them an upvote

How it works

bR§i1 - Main link. Takes n on the left
 R    - [1, 2, 3, ..., n]
b     - Convert n to each base 1, 2, 3, ..., n
  §   - Sum of the digits of each
   i1 - First index of 1
\$\endgroup\$
2
  • 1
    \$\begingroup\$ And here I thought nothing would come of the aside about base conversion! \$\endgroup\$ Dec 1 '20 at 21:20
  • 1
    \$\begingroup\$ @UnrelatedString I had the same thought, before remembering a trick from one of Jonathan Allan's old answers for checking numbers in the form 100...00 \$\endgroup\$ Dec 1 '20 at 21:22
6
\$\begingroup\$

k4, 26 24 21 18 bytes

-2 bytes by ignoring n=0 case

-3 bytes by applying @caird coinheringaahing's logic

-3 bytes by simplifying/combining operations

{(x{+/y\:x}'!x)?1}

Benefits from list ? value returning the count of the list if the value isn't present in it, and from convenient weirdness with the n=0 and n=1 edge cases.

\$\endgroup\$
5
\$\begingroup\$

Retina 0.8.2, 60 bytes

.+
$*
(?<=(?=((?=((1*)(?=\5\3+$)1)(\2*$))\4)*1$)^(..+)).*

1

Try it online! Link includes test cases. Explanation:

.+
$*

Convert to unary.

(?<=(?=...$)^(..+)).*

Delete the earliest suffix leaving behind the smallest prefix \$r\$ (captured into \5) such that the \$n\$ matches the following:

((?=((1*)(?=\5\3+$)1)(\2*$))\4)*1

Find \$k\$ \3 such that \$n-r\$ is divisible by \$k\$, but also \$n\$ is divisible by \$k+1\$ \2. Apparently this can only be satisfied by \$n=r(k+1)\$, but I can't find the answer where this is proved. \$(r-1)(k+1)\$ is then subtracted from \$n\$, resulting in \$k+1\$. This is then repeated until \$n\$ is reduced to \$1\$, which is matched at the end.

1

Convert to decimal.

\$\endgroup\$
5
\$\begingroup\$

R, 47 bytes

n=scan();match(n,sapply(0:n,"^",1:n))%/%n-(n<2)

Try it online!

Struggled for ages trying to beat Giuseppe's answer, only to be totally outgolfed (seconds before posting) by Robin Ryder's comment (now an answer)...

\$\endgroup\$
1
  • 1
    \$\begingroup\$ It's the journey that matters, not the byte count at the end. \$\endgroup\$
    – rues
    Dec 1 '20 at 23:37
5
\$\begingroup\$

R, 37 33 bytes

-4 bytes thanks to Dominic van Essen

match(T,!log(n<-scan(),1:n)%%1,1)

Try it online!

A different (and shorter) approach than the one used in Giuseppe's and Dominic van Essen's R answers.

Finds the first integer k such that log(n,k) is an integer, or returns 1 if there is no such k (which corresponds to the special case n=1).

\$\endgroup\$
5
\$\begingroup\$

JavaScript (ES7), 36 bytes

Recursively looks for the highest \$i\le n\$ such that \$k=n^{1/i}\$ is an integer. Then returns this \$k\$.

f=(n,i=n)=>(k=n**(1/i))%1?f(n,i-1):k

Try it online!


JavaScript (ES7), 37 bytes

A slightly longer version that performs more recursive calls but is not subject to rounding errors.

n=>(g=k=>k**i-n?g(k-1||i--|n):k)(i=n)

Try it online!

\$\endgroup\$
1
  • \$\begingroup\$ I like to read your answers too much. Using %1 to check being floating point is nice. \$\endgroup\$
    – snr
    Dec 4 '20 at 4:10
5
\$\begingroup\$

Python 3.8, 53 51 bytes (thanks @user for pointing out extra spaces)

def r(n):
    i=n
    while(a:=n**(1/i))%1:i-=1
    return a

Try it online!

\$\endgroup\$
4
  • 1
    \$\begingroup\$ Nice answer! You left a couple spaces in, so it's really 51 bytes. \$\endgroup\$
    – rues
    Dec 2 '20 at 19:51
  • \$\begingroup\$ @user Thanks! Took me some time to perfect it, and in the end, I forgot about removing the extra spaces \$\endgroup\$
    – nobody
    Dec 2 '20 at 19:53
  • \$\begingroup\$ It's a pity this isn't allowed \$\endgroup\$
    – rues
    Dec 2 '20 at 20:03
  • \$\begingroup\$ @user True, I spent some time trying to make something similar work, but I couldn't. \$\endgroup\$
    – nobody
    Dec 2 '20 at 20:08
4
\$\begingroup\$

R, 49 44 bytes

n=scan();which(outer(1:n,n:1,"^")==n,T)[1,1]

Try it online!

Thanks to Dominic van Essen for pointing out a bug.

n <- scan()				# read input
arr <- outer(0:n,1:n,"^")		# create the array of powers (0^(1:n), 1^(1:n), ... n^(1:n))
arr <- t(arr)				# transpose, so the array is ((0:n)^1, (0:n)^2, ... (0:n)^n)
ind <- which(arr==n,T)			# get 1-based array indices where arr == n. So they are a matirx of rows of [i+1,r+1] pairs, sorted in increasing order of r
ind[1,2]-1				# extract the appropriate r.
\$\endgroup\$
8
  • 1
    \$\begingroup\$ Nice, but what about 0 and 1? \$\endgroup\$ Dec 1 '20 at 21:38
  • \$\begingroup\$ @DominicvanEssen easily fixed by starting the second 0:n at 1 instead. \$\endgroup\$
    – Giuseppe
    Dec 1 '20 at 21:39
  • 1
    \$\begingroup\$ 37 bytes \$\endgroup\$ Dec 1 '20 at 23:21
  • 2
    \$\begingroup\$ @RobinRyder ...and, along the same lines, 33 bytes \$\endgroup\$ Dec 1 '20 at 23:34
  • 1
    \$\begingroup\$ @RobinRyder you should post that as your own! \$\endgroup\$
    – Giuseppe
    Dec 2 '20 at 0:11
4
\$\begingroup\$

Factor, 49 bytes

[ dup [1,b] 2dup '[ _ swap _ n^v member? ] find ]

Try it online!

Slow for larger inputs because it tries to evaluate a large power.

[
  dup [1,b] 2dup       ! ( n 1..n n 1..n )
  '[                   ! Put stack items in the `_`s in the quotation
    _(n) swap _(1..n)  !   ( elt -- n elt 1..n )
    n^v member?        !   Test if n appears in elt^(1..n)
  ] find               ! Find the first number in 1..n that satisfies the above
]
\$\endgroup\$
4
\$\begingroup\$

05AB1E, 6 bytes

Inspired by SunnyMoon's answer.

LÀ.ΔBR

Try it online!

L         # push the range [1, 2, ..., n]
 À        # rotate the 1 to the back: [2, 3, ..., n, 1]
  .Δ      # find the first integer where ...
    B     #   the input converted to that base
     R    #   reversed
          #   implicit: is equal to 1 as a number

05AB1E, 8 bytes

LÀ.Δ.n.ï

Try it online! There was a bug with , which has recently been fixed, but the interpreter on TIO is not up to date.

L         # push the range [1, 2, ..., n]
 À        # rotate the 1 to the back: [2, 3, ..., n, 1]
  .Δ      # find the first integer where ...
    .n    #   the logarithm of the input in that base
      .ï  #   is an integer
\$\endgroup\$
3
\$\begingroup\$

Japt -g, 10 bytes

I feel like I'm missing a trick here.

õ ï æ@¥Xrp

Try it

õ ï æ@¥Xrp     :Implicit input of integer U
õ              :Range [1,U]
  ï            :Cartesian product with itself
    æ          :Get first pair that returns true
     @         :When passed through the following function as X
      ¥        :  Test U for equality with
       Xr      :  X reduced by
         p     :    Exponentiation
               :Implicit output of first element of that pair
\$\endgroup\$
3
\$\begingroup\$

Stax, 10 bytes

┌Pèó~JRå▲ï

Run and debug it

Explanation

R{xs|E|+1=}j
R            range 1..n
 {        }j get first number i where:
  xs|E       input(x) in base i digits
      |+     summed
        1=   equals 1
\$\endgroup\$
3
\$\begingroup\$

05AB1E, 12 (10) bytes

ÓDā<Ør0š¿÷mP

Port of @UnrelatedString's Jelly answer.

The shouldn't be necessary, but unfortunately there is a bug in 05AB1E for ¿ with empty lists.

Try it online or verify all test cases.

Explanation:

Ó             # Get the prime exponents of the (implicit) input-integer
 D            # Duplicate this list of exponents
  ā           # Push a list in the range [1, length] (without popping the list itself)
   <          # Decrease each by one to make the range [0, length)
    Ø         # Get the n'th prime for each of these indices
     r        # Reverse the three lists on the stack
      0š      # Prepend a 0 (work-around for `¿` bug with empty lists)
        ¿     # Pop and get the greatest common divisor (gcd) of this list
         ÷    # Integer-divide all values in the list by this gcd
              # (we use integer-division due to another bug that isn't on TIO yet,
              #  as well as to get an integer output, instead of float)
          m   # Take the primes we created earlier to the power of these values
           P  # And take the product of that
              # (after which it is output implicitly)
\$\endgroup\$
3
\$\begingroup\$

C (gcc), 65 60 58 bytes

Saved 5 bytes thanks to Sisyphus!!!

p;i;r;f(n){for(r=0;r++<n;)for(p=i=1;i++<n;p*=r)n=p-n?n:r;}

Try it online!

\$\endgroup\$
2
  • \$\begingroup\$ You can write n=r instead of return r, if you don't mind some undefined behavior. \$\endgroup\$
    – Sisyphus
    Dec 2 '20 at 1:56
  • \$\begingroup\$ @Sisyphus I would normally avoid the dreaded UB like the plague, but if it'll save some bytes here: bring it on! Thanks! :D \$\endgroup\$
    – Noodle9
    Dec 2 '20 at 8:40
2
\$\begingroup\$

Octave, 33 bytes

@(n)[~,j]=find((t=1:n)'.^t'==n,1)

Try it online!

How it works

@(n)                               % anonymous function with input n
               (t=1:n)             % let t = [1, 2, ..., n] (row vector)
                       .^          % element-wise power with broadcast...
                      '            % of t transposed...
                         t         % raised to t. Gives n×n matrix of powers
                          '==n     % test each entry for equality with n
    [~,j]=find(               ,1)  % col index of the first true entry (in linear order)
\$\endgroup\$
2
\$\begingroup\$

Scala, 50 bytes

Back to 50 bytes because n=0 doesn't have to be handled anymore!

n=>1.to(n)find(r=>1.to(n)exists(n==math.pow(r,_)))

Try it online!

\$\endgroup\$
2
\$\begingroup\$

Wolfram Language (Mathematica), 36 bytes

#^Last[#<2||1/GCD@@FactorInteger@#]&

Try it online!

-11 bytes from @att

\$\endgroup\$
2
  • 1
    \$\begingroup\$ 40 bytes \$\endgroup\$
    – att
    Dec 2 '20 at 3:03
  • \$\begingroup\$ 36 \$\endgroup\$
    – att
    Dec 2 '20 at 7:38
2
\$\begingroup\$

Charcoal, 19 16 bytes

NθI⊕⌕Eθ⎇ιΣ↨θ⊕ιθ¹

Try it online! Link is to verbose version of code. Edit: Now back to a reformulation of my original answer. Works by converting n to each base 1..n and finding the first 1-indexed value with a digit sum of 1. Conveniently this automatically works for an input of 0 (the resulting list is empty, so the 1-indexed position is 0), so the only edge case is base 1 as Charcoal cannot convert to unary, but the digit sum is always n in base 1 anyway. Explanation:

Nθ                  Input `n` as a number
      θ             `n`
     E              Map over implicit range
        ι           Current value
       ⎇      θ     If zero then `n` else
          ↨θ        `n` converted to base
            ⊕ι      Incremented value
         Σ          Sum of digits
    ⌕          ¹    Find first occurrence of literal `1`
   ⊕                Increment (convert to 1-indexing)
  I                 Cast to string
                    Implicitly print
\$\endgroup\$
2
  • \$\begingroup\$ Since there is an OEIS , and it starts from 1 you don't have to handle n=0 \$\endgroup\$
    – AZTECCO
    Dec 1 '20 at 23:00
  • 1
    \$\begingroup\$ @AZTECCO As it happens my latest approach works for 0 without any special-casing! \$\endgroup\$
    – Neil
    Dec 3 '20 at 10:49
2
\$\begingroup\$

Perl 5 -p, 34 bytes

++$\until grep"@F"==$\**$_,1..$_}{

Try it online!

\$\endgroup\$
1
\$\begingroup\$

Python 3, 55 bytes

f=lambda n,r=1,i=1:r*(r**i==n)or f(n,r+(i>n),i>n or-~i)

Try it online!

My first golf in over a year! It's a bit longer than this answer, but doesn't use that nasty floating point. As many good code golf answers do, this hits the recursion limit pretty soon.

\$\endgroup\$
2
  • \$\begingroup\$ place f = lambda it is better to write` lambda` and put f= in the header. tio.run/… \$\endgroup\$
    – Danis
    Dec 23 '20 at 6:01
  • 2
    \$\begingroup\$ I don't think that's allowed in this case unfortunately, since I use f recursively in the program \$\endgroup\$
    – ArBo
    Dec 23 '20 at 9:22
1
\$\begingroup\$

Python 3, 74 bytes

lambda n,r=round:r(n**[1/i for i in range(1,n+1)if r(n**(1/i))**i==n][-1])

Try it online!

This solution is longer but faster than this answer

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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