Penholodigital squares
Penholodigital squares are perfect square numbers that contain all of the digits from the base in which the number is represented, except for zero, exactly once.
Penholodigital squares 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.
From the Latin prefix pene- (before, or next to, nearly)
and holo- (whole, or all)
So, in a particular base, a penholodigital square number will contain all of the digits used in that base (except zero) once, and only once. Base eight penholodigitals contain the digits 1 through 7, base 10, 1 through 9, etc.
- For example
In base 10, 139854276 is a penholodigital square. It is the square of the integer 11826, and contains every digit from 1 through 9 exactly once.
Penholodigital squares can occur in many, though not every, base. They tend to be pretty rare in lower bases.
There is a total of 1 penholodigital squares in base 2: 1² = 1 There is a total of 0 penholodigital squares in base 3: There is a total of 0 penholodigital squares in base 4: There is a total of 0 penholodigital squares in base 5: There is a total of 2 penholodigital squares in base 6: 122² = 15324, 221² = 53241 There is a total of 1 penholodigital squares in base 7: 645² = 623514 There is a total of 1 penholodigital squares in base 8: 2453² = 6532471
- Task
Find and display the total count, and the penholodigital squares and the integers that are squared to produce them, represented in the base in which they are calculated, for bases 9, 10, 11 and 12.
- Stretch
Find and display the total count, and the first and last penholodigital squares and the integers that are squared to produce them, represented in the base in which they are calculated, for bases 13, 14, 15, ... ?
- See also
Go
package main
import (
"fmt"
"math"
"rcu"
"strconv"
)
func reverse(s string) string {
r := make([]byte, len(s))
for i := 0; i < len(s); i++ {
r[i] = s[len(s)-1-i]
}
return string(r)
}
func main() {
primes := []int{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47}
digits := "123456789ABCDEF"
for b := 9; b <= 16; b++ {
master := 1
for d := 1; d < b; d++ {
master *= primes[d-1]
}
var phd []int
smin, _ := strconv.ParseInt(digits[0:b-1], b, 64)
min := int(math.Ceil(math.Sqrt(float64(smin))))
smax, _ := strconv.ParseInt(reverse(digits[0:b-1]), b, 64)
max := int(math.Floor(math.Sqrt(float64(smax))))
factors := rcu.PrimeFactors(b - 1)
div := factors[len(factors)-1]
for i := min; i <= max; i++ {
if (i % div) != 0 {
continue
}
sq := i * i
digs := rcu.Digits(sq, b)
containsZero := false
key := 1
for _, dig := range digs {
if dig == 0 {
containsZero = true
break
}
key *= primes[dig-1]
}
if containsZero {
continue
}
if key == master {
phd = append(phd, i)
}
}
fmt.Println("There is a total of", len(phd), "penholodigital squares in base", b, "\b:")
if b > 13 {
phd = []int{phd[0], phd[len(phd)-1]}
}
for i := 0; i < len(phd); i++ {
sq2 := phd[i] * phd[i]
fmt.Printf("%s² = %s ", strconv.FormatInt(int64(phd[i]), b), strconv.FormatInt(int64(sq2), b))
if (i+1)%3 == 0 {
fmt.Println()
}
}
if len(phd)%3 != 0 {
fmt.Println()
}
fmt.Println()
}
}
- Output:
There is a total of 10 penholodigital squares in base 9: 3825² = 16328547 3847² = 16523874 4617² = 23875614 4761² = 25487631 6561² = 47865231 6574² = 48162537 6844² = 53184267 7285² = 58624317 7821² = 68573241 8554² = 82314657 There is a total of 30 penholodigital squares in base 10: 11826² = 139854276 12363² = 152843769 12543² = 157326849 14676² = 215384976 15681² = 245893761 15963² = 254817369 18072² = 326597184 19023² = 361874529 19377² = 375468129 19569² = 382945761 19629² = 385297641 20316² = 412739856 22887² = 523814769 23019² = 529874361 23178² = 537219684 23439² = 549386721 24237² = 587432169 24276² = 589324176 24441² = 597362481 24807² = 615387249 25059² = 627953481 25572² = 653927184 25941² = 672935481 26409² = 697435281 26733² = 714653289 27129² = 735982641 27273² = 743816529 29034² = 842973156 29106² = 847159236 30384² = 923187456 There is a total of 20 penholodigital squares in base 11: 42045² = 165742a893 43152² = 173a652894 44926² = 18792a6453 47149² = 1a67395824 47257² = 1a76392485 52071² = 249a758631 54457² = 2719634a85 55979² = 286a795314 59597² = 314672a895 632a4² = 3671a89245 64069² = 376198a254 68335² = 41697528a3 71485² = 46928a7153 81196² = 5a79286413 83608² = 632a741859 86074² = 6713498a25 89468² = 7148563a29 91429² = 76315982a4 93319² = 795186a234 a3a39² = 983251a764 There is a total of 23 penholodigital squares in base 12: 117789² = 135b7482a69 16357b² = 23a5b976481 16762b² = 24ab5379861 16906b² = 25386749ba1 173434² = 26b859a3714 178278² = 2835ba17694 1a1993² = 34a8125b769 1a3595² = 354a279b681 1b0451² = 3824b7569a1 1b7545² = 3a5b2487961 2084a9² = 42a1583b769 235273² = 5287ba13469 2528b5² = 5b23a879641 25b564² = 62937b5a814 262174² = 63a8527b194 285a44² = 73b615a8294 29a977² = 7b9284a5361 2a7617² = 83ab5479261 2b0144² = 8617b35a294 307381² = 93825a67b41 310828² = 96528ab7314 319488² = 9ab65823714 319a37² = 9b2573468a1 There is a total of 0 penholodigital squares in base 13: There is a total of 160 penholodigital squares in base 14: 1129535² = 126a84d79c53b 3a03226² = db3962a7541c8 There is a total of 419 penholodigital squares in base 15: 4240c58² = 12378da5b6ec94 ee25e4a² = ed4c93285671ba There is a total of 740 penholodigital squares in base 16: 11156eb6² = 123da7f85bce964 3fd8f786² = fec81b69573da24
J
Implementation:
digch=: a.{~;48 97(+i.)&.>10 26
brep=: (digch {~ #.inv)&.>
penholod=: {{
F=: >.%:y#.D=:}.i.y
C=: <.%:y#.}:i.-y
ok=: (D */@e. y #.inv ])"0
(#~ok) *:F+i.1+C-F
}}
task=: {{
sq=. penholod y
hd=. ,:(#sq),&":' penholodigital squares in base ',":y
hd,(*#sq)#names (y brep sq),each '=',each(y brep %:sq),each<'²'
}}
stretch=: {{
sq=. penholod y
hd=. ,:(#sq),&":' penholodigital squares in base ',":y
hd,(*#sq)#names ({.,'...';{:) (y brep sq),each '=',each(y brep %:sq),each<'²'
}}
Task examples:
task 9
10 penholodigital squares in base 9
16328547=3825² 16523874=3847² 23875614=4617² 25487631=4761² 47865231=6561² 48162537=6574²
53184267=6844² 58624317=7285² 68573241=7821² 82314657=8554²
task 10
30 penholodigital squares in base 10
139854276=11826² 152843769=12363² 157326849=12543² 215384976=14676² 245893761=15681² 254817369=15963²
326597184=18072² 361874529=19023² 375468129=19377² 382945761=19569² 385297641=19629² 412739856=20316²
523814769=22887² 529874361=23019² 537219684=23178² 549386721=23439² 587432169=24237² 589324176=24276²
597362481=24441² 615387249=24807² 627953481=25059² 653927184=25572² 672935481=25941² 697435281=26409²
714653289=26733² 735982641=27129² 743816529=27273² 842973156=29034² 847159236=29106² 923187456=30384²
task 11
20 penholodigital squares in base 11
165742a893=42045² 173a652894=43152² 18792a6453=44926² 1a67395824=47149² 1a76392485=47257²
249a758631=52071² 2719634a85=54457² 286a795314=55979² 314672a895=59597² 3671a89245=632a4²
376198a254=64069² 41697528a3=68335² 46928a7153=71485² 5a79286413=81196² 632a741859=83608²
6713498a25=86074² 7148563a29=89468² 76315982a4=91429² 795186a234=93319² 983251a764=a3a39²
task 12
23 penholodigital squares in base 12
135b7482a69=117789² 23a5b976481=16357b² 24ab5379861=16762b² 25386749ba1=16906b² 26b859a3714=173434²
2835ba17694=178278² 34a8125b769=1a1993² 354a279b681=1a3595² 3824b7569a1=1b0451² 3a5b2487961=1b7545²
42a1583b769=2084a9² 5287ba13469=235273² 5b23a879641=2528b5² 62937b5a814=25b564² 63a8527b194=262174²
73b615a8294=285a44² 7b9284a5361=29a977² 83ab5479261=2a7617² 8617b35a294=2b0144² 93825a67b41=307381²
96528ab7314=310828² 9ab65823714=319488² 9b2573468a1=319a37²
stretch 13
0 penholodigital squares in base 13
stretch 14
160 penholodigital squares in base 14
126a84d79c53b=1129535² ...
db3962a7541c8=3a03226²
stretch 15
419 penholodigital squares in base 15
12378da5b6ec94=4240c58² ...
ed4c93285671ba=ee25e4a²
stretch 16
740 penholodigital squares in base 16
123da7f85bce964=11156eb6² ...
fec81b69573da24=3fd8f786²
NB. this is getting to be obnoxiously long in terms of time...
jq
Adapted from Python
Also works with gojq, the Go implementation of jq, and with fq
Note that the definition of `_nwise/1` may be omitted if using jq.
General Utilities
# This def may be omitted if using jq
def _nwise($n):
def nw: if length <= $n then . else .[0:$n] , (.[$n:] | nw) end;
nw;
# Evaluate SIGMA $x^k * $p[k] for k=0...
def evalpoly($x; $p):
reduce range(0;p|length) as $i ({power: 1, sum:0};
.sum += .power * $p[$i]
| .power *= $x)
| .sum;
# Convert the input integer to a string in the specified base (2 to 36 inclusive)
def convert(base):
def stream:
recurse(if . >= base then ./base|floor else empty end) | . % base ;
[stream] | reverse
| if base < 10 then map(tostring) | join("")
elif base <= 36 then map(if . < 10 then 48 + . else . + 87 end) | implode
else error("base too large")
end
end;
# If $j is 0, then an error condition is raised;
# otherwise, assuming infinite-precision integer arithmetic,
# if the input and $j are integers, then the result will be an integer.
def idivide($j):
. as $i
| ($i % $j) as $mod
| ($i - $mod) / $j ;
# input should be a non-negative integer for accuracy
# but may be any non-negative finite number
def isqrt:
def irt:
. as $x
| 1 | until(. > $x; . * 4) as $q
| {$q, $x, r: 0}
| until( .q <= 1;
.q |= idivide(4)
| .t = .x - .r - .q
| .r |= idivide(2)
| if .t >= 0
then .x = .t
| .r += .q
else .
end)
| .r ;
if type == "number" and (isinfinite|not) and (isnan|not) and . >= 0
then irt
else "isqrt requires a non-negative integer for accuracy" | error
end ;
# Input: an integer base 10
# Output: an array of the digits (characters) if . were printed in base $base
def digits($base):
convert($base) | tostring | [explode[] | [.] | implode];The Task
# emit an array of [$n,$sq] values where $n is a penholodigital square in the given base
# and $n and $sq are integers expressed in that base
def penholodigital($base):
{ hi: (evalpoly($base; [range(1;$base)])|isqrt),
lo: (evalpoly($base; [range(base-1; 0; -1)]) | isqrt) # evalpoly(base, base-1:-1:1)
}
| reduce range(.lo; .hi+1) as $n (null;
($n * $n) as $sq
| ($sq | digits($base)) as $digits
| if "0" | IN($digits[]) then .
elif (($digits | length) == $base - 1) and (($digits | unique | length) == $base-1)
then . + [[($n | convert(base)), ($sq | convert(base))]]
else .
end );
def task(a;b):
range(a;b) as $base
| penholodigital($base)
| "\n\nThere are \(length) penholodigital squares in base \($base):",
(_nwise(3)
| map("\(.[0])² = \(.[1])" )
| join(" "));
task(9;13)- Output:
There are 10 penholodigital squares in base 9: 3825² = 16328547 3847² = 16523874 4617² = 23875614 4761² = 25487631 6561² = 47865231 6574² = 48162537 6844² = 53184267 7285² = 58624317 7821² = 68573241 8554² = 82314657 There are 30 penholodigital squares in base 10: 11826² = 139854276 12363² = 152843769 12543² = 157326849 14676² = 215384976 15681² = 245893761 15963² = 254817369 18072² = 326597184 19023² = 361874529 19377² = 375468129 19569² = 382945761 19629² = 385297641 20316² = 412739856 22887² = 523814769 23019² = 529874361 23178² = 537219684 23439² = 549386721 24237² = 587432169 24276² = 589324176 24441² = 597362481 24807² = 615387249 25059² = 627953481 25572² = 653927184 25941² = 672935481 26409² = 697435281 26733² = 714653289 27129² = 735982641 27273² = 743816529 29034² = 842973156 29106² = 847159236 30384² = 923187456 There are 20 penholodigital squares in base 11: 42045² = 165742a893 43152² = 173a652894 44926² = 18792a6453 47149² = 1a67395824 47257² = 1a76392485 52071² = 249a758631 54457² = 2719634a85 55979² = 286a795314 59597² = 314672a895 632a4² = 3671a89245 64069² = 376198a254 68335² = 41697528a3 71485² = 46928a7153 81196² = 5a79286413 83608² = 632a741859 86074² = 6713498a25 89468² = 7148563a29 91429² = 76315982a4 93319² = 795186a234 a3a39² = 983251a764 There are 23 penholodigital squares in base 12: 117789² = 135b7482a69 16357b² = 23a5b976481 16762b² = 24ab5379861 16906b² = 25386749ba1 173434² = 26b859a3714 178278² = 2835ba17694 1a1993² = 34a8125b769 1a3595² = 354a279b681 1b0451² = 3824b7569a1 1b7545² = 3a5b2487961 2084a9² = 42a1583b769 235273² = 5287ba13469 2528b5² = 5b23a879641 25b564² = 62937b5a814 262174² = 63a8527b194 285a44² = 73b615a8294 29a977² = 7b9284a5361 2a7617² = 83ab5479261 2b0144² = 8617b35a294 307381² = 93825a67b41 310828² = 96528ab7314 319488² = 9ab65823714 319a37² = 9b2573468a1
Julia
""" rosettacode.org task Penholodigital_squares """
function penholodigital(base)
penholodigitals = Int[]
hi, lo = isqrt(evalpoly(base, 1:base-1)), isqrt(evalpoly(base, base-1:-1:1))
for n in lo:hi
dig = digits(n * n; base)
0 in dig && continue
if all(i -> count(==(i), dig) == 1, 1:base-1)
push!(penholodigitals, n * n)
end
end
return penholodigitals
end
for j in 9:16
allpen = penholodigital(j)
println("\n\nThere is a total of $(length(allpen)) penholodigital squares in base $j:")
for (i, n) in (j < 14 ? enumerate(allpen) : enumerate([allpen[begin], allpen[end]]))
print(string(isqrt(n), base=j), "² = ", string(n, base=j), i %3 == 0 ? "\n" : " ")
end
end
- Output:
There is a total of 10 penholodigital squares in base 9: 3825² = 16328547 3847² = 16523874 4617² = 23875614 4761² = 25487631 6561² = 47865231 6574² = 48162537 6844² = 53184267 7285² = 58624317 7821² = 68573241 8554² = 82314657 There is a total of 30 penholodigital squares in base 10: 11826² = 139854276 12363² = 152843769 12543² = 157326849 14676² = 215384976 15681² = 245893761 15963² = 254817369 18072² = 326597184 19023² = 361874529 19377² = 375468129 19569² = 382945761 19629² = 385297641 20316² = 412739856 22887² = 523814769 23019² = 529874361 23178² = 537219684 23439² = 549386721 24237² = 587432169 24276² = 589324176 24441² = 597362481 24807² = 615387249 25059² = 627953481 25572² = 653927184 25941² = 672935481 26409² = 697435281 26733² = 714653289 27129² = 735982641 27273² = 743816529 29034² = 842973156 29106² = 847159236 30384² = 923187456 There is a total of 20 penholodigital squares in base 11: 42045² = 165742a893 43152² = 173a652894 44926² = 18792a6453 47149² = 1a67395824 47257² = 1a76392485 52071² = 249a758631 54457² = 2719634a85 55979² = 286a795314 59597² = 314672a895 632a4² = 3671a89245 64069² = 376198a254 68335² = 41697528a3 71485² = 46928a7153 81196² = 5a79286413 83608² = 632a741859 86074² = 6713498a25 89468² = 7148563a29 91429² = 76315982a4 93319² = 795186a234 a3a39² = 983251a764 There is a total of 23 penholodigital squares in base 12: 117789² = 135b7482a69 16357b² = 23a5b976481 16762b² = 24ab5379861 16906b² = 25386749ba1 173434² = 26b859a3714 178278² = 2835ba17694 1a1993² = 34a8125b769 1a3595² = 354a279b681 1b0451² = 3824b7569a1 1b7545² = 3a5b2487961 2084a9² = 42a1583b769 235273² = 5287ba13469 2528b5² = 5b23a879641 25b564² = 62937b5a814 262174² = 63a8527b194 285a44² = 73b615a8294 29a977² = 7b9284a5361 2a7617² = 83ab5479261 2b0144² = 8617b35a294 307381² = 93825a67b41 310828² = 96528ab7314 319488² = 9ab65823714 319a37² = 9b2573468a1 There is a total of 0 penholodigital squares in base 13: There is a total of 160 penholodigital squares in base 14: 1129535² = 126a84d79c53b 3a03226² = db3962a7541c8 There is a total of 419 penholodigital squares in base 15: 4240c58² = 12378da5b6ec94 ee25e4a² = ed4c93285671ba There is a total of 740 penholodigital squares in base 16: 11156eb6² = 123da7f85bce964 3fd8f786² = fec81b69573da24
Extended version
Theoretically, the program should be able to handle bases up to 30, but in practice that would take it far too long.
function penholodigital(base)
penholodigitals = [typeof(base)[] for _ in 1:Threads.nthreads()]
digitbuf = [zeros(typeof(base), base-1) for _ in 1:Threads.nthreads()]
hi, lo = isqrt(evalpoly(base, 1:base-1)), isqrt(evalpoly(base, base-1:-1:1))
@Threads.threads for n in lo:hi
dig = digitbuf[Threads.threadid()]
digits!(dig, n * n; base)
0 in dig && continue
if all(i -> count(==(i), dig) == 1, 1:base-1)
push!(penholodigitals[Threads.threadid()], n * n)
end
end
return sort!(vcat(penholodigitals...))
end
for j in 9:19
@time begin
allpen = penholodigital(j < 17 ? j : Int128(j))
println("There are a total of $(length(allpen)) penholodigital squares in base $j:")
if length(allpen) > 0
for (i, n) in (j < 14 ? enumerate(allpen) : enumerate([allpen[begin], allpen[end]]))
print(string(isqrt(n), base=j), "² = ", string(n, base=j), i %3 == 0 ? "\n" : " ")
end
end
end
println("\n")
end- Output:
There are a total of 10 penholodigital squares in base 9: 3825² = 16328547 3847² = 16523874 4617² = 23875614 4761² = 25487631 6561² = 47865231 6574² = 48162537 6844² = 53184267 7285² = 58624317 7821² = 68573241 8554² = 82314657 0.180057 seconds (213.67 k allocations: 10.895 MiB, 98.16% compilation time) There are a total of 30 penholodigital squares in base 10: 11826² = 139854276 12363² = 152843769 12543² = 157326849 14676² = 215384976 15681² = 245893761 15963² = 254817369 18072² = 326597184 19023² = 361874529 19377² = 375468129 19569² = 382945761 19629² = 385297641 20316² = 412739856 22887² = 523814769 23019² = 529874361 23178² = 537219684 23439² = 549386721 24237² = 587432169 24276² = 589324176 24441² = 597362481 24807² = 615387249 25059² = 627953481 25572² = 653927184 25941² = 672935481 26409² = 697435281 26733² = 714653289 27129² = 735982641 27273² = 743816529 29034² = 842973156 29106² = 847159236 30384² = 923187456 0.008105 seconds (770 allocations: 28.117 KiB) There are a total of 20 penholodigital squares in base 11: 42045² = 165742a893 43152² = 173a652894 44926² = 18792a6453 47149² = 1a67395824 47257² = 1a76392485 52071² = 249a758631 54457² = 2719634a85 55979² = 286a795314 59597² = 314672a895 632a4² = 3671a89245 64069² = 376198a254 68335² = 41697528a3 71485² = 46928a7153 81196² = 5a79286413 83608² = 632a741859 86074² = 6713498a25 89468² = 7148563a29 91429² = 76315982a4 93319² = 795186a234 a3a39² = 983251a764 0.008614 seconds (538 allocations: 21.164 KiB) There are a total of 23 penholodigital squares in base 12: 117789² = 135b7482a69 16357b² = 23a5b976481 16762b² = 24ab5379861 16906b² = 25386749ba1 173434² = 26b859a3714 178278² = 2835ba17694 1a1993² = 34a8125b769 1a3595² = 354a279b681 1b0451² = 3824b7569a1 1b7545² = 3a5b2487961 2084a9² = 42a1583b769 235273² = 5287ba13469 2528b5² = 5b23a879641 25b564² = 62937b5a814 262174² = 63a8527b194 285a44² = 73b615a8294 29a977² = 7b9284a5361 2a7617² = 83ab5479261 2b0144² = 8617b35a294 307381² = 93825a67b41 310828² = 96528ab7314 319488² = 9ab65823714 319a37² = 9b2573468a1 0.021154 seconds (606 allocations: 23.141 KiB) There are a total of 0 penholodigital squares in base 13: 0.093971 seconds (67 allocations: 6.148 KiB) There are a total of 160 penholodigital squares in base 14: 1129535² = 126a84d79c53b 3a03226² = db3962a7541c8 0.678507 seconds (148 allocations: 12.523 KiB, 0.55% compilation time) There are a total of 419 penholodigital squares in base 15: 4240c58² = 12378da5b6ec94 ee25e4a² = ed4c93285671ba 4.194926 seconds (137 allocations: 22.289 KiB) There are a total of 740 penholodigital squares in base 16: 11156eb6² = 123da7f85bce964 3fd8f786² = fec81b69573da24 10.843582 seconds (137 allocations: 24.789 KiB) There are a total of 0 penholodigital squares in base 17: 345.116100 seconds (335.36 k allocations: 17.403 MiB, 0.08% compilation time) There are a total of 5116 penholodigital squares in base 18: 11150fc0g² = 123cd8abh5g79f6e4 44422dd18² = hgef25738d496bc1a 2584.183274 seconds (332.23 k allocations: 17.565 MiB, 0.00% gc time, 0.01% compilation time) There are a total of 47677 penholodigital squares in base 19: 4b802235a² = 1234978cibd6gfhea5 ii844bia2² = ihg8f71c6da59be324 20734.916185 seconds (169 allocations: 2.163 MiB)
Pascal
Free Pascal
Nearly copy and paste of pandigital square numbers.
Now using the right step size and startvalue
I think base 16 is the limit. 1234...FG is to big for Uint64. GMP/ MPinteger is required.
program penholodigital;
//Find the smallest number n to base b, so that n*n includes all
//digits of base b without 0
{$IFDEF FPC}{$MODE DELPHI}{$Optimization ON,All}{$ENDIF}
{$IFDEF Windows}{$APPTYPE CONSOLE}{$ENDIF}
{$DEFINE TIORUN}
uses
sysutils;
const
charSet : array[0..36] of char ='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
type
tNumtoBase = record
ntb_dgt : array[0..31-8] of byte;
ntb_cnt,
ntb_bas : Int32;
end;
var
dgtSqrRoot : array[0..31-8] of byte;
sl : array of string;
s2Delta : array of Uint32;
Num,
sqr2B,
deltaSqrNum : tNumtoBase;
procedure Conv2num(var num:tNumtoBase;n:Uint64;base:NativeUint);
var
quot :UInt64;
i :NativeUint;
Begin
i := 0;
repeat
quot := n div base;
Num.ntb_dgt[i] := n-quot*base;
n := quot;
inc(i);
until n = 0;
Num.ntb_cnt := i;
Num.ntb_bas := base;
//clear upper digits
For i := i to high(tNumtoBase.ntb_dgt) do
Num.ntb_dgt[i] := 0;
end;
function OutNum(const num:tNumtoBase):AnsiString;
var
i,j : NativeInt;
Begin
with num do
Begin
setlength(result,ntb_cnt);
j := 1;
For i := ntb_cnt-1 downto 0 do
Begin
result[j] := charSet[ntb_dgt[i]];
inc(j);
end;
end;
end;
procedure InsertSolution(i,penHoloCnt : NativeInt);
begin
sl[penHoloCnt] := Format('%s^2 = %s',[OutNum(Num),OutNum(sqr2B)]);
s2delta[penHoloCnt] := i;
{$IFNDEF TIORUN}
//a little action in the terminal
write(penHoloCnt:8,i :10,' ',sl[penHoloCnt],#13);
IF penHoloCnt= 0 then
writeln;
{$ENDIF}
end;
procedure IncNumBig(var add1:tNumtoBase;n:NativeUInt);
//prerequisites
//bases are the same,delta : NativeUint
var
i,s,b,carry : NativeInt;
Begin
b := add1.ntb_bas;
i := 0;
carry := 0;
while n > 0 do
Begin
s := add1.ntb_dgt[i]+carry+ n MOD b;
carry := Ord(s>=b);
s := s- (-carry AND b);
add1.ntb_dgt[i] := s;
n := n div b;
inc(i);
end;
while carry <> 0 do
Begin
s := add1.ntb_dgt[i]+carry;
carry := Ord(s>=b);
s := s- (-carry AND b);
add1.ntb_dgt[i] := s;
inc(i);
end;
IF add1.ntb_cnt < i then
add1.ntb_cnt := i;
end;
procedure IncNum(var add1:tNumtoBase;carry:NativeInt);
//prerequisites: bases are the same, carry==delta < base
var
i,s,b : NativeInt;
Begin
b := add1.ntb_bas;
i := 0;
while carry <> 0 do
Begin
s := add1.ntb_dgt[i]+carry;
carry := Ord(s>=b);
s := s- (-carry AND b);
add1.ntb_dgt[i] := s;
inc(i);
end;
IF add1.ntb_cnt < i then
add1.ntb_cnt := i;
end;
procedure AddNum(var add1,add2:tNumtoBase);
//prerequisites
//bases are the same,add1>add2, add1 <= add1+add2;
var
i,carry,s,b : NativeInt;
Begin
b := add1.ntb_bas;
carry := 0;
For i := 0 to add2.ntb_cnt-1 do
begin
s := add1.ntb_dgt[i]+add2.ntb_dgt[i]+carry;
carry := Ord(s>=b);
s := s- (-carry AND b);
add1.ntb_dgt[i] := s;
end;
i := add2.ntb_cnt;
while carry = 1 do
Begin
s := add1.ntb_dgt[i]+carry;
carry := Ord(s>=b);
// remove of if s>b then by bit-twiddling
s := s- (-carry AND b);
add1.ntb_dgt[i] := s;
inc(i);
end;
IF add1.ntb_cnt < i then
add1.ntb_cnt := i;
end;
procedure Test(base:NativeUInt);
var
n,penHoloCnt : Uint64;
b1,i,j,TestSet,CheckSet,dgtRoot,step,dNum : NativeInt;
Begin
penHoloCnt := 0;
b1 := Base-1;
dgtRoot := ((Base*b1) DIV 2) MOD b1;
For j := 1 to b1 do
dgtSqrRoot[j] := (j*j) MOD b1;
// square number containing 1,2..,base-1
// now estimate root for 1234..Base-1
// if base is even then root = 111...1 in Base
// if base is odd then root = sqrt(base)*(111...1) in Base
n := 0;
For j := Base DIV 2 downto 1 do
n := n*base+1;
if ODD(BASE) then
n := trunc(n*Sqrt(base));
// increment n til it fits (n*n) MOD b1 = dgtroot
j := B1;
repeat
if sqr(n MOD b1) MOD b1 = dgtroot then
BREAK;
inc(n);
dec(j);
until j = 0;
//calc nxn
Conv2num(Num,n,base);
deltaSqrNum := Num;
Conv2num(sqr2B,0,base);
j := 1;
repeat
if j AND n <> 0 then
AddNum(sqr2B,deltaSqrNum);
AddNum(deltaSqrNum,deltaSqrNum);
j +=j;
until j > n;
// calc step size i
i := 0;
For j := 1 to Base-1 do
if dgtSqrRoot[j] = dgtRoot then
inc(i);
// if i stays 0 than an extra digit will be needed -> no penholodigital
if i <> 0 then
Begin
step := b1 DIV i;
Writeln('Step size ',step,' decimal : ',n,' in base: ',OutNum(Num),' ',OutNum(sqr2B));
// calc delta of square numbers for incremnt n by step
Conv2num(deltaSqrNum,2*step*n,base);
IncNumBig(deltaSqrNum,step*step);
dNum := 2*step*step;
//all digits without 0
CheckSet := 0;
For j := b1 downto 1 do
CheckSet := CheckSet OR (1 shl j);
i := 0;
repeat
//count used digits
TestSet := 0;
For j := sqr2B.ntb_cnt-1 downto 0 do
TestSet := TestSet OR (1 shl sqr2B.ntb_dgt[j]);
IF CheckSet=TestSet then
Begin
//now correct number
IncNumBig(num,i*step);
InsertSolution(i,penHoloCnt);
inc(penHoloCnt);
i := 0;
end;
//next square number
AddNum(sqr2B,deltaSqrNum);
IncNumBig(deltaSqrNum,dNum);// dnum mostly base
inc(i);
until sqr2B.ntb_cnt >= base;
end;
if i = 0 then
Begin
Writeln('Penholodigital squares in base: ',base:2,' are not possible');
writeln;
EXIT;
end
else
Writeln('There are a total of ',penHoloCnt,' penholodigital squares in base: ',base:2);
if (penHoloCnt > 0) AND (base < 11) then
begin
j := 0;
while penHoloCnt-j > 3 do
begin
writeln(sl[j],',',sl[j+1],',',sl[j+2]);
inc(j,3);
end;
write(sl[j]);
For j := j+1 to penHoloCnt-1 do
write(',',sl[j]);
writeln;
end
else
if penHoloCnt > 1 then
begin
writeln(sl[0],',',sl[penHoloCnt-1]);
end;
writeln;
end;
var
T0: TDateTime;
base :nativeInt;
begin
T0 := now;
setlength(sl,51160);
setlength(s2Delta,51160);
For base := 19 to 19 do
Test(base);
writeln('Total runtime in s ',(now-T0)*86400:10:3);
{$IFDEF WINDOWS}readln;{$ENDIF}
end.
- @TIO.RUN:
Step size 1 decimal : 1 in base: 1 1 There are a total of 1 penholodigital squares in base: 2 1^2 = 1 Step size 2 decimal : 1 in base: 1 1 There are a total of 0 penholodigital squares in base: 3 Step size 3 decimal : 6 in base: 12 210 There are a total of 0 penholodigital squares in base: 4 Penholodigital squares in base: 5 are not possible Step size 5 decimal : 45 in base: 113 13213 There are a total of 2 penholodigital squares in base: 6 122^2 = 15324,221^2 = 53241 Step size 6 decimal : 153 in base: 306 125151 There are a total of 1 penholodigital squares in base: 7 645^2 = 623514 Step size 7 decimal : 588 in base: 1114 1243220 There are a total of 1 penholodigital squares in base: 8 2453^2 = 6532471 Step size 4 decimal : 2462 in base: 3335 12357657 There are a total of 10 penholodigital squares in base: 9 3825^2 = 16328547,3847^2 = 16523874,4617^2 = 23875614 4761^2 = 25487631,6561^2 = 47865231,6574^2 = 48162537 6844^2 = 53184267,7285^2 = 58624317,7821^2 = 68573241 8554^2 = 82314657 Step size 3 decimal : 11112 in base: 11112 123476544 There are a total of 30 penholodigital squares in base: 10 11826^2 = 139854276,12363^2 = 152843769,12543^2 = 157326849 14676^2 = 215384976,15681^2 = 245893761,15963^2 = 254817369 18072^2 = 326597184,19023^2 = 361874529,19377^2 = 375468129 19569^2 = 382945761,19629^2 = 385297641,20316^2 = 412739856 22887^2 = 523814769,23019^2 = 529874361,23178^2 = 537219684 23439^2 = 549386721,24237^2 = 587432169,24276^2 = 589324176 24441^2 = 597362481,24807^2 = 615387249,25059^2 = 627953481 25572^2 = 653927184,25941^2 = 672935481,26409^2 = 697435281 26733^2 = 714653289,27129^2 = 735982641,27273^2 = 743816529 29034^2 = 842973156,29106^2 = 847159236,30384^2 = 923187456 Step size 10 decimal : 53415 in base: 3714A 1234599011 There are a total of 20 penholodigital squares in base: 11 42045^2 = 165742A893,A3A39^2 = 983251A764 Step size 11 decimal : 271458 in base: 111116 12346543230 There are a total of 23 penholodigital squares in base: 12 117789^2 = 135B7482A69,319A37^2 = 9B2573468A1 Penholodigital squares in base: 13 are not possible Step size 13 decimal : 8108737 in base: 1111117 1234576543237 There are a total of 160 penholodigital squares in base: 14 1129535^2 = 126A84D79C53B,3A03226^2 = DB3962A7541C8 Step size 14 decimal : 47266835 in base: 4239EC5 123456E806A71A There are a total of 419 penholodigital squares in base: 15 4240C58^2 = 12378DA5B6EC94,EE25E4A^2 = ED4C93285671BA Step size 15 decimal : 286331160 in base: 11111118 123456876543240 There are a total of 740 penholodigital squares in base: 16 11156EB6^2 = 123DA7F85BCE964,3FD8F786^2 = FEC81B69573DA24 Total runtime in s 7.159 @home 1.573 s
// Running Base 18 and 19 @home Step size 17 decimal : 11668193559 in base: 111111119 12345679876543249 There are a total of 5116 penholodigital squares in base: 18 11150FC0G^2 = 123CD8ABH5G79F6E4,44422DD18^2 = HGEF25738D496BC1A Step size 6 decimal : 78142392501 in base: 4B7ICE111 12345678BB48EGB321 There are a total of 47677 penholodigital squares in base: 19 4B802235A^2 = 1234978CIBD6GFHEA5,II844BIA2^2 = IHG8F71C6DA59BE324 Total runtime in s 1151.714 real 19m11.715s user 19m10.257s sys 0m0.042s
Phix
using string maths (and not particularly fast)
with javascript_semantics procedure penholodigital(integer base) sequence penholodigitals = {} -- search squares of n from eg for base=4 sqrt(123) -- (and stop when next square has too many digits) atom n = 0, t1 = time()+1, carry = 0 for d=1 to base-1 do n = n*base+d end for n = ceil(sqrt(n)) assert(integer(n)) string digits = "123456789ABCDEF"[1..base-1], square = sprintf("%A",{{base,n*n}}) integer div = prime_factors(base-1,true)[$] bool ndz = mod(n,div)=0 while true do -- (until we get a carry off the end of square) if ndz and not find('0',square) and sort(square)=digits then penholodigitals &= {{{base,n},square}} -- (fmt later) end if -- add 2n+1 to get the next square (using string maths) carry += 2*n+1 n += 1 ndz = mod(n,div)=0 if ndz then integer d = base-1 while carry and d do atom ch = square[d] ch += carry - iff(ch<='9'?'0':'A'-10) carry = floor(ch/base) ch = remainder(ch,base) square[d] = ch + iff(ch<=9?'0':'A'-10) d -= 1 end while if carry then exit end if if time()>t1 then integer l = length(penholodigitals), e = {1,0,0,0,2,1,1,10,30,20,23,0,160,419,740}[base-1] progress("scanning base %d, %s (%d/%d found)\r",{base,square,l,e}) t1 = time()+1 end if end if end while progress("") integer count = length(penholodigitals) if base>12 and count>2 then penholodigitals = extract(penholodigitals,{1,-1}) end if penholodigitals = apply(true,sprintf,{{"%A**2 = %s"},penholodigitals}) string p = iff(count?":\n"&iff(base>12?sprintf("%s .. %s\n",penholodigitals) :join_by(penholodigitals,1,3)):"\n"), {is,s} = iff(count=1?{"is",""}:{"are","s"}) printf(1,"There %s %d penholodigital%s in base %d%s\n",{is,count,s,base,p}) end procedure integer lim = iff(platform()=JS?14: -- ~18s iff(machine_bits()=32?15 -- (initial square(16) is 4 out) :16)) -- ~7.5 mins (ho hum) papply(tagset(lim,2),penholodigital)
- Output:
There is 1 penholodigital in base 2: 1**2 = 1 There are 0 penholodigitals in base 3 There are 0 penholodigitals in base 4 There are 0 penholodigitals in base 5 There are 2 penholodigitals in base 6: 122**2 = 15324 221**2 = 53241 There is 1 penholodigital in base 7: 645**2 = 623514 There is 1 penholodigital in base 8: 2453**2 = 6532471 There are 10 penholodigitals in base 9: 3825**2 = 16328547 3847**2 = 16523874 4617**2 = 23875614 4761**2 = 25487631 6561**2 = 47865231 6574**2 = 48162537 6844**2 = 53184267 7285**2 = 58624317 7821**2 = 68573241 8554**2 = 82314657 There are 30 penholodigitals in base 10: 11826**2 = 139854276 12363**2 = 152843769 12543**2 = 157326849 14676**2 = 215384976 15681**2 = 245893761 15963**2 = 254817369 18072**2 = 326597184 19023**2 = 361874529 19377**2 = 375468129 19569**2 = 382945761 19629**2 = 385297641 20316**2 = 412739856 22887**2 = 523814769 23019**2 = 529874361 23178**2 = 537219684 23439**2 = 549386721 24237**2 = 587432169 24276**2 = 589324176 24441**2 = 597362481 24807**2 = 615387249 25059**2 = 627953481 25572**2 = 653927184 25941**2 = 672935481 26409**2 = 697435281 26733**2 = 714653289 27129**2 = 735982641 27273**2 = 743816529 29034**2 = 842973156 29106**2 = 847159236 30384**2 = 923187456 There are 20 penholodigitals in base 11: 42045**2 = 165742A893 43152**2 = 173A652894 44926**2 = 18792A6453 47149**2 = 1A67395824 47257**2 = 1A76392485 52071**2 = 249A758631 54457**2 = 2719634A85 55979**2 = 286A795314 59597**2 = 314672A895 632A4**2 = 3671A89245 64069**2 = 376198A254 68335**2 = 41697528A3 71485**2 = 46928A7153 81196**2 = 5A79286413 83608**2 = 632A741859 86074**2 = 6713498A25 89468**2 = 7148563A29 91429**2 = 76315982A4 93319**2 = 795186A234 A3A39**2 = 983251A764 There are 23 penholodigitals in base 12: 117789**2 = 135B7482A69 16357B**2 = 23A5B976481 16762B**2 = 24AB5379861 16906B**2 = 25386749BA1 173434**2 = 26B859A3714 178278**2 = 2835BA17694 1A1993**2 = 34A8125B769 1A3595**2 = 354A279B681 1B0451**2 = 3824B7569A1 1B7545**2 = 3A5B2487961 2084A9**2 = 42A1583B769 235273**2 = 5287BA13469 2528B5**2 = 5B23A879641 25B564**2 = 62937B5A814 262174**2 = 63A8527B194 285A44**2 = 73B615A8294 29A977**2 = 7B9284A5361 2A7617**2 = 83AB5479261 2B0144**2 = 8617B35A294 307381**2 = 93825A67B41 310828**2 = 96528AB7314 319488**2 = 9AB65823714 319A37**2 = 9B2573468A1 There are 0 penholodigitals in base 13 There are 160 penholodigitals in base 14: 1129535**2 = 126A84D79C53B .. 3A03226**2 = DB3962A7541C8 There are 419 penholodigitals in base 15: 4240C58**2 = 12378DA5B6EC94 .. EE25E4A**2 = ED4C93285671BA There are 740 penholodigitals in base 16: 11156EB6**2 = 123DA7F85BCE964 .. 3FD8F786**2 = FEC81B69573DA24
slightly faster
Using string digit-wise maths (and still not particularly fast). Same output as above, but 32 bit can also do base 16.
with javascript_semantics -- -- We can check for the presence of any zeroes or duplicate digits as we go. -- (Please gloss over the gaff of increasing #digits, which makes the next a rather daft example.) -- We can also leave partial results unfinished, for (a bad) example when adding 199 = 2*99+1 to go -- from 99*99 = {9,8,0,1} to 100*100 = {1,0,0,0,0} we can simply stop when we see a 0/dup in the -- finished part of the result, on {9,8,20,0}, and it won't hurt us at all when adding 201 = 2*100+1 -- to get the next square. That does mean we need to be a little smarter displaying progress, though. -- We can also utilise a partial to avoid overflow and get 16 digits to work properly on 32-bit. -- We can also skip +199 if that ain't gona work and +300 on the next iteration instead, iyswim. -- We can also use a trivial integer-sized bitmask to check for duplicate digits, which won't hit any -- problems (on Phix) up to at least 29 digits, or 61 digits on 64-bit, and start off with bitmask=1 -- to effectively mean "0 already seen", so that test no longer needs to be a separate check. -- Combined, these optimisations improved things from 7 minutes 23s to 4 mins 15s, or about 43%. -- Partials only saved 45s, or ~10%, admittedly rather less than hoped for, but still something. -- function aleph(sequence s, integer base) -- convert eg {1,15} to "1F" -- s may be partial: show digits>=base as '?' string res = repeat(' ',length(s)) for i,d in s do res[i] = iff(d>=base?'?':d+iff(d<=9?'0':'A'-10)) end for return res end function function reformat(sequence rs) sequence {r,s} = rs string root = sprintf("%A",{r}), square = aleph(s,r[1]) return sprintf("%s**2 = %s",{root,square}) end function procedure penholodigital(integer base) -- search squares of n from eg sqrt(123) for base=4 -- (and stop when next square has too many digits) sequence penholodigitals = {} atom n = 0, t1 = time()+1, carry = 0 for d=1 to base-1 do n = n*base+d end for -- (eg 123) n = ceil(sqrt(n))-1 assert(integer(n)) -- (^^ -1 as we bump square and set zod on first iter) sequence square = repeat(0,base-1) integer div = prime_factors(base-1,true)[$], d, dn = n, mbit -- square[$] = n*n -- 9 out for base of 16 on 32 bit, so: -- for eg 123*123 start off with {1*123,2*123,3*123} for d = base-1 to 1 by -1 do square[d] = remainder(dn,base)*n dn = floor(dn/base) end for bool ndz = mod(n,div)=0, zod -- zero or duplicate digit flag while true do -- (until we get a carry off the end of square) -- add 2n+1 to get the next square (using digitwise maths) carry += 2*n+1 n += 1 ndz = mod(n,div)=0 if ndz then zod = false integer mask = 01 -- (treat 0s as dups) d = base-1 while carry and d do atom ch = square[d] + carry carry = floor(ch/base) ch = remainder(ch,base) square[d] = ch d -= 1 mbit = power(2,ch) if and_bits(mask,mbit) then zod = true -- duplicate digit (or 0) if d then square[d] += carry carry = 0 -- theoretically better, but in practice worse: -- carry = carry>((base-square[1])*power(base,d-1)) end if exit end if mask += mbit end while if carry then exit end if if time()>t1 then integer l = length(penholodigitals), -- mini-cheat for the progress messages only: e = {1,0,0,0,2,1,1,10,30,20,23,0,160,419,740}[base-1] string sq = aleph(square,base) progress("scanning base %d, %s (%d/%d found)\r",{base,sq,l,e}) t1 = time()+1 end if if not zod then while d do -- finish zod checks & clean up any "legacy" partials atom ch = square[d] d -= 1 if ch>=base then carry = floor(ch/base) ch = remainder(ch,base) -- (nb: needed for mbit below) square[d+1] = ch if d=0 then exit end if -- (and any carry quits) square[d] += carry carry = 0 end if mbit = power(2,ch) if and_bits(mask,mbit) then zod = true -- duplicate digit (or 0) exit end if mask += mbit end while if carry then exit end if if not zod then penholodigitals &= {{{base,n},deep_copy(square)}} -- (fmt later) end if end if end if end while progress("") integer count = length(penholodigitals) if base>12 and count>2 then penholodigitals = extract(penholodigitals,{1,-1}) end if penholodigitals = apply(penholodigitals,reformat) string p = iff(count?":\n"&iff(base>12?sprintf("%s .. %s\n",penholodigitals) :join_by(penholodigitals,1,3)):"\n"), {is,s} = iff(count=1?{"is",""}:{"are","s"}) printf(1,"There %s %d penholodigital%s in base %d%s\n",{is,count,s,base,p}) end procedure integer lim = iff(platform()=JS?14:16) -- js ~3.8s, desktop(64/32bit) 4/6 mins papply(tagset(lim,2),penholodigital)
Javascript is actually nearly twice as fast as desktop/32bit, finishing base 16 in 3 mins 35s (but blank screen till then)
Raku
(9 .. 12).map: -> $base {
my $test = (1 ..^ $base)».base($base).join;
my $start = $test .parse-base($base).sqrt.Int;
my $end = $test.flip.parse-base($base).sqrt.Int;
say "\nThere is a total of {+$_} penholodigital squares in base $base:\n" ~
.map({"{.base($base)}² = {.².base($base)}"}).batch(3)».join(", ").join: "\n" given
($start .. $end).grep: *².base($base).comb.sort.join eq $test
}
(13 .. 16).hyper(:1batch).map: -> $base {
my $test = (1 ..^ $base)».base($base).join;
my $start = $test .parse-base($base).sqrt.Int;
my $end = $test.flip.parse-base($base).sqrt.Int;
my @penholo = ($start .. $end).grep: *².base($base).comb.sort.join eq $test;
say "\nThere is a total of {+@penholo} penholodigital squares in base $base:";
say @penholo[0,*-1].map({"{.base($base)}² = {.².base($base)}"}).batch(3)».join(", ").join: "\n" if +@penholo;
}
- Output:
There is a total of 10 penholodigital squares in base 9: 3825² = 16328547, 3847² = 16523874, 4617² = 23875614 4761² = 25487631, 6561² = 47865231, 6574² = 48162537 6844² = 53184267, 7285² = 58624317, 7821² = 68573241 8554² = 82314657 There is a total of 30 penholodigital squares in base 10: 11826² = 139854276, 12363² = 152843769, 12543² = 157326849 14676² = 215384976, 15681² = 245893761, 15963² = 254817369 18072² = 326597184, 19023² = 361874529, 19377² = 375468129 19569² = 382945761, 19629² = 385297641, 20316² = 412739856 22887² = 523814769, 23019² = 529874361, 23178² = 537219684 23439² = 549386721, 24237² = 587432169, 24276² = 589324176 24441² = 597362481, 24807² = 615387249, 25059² = 627953481 25572² = 653927184, 25941² = 672935481, 26409² = 697435281 26733² = 714653289, 27129² = 735982641, 27273² = 743816529 29034² = 842973156, 29106² = 847159236, 30384² = 923187456 There is a total of 20 penholodigital squares in base 11: 42045² = 165742A893, 43152² = 173A652894, 44926² = 18792A6453 47149² = 1A67395824, 47257² = 1A76392485, 52071² = 249A758631 54457² = 2719634A85, 55979² = 286A795314, 59597² = 314672A895 632A4² = 3671A89245, 64069² = 376198A254, 68335² = 41697528A3 71485² = 46928A7153, 81196² = 5A79286413, 83608² = 632A741859 86074² = 6713498A25, 89468² = 7148563A29, 91429² = 76315982A4 93319² = 795186A234, A3A39² = 983251A764 There is a total of 23 penholodigital squares in base 12: 117789² = 135B7482A69, 16357B² = 23A5B976481, 16762B² = 24AB5379861 16906B² = 25386749BA1, 173434² = 26B859A3714, 178278² = 2835BA17694 1A1993² = 34A8125B769, 1A3595² = 354A279B681, 1B0451² = 3824B7569A1 1B7545² = 3A5B2487961, 2084A9² = 42A1583B769, 235273² = 5287BA13469 2528B5² = 5B23A879641, 25B564² = 62937B5A814, 262174² = 63A8527B194 285A44² = 73B615A8294, 29A977² = 7B9284A5361, 2A7617² = 83AB5479261 2B0144² = 8617B35A294, 307381² = 93825A67B41, 310828² = 96528AB7314 319488² = 9AB65823714, 319A37² = 9B2573468A1 There is a total of 0 penholodigital squares in base 13: There is a total of 160 penholodigital squares in base 14: 1129535² = 126A84D79C53B, 3A03226² = DB3962A7541C8 There is a total of 419 penholodigital squares in base 15: 4240C58² = 12378DA5B6EC94, EE25E4A² = ED4C93285671BA There is a total of 740 penholodigital squares in base 16: 11156EB6² = 123DA7F85BCE964, 3FD8F786² = FEC81B69573DA24
RPL
| Code | Comments |
|---|---|
"0123456789ABCDEF" 'Digits' STO
≪ → base
≪ "" SWAP
WHILE DUP REPEAT
DUP base MOD
Digits OVER 1 + DUP SUB
4 ROLL + ROT ROT - base / RND
END DROP
≫ ≫ 'D→BAS' STO
≪ → base
≪ 0 1 SIZE FOR j
base * OVER j j SUB Digits SWAP POS 1 - +
NEXT SWAP DROP
≫ ≫ 'BAS→D' STO
≪ → number base digits
≪ IF number "0" POS
THEN 0
ELSE
{} base + 0 CON 1 1 PUT
1 number SIZE FOR j
Digits number j DUP SUB POS 1 PUT
NEXT CNRM base ==
END
≫ ≫ 'PHD?' STO
≪ 0 0 → base first last
≪ 0 1 SF
Digits 2 base SUB base BAS→D√ FLOOR
"FEDCBA987654321" 17 base - 15 SUB base BAS→D√ CEIL
FOR n
n SQ base D→BAS
IF base PHD?
THEN 1 + n 'last' STO IF 1 FS?C THEN n 'first' STO END
END
NEXT
IF first THEN
first base D→BAS "^2 = " + first SQ base D→BAS +
last base D→BAS "^2 = " + last SQ base D→BAS +
END
≫ ≫ 'PHDSQ' STO
|
Constant ( n base -- "###" ) ( "###" base -- n ) ( "###" base -- boolean ) Initialize variables o/w an array of counters the sum of counters must equal base ( base -- #PHD "first PHD" "last PHD" ) start search with "123..b" end search with "b..321" Display detailed results |
The following lines of command deliver what is required:
9 PHDSQ 10 PHDSQ 11 PHDSQ 12 PHDSQ
- Output:
12: 10 11: "3825^2 = 16328547" 10: "8554^2 = 82314657" 9: 30 8: "11826^2 = 139854276" 7: "30384^2 = 923187456" 6: 20 5: "42045^2 = 165742A893" 4: "A3A39^2 = 983251A764" 3: 23 2: "117789^2 = 135B7482A69" 1: "319A37^2 = 9B2573468A1"
Wren
This is limited to base 14 as base 15 would overflow Wren's safe integer limit of 2^53.
Although I'm not quite sure why, it appears that a necessary condition for a number to be a penholodigital square is for its square root to be exactly divisible by the highest prime factor of (base - 1).
import "./math" for Int
import "./fmt" for Conv, Fmt
var primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41]
var digits = "123456789ABCD"
for (b in 9..14) {
var master = 1
for (d in 1...b) master = master * primes[d-1]
var phd = []
var min = Conv.atoi(digits[0..(b-2)], b).sqrt.ceil
var max = Conv.atoi(digits[(b-2)..0], b).sqrt.floor
var div = Int.primeFactors(b-1)[-1]
for (i in min..max) {
if ((i % div) != 0) continue
var sq = i * i
var digs = Int.digits(sq, b)
if (digs.contains(0)) continue
var key = 1
for (dig in digs) key = key * primes[dig-1]
if (key == master) phd.add(i)
}
System.print("There is a total of %(phd.count) penholodigital squares in base %(b):")
if (b > 13) phd = [phd[0], phd[-1]]
for (i in 0...phd.count) {
Fmt.write("$s² = $s ", Conv.Itoa(phd[i], b), Conv.Itoa(phd[i] * phd[i], b))
if ((i + 1) % 3 == 0) System.print()
}
if (phd.count % 3 != 0) System.print()
System.print()
}- Output:
There is a total of 10 penholodigital squares in base 9: 3825² = 16328547 3847² = 16523874 4617² = 23875614 4761² = 25487631 6561² = 47865231 6574² = 48162537 6844² = 53184267 7285² = 58624317 7821² = 68573241 8554² = 82314657 There is a total of 30 penholodigital squares in base 10: 11826² = 139854276 12363² = 152843769 12543² = 157326849 14676² = 215384976 15681² = 245893761 15963² = 254817369 18072² = 326597184 19023² = 361874529 19377² = 375468129 19569² = 382945761 19629² = 385297641 20316² = 412739856 22887² = 523814769 23019² = 529874361 23178² = 537219684 23439² = 549386721 24237² = 587432169 24276² = 589324176 24441² = 597362481 24807² = 615387249 25059² = 627953481 25572² = 653927184 25941² = 672935481 26409² = 697435281 26733² = 714653289 27129² = 735982641 27273² = 743816529 29034² = 842973156 29106² = 847159236 30384² = 923187456 There is a total of 20 penholodigital squares in base 11: 42045² = 165742A893 43152² = 173A652894 44926² = 18792A6453 47149² = 1A67395824 47257² = 1A76392485 52071² = 249A758631 54457² = 2719634A85 55979² = 286A795314 59597² = 314672A895 632A4² = 3671A89245 64069² = 376198A254 68335² = 41697528A3 71485² = 46928A7153 81196² = 5A79286413 83608² = 632A741859 86074² = 6713498A25 89468² = 7148563A29 91429² = 76315982A4 93319² = 795186A234 A3A39² = 983251A764 There is a total of 23 penholodigital squares in base 12: 117789² = 135B7482A69 16357B² = 23A5B976481 16762B² = 24AB5379861 16906B² = 25386749BA1 173434² = 26B859A3714 178278² = 2835BA17694 1A1993² = 34A8125B769 1A3595² = 354A279B681 1B0451² = 3824B7569A1 1B7545² = 3A5B2487961 2084A9² = 42A1583B769 235273² = 5287BA13469 2528B5² = 5B23A879641 25B564² = 62937B5A814 262174² = 63A8527B194 285A44² = 73B615A8294 29A977² = 7B9284A5361 2A7617² = 83AB5479261 2B0144² = 8617B35A294 307381² = 93825A67B41 310828² = 96528AB7314 319488² = 9AB65823714 319A37² = 9B2573468A1 There is a total of 0 penholodigital squares in base 13: There is a total of 160 penholodigital squares in base 14: 1129535² = 126A84D79C53B 3A03226² = DB3962A7541C8
XPL0
Real, 64-bit numbers provide the precision needed beyond 32-bit integers to reach base 14 (14^13 = 7.94e14, which is 49.5 bits). Runs in 37 seconds on Pi4.
real Base; \Number Base being used [9..14]
proc NumOut(N); \Display N in the specified Base
real N;
int Remain;
[Remain:= fix(Mod(N, Base));
N:= Floor(N/Base);
if N # 0. then NumOut(N);
ChOut(0, Remain + (if Remain <= 9 then ^0 else ^A-10));
];
proc ShowPenSq(N); \Display N = N^2
real N;
[NumOut(N);
Text(0, "^^2 = ");
NumOut(N*N);
Text(0, " ");
];
func Penholodigital(N); \Return 'true' if N is penholodigital
real N;
int Used, Remain;
[Used:= 1; \can't contain 0
while N # 0. do
[Remain:= fix(Mod(N, Base));
N:= Floor(N/Base);
if Used & 1<<Remain then return false;
Used:= Used ! 1<<Remain;
];
return Used = 1<<fix(Base) - 1;
];
int Cnt;
real N, Limit, FirstN, LastN;
[Base:= 9.;
repeat Cnt:= 0; FirstN:= 0.;
N:= Floor(Sqrt(Pow(Base, Base-2.)));
Limit:= sqrt(Pow(Base, Base-1.));
repeat if Penholodigital(N*N) then
[Cnt:= Cnt+1;
if FirstN = 0. then FirstN:= N;
if Base <= 12. then
[ShowPenSq(N);
if rem(Cnt/3) = 0 then CrLf(0);
]
else LastN:= N;
];
N:= N + 1.;
until N >= Limit;
if rem(Cnt/3) # 0 then CrLf(0);
Text(0, "There are "); IntOut(0, Cnt);
Text(0, " penholodigital squares in base ");
IntOut(0, fix(Base)); CrLf(0);
if Base >= 13. and Cnt > 0 then
[ShowPenSq(FirstN);
ShowPenSq(LastN);
CrLf(0);
];
CrLf(0);
Base:= Base + 1.;
until Base >= 15.;
]- Output:
3825^2 = 16328547 3847^2 = 16523874 4617^2 = 23875614 4761^2 = 25487631 6561^2 = 47865231 6574^2 = 48162537 6844^2 = 53184267 7285^2 = 58624317 7821^2 = 68573241 8554^2 = 82314657 There are 10 penholodigital squares in base 9 11826^2 = 139854276 12363^2 = 152843769 12543^2 = 157326849 14676^2 = 215384976 15681^2 = 245893761 15963^2 = 254817369 18072^2 = 326597184 19023^2 = 361874529 19377^2 = 375468129 19569^2 = 382945761 19629^2 = 385297641 20316^2 = 412739856 22887^2 = 523814769 23019^2 = 529874361 23178^2 = 537219684 23439^2 = 549386721 24237^2 = 587432169 24276^2 = 589324176 24441^2 = 597362481 24807^2 = 615387249 25059^2 = 627953481 25572^2 = 653927184 25941^2 = 672935481 26409^2 = 697435281 26733^2 = 714653289 27129^2 = 735982641 27273^2 = 743816529 29034^2 = 842973156 29106^2 = 847159236 30384^2 = 923187456 There are 30 penholodigital squares in base 10 42045^2 = 165742A893 43152^2 = 173A652894 44926^2 = 18792A6453 47149^2 = 1A67395824 47257^2 = 1A76392485 52071^2 = 249A758631 54457^2 = 2719634A85 55979^2 = 286A795314 59597^2 = 314672A895 632A4^2 = 3671A89245 64069^2 = 376198A254 68335^2 = 41697528A3 71485^2 = 46928A7153 81196^2 = 5A79286413 83608^2 = 632A741859 86074^2 = 6713498A25 89468^2 = 7148563A29 91429^2 = 76315982A4 93319^2 = 795186A234 A3A39^2 = 983251A764 There are 20 penholodigital squares in base 11 117789^2 = 135B7482A69 16357B^2 = 23A5B976481 16762B^2 = 24AB5379861 16906B^2 = 25386749BA1 173434^2 = 26B859A3714 178278^2 = 2835BA17694 1A1993^2 = 34A8125B769 1A3595^2 = 354A279B681 1B0451^2 = 3824B7569A1 1B7545^2 = 3A5B2487961 2084A9^2 = 42A1583B769 235273^2 = 5287BA13469 2528B5^2 = 5B23A879641 25B564^2 = 62937B5A814 262174^2 = 63A8527B194 285A44^2 = 73B615A8294 29A977^2 = 7B9284A5361 2A7617^2 = 83AB5479261 2B0144^2 = 8617B35A294 307381^2 = 93825A67B41 310828^2 = 96528AB7314 319488^2 = 9AB65823714 319A37^2 = 9B2573468A1 There are 23 penholodigital squares in base 12 There are 0 penholodigital squares in base 13 There are 160 penholodigital squares in base 14 1129535^2 = 126A84D79C53B 3A03226^2 = DB3962A7541C8