First perfect square in base n with n unique digits

From Rosetta Code
Revision as of 01:21, 22 May 2019 by rosettacode>Gerard Schildberger (→‎{{header|REXX}}: shortened the program.)
First perfect square in base n with n unique digits is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Find the first perfect square in a given base N that has at least N digits and exactly N significant unique digits when expressed in base N.

E.G. In base 10, the first perfect square with at least 10 unique digits is 1026753849 (32043²).

You may use analytical methods to reduce the search space, but the code must do a search. Do not use magic numbers or just feed the code the answer to verify it is correct.

Task
  • Find and display here, on this page, the first perfect square in base N, with N significant unique digits when expressed in base N, for each of base 2 through 12. Display each number in the base N for which it was calculated.
  • (optional) Do the same for bases 13 through 16.
  • (stretch goal) Continue on for bases 17 - ?? (Big Integer math)


F#

<lang fsharp> // Nigel Galloway: May 21st., 2019 let fN g=let g=int64(sqrt(float(pown g (int(g-1L)))))+1L in (Seq.unfold(fun(n,g)->Some(n,(n+g,g+2L))))(g*g,g*2L+1L) let fG n g=Array.unfold(fun n->if n=0L then None else let n,g=System.Math.DivRem(n,g) in Some(g,n)) n let fL g=let n=set[0L..g-1L] in Seq.find(fun x->set(fG x g)=n) (fN g) let toS n g=let a=Array.concat [[|'0'..'9'|];[|'a'..'f'|]] in System.String(Array.rev(fG n g)|>Array.map(fun n->a.[(int n)])) [2L..16L]|>List.iter(fun n->let g=fL n in printfn "Base %d: %s² -> %s" n (toS (int64(sqrt(float g))) n) (toS g n)) </lang>

Output:
Base 2: 10² -> 100
Base 3: 22² -> 2101
Base 4: 33² -> 3201
Base 5: 243² -> 132304
Base 6: 523² -> 452013
Base 7: 1431² -> 2450361
Base 8: 3344² -> 13675420
Base 9: 11642² -> 136802574
Base 10: 32043² -> 1026753849
Base 11: 111453² -> 1240a536789
Base 12: 3966b9² -> 124a7b538609
Base 13: 3828943² -> 10254773ca86b9
Base 14: 3a9db7c² -> 10269b8c57d3a4
Base 15: 1012b857² -> 102597bace836d4
Base 16: 404a9d9b² -> 1025648cfea37bd9

Go

<lang go>package main

import (

   "fmt"
   "math"
   "strconv"

)

const maxBase = 16 const minSq16 = "1023456789abcdef"

var found = make([]bool, maxBase) var blankFound = make([]bool, maxBase)

func containsAll(sq string, base int) bool {

   copy(found, blankFound)
   for _, r := range sq {
       if r < 58 {
           found[r-48] = true
       } else {
           found[r-87] = true
       }
   }
   for _, r := range found[:base] {
       if r == false {
           return false
       }
   }
   return true

}

func main() {

   for n, base := uint64(2), 2; ; n++ {
       sq := strconv.FormatUint(n*n, base)
       if !containsAll(sq, base) {
           continue
       }
       ns := strconv.FormatUint(n, base)
       fmt.Printf("Base %2d:%10s² = %s\n", base, ns, sq)
       if base == maxBase {
           return
       }
       base++
       minNN, _ := strconv.ParseUint(minSq16[:base], base, 64)
       if minNN > (n+1)*(n+1) {
           n = uint64(math.Sqrt(float64(minNN))) - 1
       }
   }

}</lang>

Output:
Base  2:        10² = 100
Base  3:        22² = 2101
Base  4:        33² = 3201
Base  5:       243² = 132304
Base  6:       523² = 452013
Base  7:      1431² = 2450361
Base  8:      3344² = 13675420
Base  9:     11642² = 136802574
Base 10:     32043² = 1026753849
Base 11:    111453² = 1240a536789
Base 12:    3966b9² = 124a7b538609
Base 13:   3828943² = 10254773ca86b9
Base 14:   3a9db7c² = 10269b8c57d3a4
Base 15:  1012b857² = 102597bace836d4
Base 16:  404a9d9b² = 1025648cfea37bd9

Julia

Runs in about 4 seconds with using occursin(). <lang julia>const num = "0123456789abcdef" hasallin(n, nums, b) = (s = string(n, base=b); all(x -> occursin(x, s), nums))

function squaresearch(base)

   basenumerals = [c for c in num[1:base]]
   highest = parse(Int, "10" * num[3:base], base=base)
   for n in Int(trunc(sqrt(highest))):highest
       if hasallin(n * n, basenumerals, base)
           return n
       end
   end

end

println("Base Root N") for b in 2:16

   n = squaresearch(b)
   println(lpad(b, 3), lpad(string(n, base=b), 10), "  ", string(n * n, base=b))

end

</lang>

