Task — Largest square

Given a number base, derive the largest perfect square with no repeated digits and return it as a string. (For base>10, use ‘A’..‘Z’.)

Examples

Example 1:
    f(2)="1"
    f(4)="3201"
    f(10)="9814072356"
    f(12)="B8750A649321"

Analysis

A number base b is made up from a palette of b different digits - for example a base 4 number can only contain digits from the set 0, 1, 2 and 3. So the largest number base b with no repeated digits can't be more than b digits long and it comprises the digits b - 1, b -2 ... 0. For example, if b is 6, the largest number with no repeated digits is 543210. Generalising that, the number is:

$z += $_ * ($b ** $_) for (1 .. $b);

$z may not of course be a perfect square, but any number meeting the 'largest perfect square with no repeated digits' criterion must be no more than $z. So let's take the square root of $z and truncate it to an integer, $m. We can then scan downwards from $m to 1, checking each $m**2 to see if it has no repeating digits, and the first one that meets that test is our answer.

This works fine up to $b = 16 - except for $b = 13 which takes a very long time. Beyond that, Perl (or possibly my computer) cannot represent $z as an integer and while my algorithm still holds, converting the initial $m ** 2 to a string fails because it isn't held to sufficient precision. Fortunately Mohammad doesn't ask us to go that high.

#!/usr/bin/perl

# Peter Campbell Smith - 2022-01-24
# PWC 149 task 2

use v5.28;
use strict;
use warnings;
use utf8;

my ($i, $square, $string, $test, @tests, $largest, $start);

# bases to try
@tests = (2 .. 12);

for $test (@tests) {
    
    # get largest possible number in base $test with no repeating digits
    $largest = 0;
    for $i (1 .. $test - 1) {
        $largest += $i * $test ** $i;
    }
    
    # can't do this if $largest can't be represented as an integer
    if ($largest > ~1 + 1) {
        say qq[$test is too large];
        next;
    }
    
    # find the largest square <= $largest
    $start = int(sqrt($largest));
    
    # generate squares down from there
    for ($i = $start; $i > 0; $i--) {
        $square = $i * $i;
        $string = basify($square, $test);    # convert to required format (eg 123AB)
        last if no_repeats($string);         # the answer!
    }
    say qq[f($test) = $string = ] . basify($i, $test) . qq[ ** 2]
}

sub basify {   # ($integer, $base)

    my ($base, $digit, $digits, $integer, $result);
    
    # converts $integer to 123AB representation in base $base
    
    ($integer, $base) = @_;
    $digits = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    $result = '';
    
    # strip digits 1 at a time
    while ($integer) {
        $digit = $integer % $base;
        $integer = ($integer - $digit) / $base;
        $result = substr($digits, $digit, 1) . $result;
    }
    return $result;
}

sub no_repeats {   # ($string)

    my ($string, %seen);
    $string = $_[0];

    while ($string =~ m|(.)|g) {
        return 0 if $seen{$1};
        $seen{$1} = 1;
    }
    return 1;
}

Output

f(2) = 1 = 1 ** 2
f(3) = 1 = 1 ** 2
f(4) = 3201 = 33 ** 2
f(5) = 4301 = 44 ** 2
f(6) = 452013 = 523 ** 2
f(7) = 6250341 = 2346 ** 2
f(8) = 47302651 = 6215 ** 2
f(9) = 823146570 = 27773 ** 2
f(10) = 9814072356 = 99066 ** 2
f(11) = A8701245369 = 331413 ** 2
f(12) = B8750A649321 = BA3711 ** 2