Output:
Base     Root   N
  2        10  100
  3        22  2101
  4        33  3201
  5       243  132304
  6       523  452013
  7      1431  2450361
  8      3344  13675420
  9     11642  136802574
 10     32043  1026753849
 11    111453  1240a536789
 12    3966b9  124a7b538609
 13   3828943  10254773ca86b9
 14   3a9db7c  10269b8c57d3a4
 15  1012b857  102597bace836d4
 16  404a9d9b  1025648cfea37bd9

Perl

Library: ntheory

<lang perl>use strict; use warnings; use feature 'say'; use ntheory 'todigitstring'; use utf8; binmode('STDOUT', 'utf8');

sub first_square {

   my $n = shift;
   my $r = int( $n**( ($n - 1) / 2) ) || 1;
   my @digits = reverse split , substr('0123456789abcdef',0,$n);
   TRY: while (1) {
       my $sq = $r * $r;
       my $cnt = 0;
       my $s = todigitstring($sq, $n);
       my $i = scalar @digits;
       for (@digits) {
           $r++ and redo TRY if (-1 == index($s, $_)) || ($i-- + $cnt < $n);
           last if $cnt++ == $n;
       }
       return sprintf "Base %2d: %10s² == %s", $n, todigitstring($r, $n),
              todigitstring($sq, $n);
   }

}

say "First perfect square with N unique digits in base N: "; say first_square($_) for 2..16;</lang>

Output:
First perfect square with N unique digits in base N: 
Base  2:         10² == 100
Base  3:         22² == 2101
Base  4:         33² == 3201
Base  5:        243² == 132304
Base  6:        523² == 452013
Base  7:       1431² == 2450361
Base  8:       3344² == 13675420
Base  9:      11642² == 136802574
Base 10:      32043² == 1026753849
Base 11:     111453² == 1240a536789
Base 12:     3966b9² == 124a7b538609
Base 13:    3828943² == 10254773ca86b9
Base 14:    3a9db7c² == 10269b8c57d3a4
Base 15:   1012b857² == 102597bace836d4
Base 16:   404a9d9b² == 1025648cfea37bd9

Perl 6

Works with: Rakudo version 2019.03

<lang perl6># Only search perfect squares that have at least N digits;

  1. smaller could not possibly match.

sub first-square (Int $n) {

   my int $start = (($n - 1)/2).exp($n).floor || 2;
   my @digits = reverse (^$n)».base: $n;
   my $sq = ($start .. *).map( {.²} ).hyper.first: {
       my $s = .base: $n;
       my $f;
       $f = 1 and last unless $s.contains: $_ for @digits;
       next if $f;
       $_
   }
   sprintf "Base %2d: %10s² == %s", $n, $sq.sqrt.base($n), $sq.base($n);

}

say "First perfect square with N unique digits in base N: "; say .&first-square for flat

  2 .. 12, # required
 13 .. 16  # optional
</lang>
Output:
First perfect square with N unique digits in base N:
Base  2:         10² == 100
Base  3:         22² == 2101
Base  4:         33² == 3201
Base  5:        243² == 132304
Base  6:        523² == 452013
Base  7:       1431² == 2450361
Base  8:       3344² == 13675420
Base  9:      11642² == 136802574
Base 10:      32043² == 1026753849
Base 11:     111453² == 1240A536789
Base 12:     3966B9² == 124A7B538609
Base 13:    3828943² == 10254773CA86B9
Base 14:    3A9DB7C² == 10269B8C57D3A4
Base 15:   1012B857² == 102597BACE836D4
Base 16:   404A9D9B² == 1025648CFEA37BD9

Python

Works with: Python version 3.7

<lang python>Perfect squares using every digit in a given base.

from math import (ceil, sqrt)


  1. allDigitSquare :: Int -> Int

def allDigitSquare(base):

   The lowest perfect square which
      requires all digits in the given base.
   
   showBase = showAtBase(base)
   def p(x):
       return base == len(set(showBase(x * x)))
   return untilSucc(p)(
       ceil(sqrt(
           int('10' + '0123456789abcdef'[2:base], base)
       ))
   )


  1. TEST ----------------------------------------------------
  2. main :: IO ()

def main():

   Smallest perfect squares using all digits in bases 2-16
   print(main.__doc__ + ':\n\nBase      Root    Square')
   for b in enumFromTo(2)(16):
       q = allDigitSquare(b)
       print(
           str(b).rjust(2, ' ') + ' -> ' +
           showAtBase(b)(q).rjust(8, ' ') + ' -> ' +
           showAtBase(b)(q * q)
       )


  1. GENERIC -------------------------------------------------
  1. enumFromTo :: (Int, Int) -> [Int]

def enumFromTo(m):

   Integer enumeration from m to n.
   return lambda n: list(range(m, 1 + n))


  1. showAtBase :: Int -> Int -> String

def showAtBase(base):

   Representation of integer n in the given base.
      NB Compressed and stripped back just for this task,
      and depends on several parochial assumptions. For
      more general use, see the less partial variant below).
   
   def go(x):
       ds = '0123456789abcdef'
       xs = []
       while x:
           xs.append(ds[x % base])
           x //= base
       return .join(reversed(xs))
   return lambda n: go(n)


  1. showIntAtBase :: Int -> (Int -> String) -> Int -> String -> String

def showIntAtBase(base):

   String representation of an integer in a given base,
      using a supplied function for the string representation
      of digits.
   
   def wrap(toChr, n, rs):
       def go(nd, r):
           n, d = nd
           r_ = toChr(d) + r
           return go(divmod(n, base), r_) if 0 != n else r_
       return 'unsupported base' if 1 >= base else (
           'negative number' if 0 > n else (
               go(divmod(n, base), rs))
       )
   return lambda toChr: lambda n: lambda rs: (
       wrap(toChr, n, rs)
   )


  1. untilSucc :: (a -> Bool) -> a -> a

def untilSucc(p):

   The result of repeatedly testing succ(x) until p holds.
      The initial seed value is x.
   
   def go(x):
       v = x
       while not p(v):
           v = 1 + v
       return v
   return lambda x: go(x)


  1. MAIN ---

if __name__ == '__main__':

   main()</lang>
Output:
Smallest perfect squares using all digits in bases 2-16:

Base      Root    Square
 2 ->       10 -> 100
 3 ->       22 -> 2101
 4 ->       33 -> 3201
 5 ->      243 -> 132304
 6 ->      523 -> 452013
 7 ->     1431 -> 2450361
 8 ->     3344 -> 13675420
 9 ->    11642 -> 136802574
10 ->    32043 -> 1026753849
11 ->   111453 -> 1240a536789
12 ->   3966b9 -> 124a7b538609
13 ->  3828943 -> 10254773ca86b9
14 ->  3a9db7c -> 10269b8c57d3a4
15 -> 1012b857 -> 102597bace836d4
16 -> 404a9d9b -> 1025648cfea37bd9

REXX

The   REXX   language doesn't have a   sqrt   function,   nor does it have a general purpose radix (base) convertor,
so RYO versions were included here.

This REXX version can handle up to base 36. <lang rexx>/*REXX program finds/displays the first perfect square with N unique digits in base N.*/ numeric digits 40 /*ensure enough decimal digits for a #.*/ parse arg n . /*obtain optional argument from the CL.*/ if n== | n=="," then n= 16 /*not specified? Then use the default.*/ @start= 1023456789abcdefghijklmnopqrstuvwxyz /*contains the start # (up to base 36).*/

                          w= length(n)          /* [↓]  find the smallest square with  */
   do j=2  to n;          beg= left(@start, j)  /*      N  unique digits in base  N.   */
      do k=iSqrt( base(beg,,j) )  until #==0    /*start each search from smallest sqrt.*/
      $= base(k*k, j)                           /*calculate square, convert to base J. */
      $u= $;              upper $u              /*get an uppercase version fast count. */
      #= verify(beg, $u)                        /*count differences between 2 numbers. */
      end   /*k*/
   say 'base'  right(j,w)     "   root="   right(base(k,j),max(5,n))     '   square='   $
   end      /*j*/

exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ base: procedure; arg x,toB,inB /*obtain: three arguments, last 2 opt.*/

     @l= '0123456789abcdefghijklmnopqrstuvwxyz' /*lowercase (Latin or English) alphabet*/
     @u= @l;     upper @u                       /*uppercase    "    "    "         "   */
     if toB==  then toB= 10                   /*if skipped, assume the default (10). */
     if inB==  then inB= 10                   /* "    "        "    "     "      "   */
     #=0                                        /*result of converted  X  (in base 10).*/
        do j=1  for length(x)                   /*convert  X:   base inB  ──► base 10. */
        #= # * inB + pos(substr(x,j,1), @u) - 1 /*build a new number,  digit by digit. */
        end    /*j*/                            /* [↑]  this also verifies digits.     */
     y=                                         /*the value of  X  in base  B (so far).*/
        do  while  # >= toB                     /*convert #:    base 10  ──►  base toB.*/
        y= substr(@l, (# // toB) + 1, 1)y       /*construct the output number.         */
        #= # % toB                              /*      ··· and whittle  #  down also. */
        end    /*while*/                        /* [↑]  algorithm may leave a residual.*/
     return substr(@l, # + 1, 1)y               /*prepend the residual, if any.        */

/*──────────────────────────────────────────────────────────────────────────────────────*/ iSqrt: procedure; parse arg x; r=0; q=1; do while q<=x; q=q*4; end

       do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end; end; return r</lang>
output   when using the default input:
base  2    root=           10    square= 100
base  3    root=           22    square= 2101
base  4    root=           33    square= 3201
base  5    root=          243    square= 132304
base  6    root=          523    square= 452013
base  7    root=         1431    square= 2450361
base  8    root=         3344    square= 13675420
base  9    root=        11642    square= 136802574
base 10    root=        32043    square= 1026753849
base 11    root=       111453    square= 1240a536789
base 12    root=       3966b9    square= 124a7b538609
base 13    root=      3828943    square= 10254773ca86b9
base 14    root=      3a9db7c    square= 10269b8c57d3a4
base 15    root=     1012b857    square= 102597bace836d4
base 16    root=     404a9d9b    square= 1025648cfea37bd9