Penholodigital squares: Difference between revisions
→{{header|Raku}}: prepend Free Pascal Version
m (→{{header|J}}: meh) |
(→{{header|Raku}}: prepend Free Pascal Version) |
||
Line 117:
fec81b69573da24=3fd8f786²
NB. this is getting to be obnoxiously long in terms of time...</syntaxhighlight>
=={{header|Pascal}}==
==={{header|Free Pascal}}===
nearly copy and paste of pandigital square numbers.base 17 none found.Base 18 starts late, base 19 no start found within 20 min.
<syntaxhighlight lang="pascal">
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}
uses
sysutils;
const
charSet : array[0..36] of char ='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
type
tNumtoBase = record
ntb_dgt : array[0..31-4] of byte;
ntb_cnt,
ntb_bas : Word;
end;
var
sl : array of string;
Num,
sqr2B,
deltaNum : 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 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:NativeInt);
var
n,penHoloCnt : Uint64;
i,j,TestSet,CheckSet : NativeInt;
Begin
setlength(sl,740);
//number containing 1,2..,base-1
n := 0;
For j := 1 to Base-1 do
n := n* base + j;
n := trunc(sqrt(n));
Conv2num(sqr2B,n*n,base);
Conv2num(Num,n,base);
deltaNum := num;
AddNum(deltaNum,deltaNum);
IncNum(deltaNum,1);
i := 0;
//all digits without 0
CheckSet := 0;
For j := base-1 downto 1 do
CheckSet := CheckSet OR (1 shl j);
penHoloCnt := 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
IncNumBig(num,i);
sl[penHoloCnt] := OutNum(Num)+'^2 = '+OutNum(sqr2B);
inc(penHoloCnt);
i := 0;
end;
//next square number
AddNum(sqr2B,deltaNum);
IncNum(deltaNum,2);
inc(i);
until sqr2B.ntb_cnt >= base;
Writeln('There are a total of ',penHoloCnt,' penholodigital squares in base: ',base:2);
if (penHoloCnt > 0) AND (base < 14) 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;
end;
var
T0: TDateTime;
base :nativeInt;
begin
T0 := now;
For base := 2 to 16 do
Test(base);
writeln('Total runtime in s ',(now-T0)*86400:10:3);
{$IFDEF WINDOWS}readln;{$ENDIF}
end.
</syntaxhighlight>
{{out|@TIO.RUN}}
<pre style="height:40ex;overflow:scroll;">
There are a total of 1 penholodigital squares in base: 2
1^2 = 1
There are a total of 0 penholodigital squares in base: 3
There are a total of 0 penholodigital squares in base: 4
There are a total of 0 penholodigital squares in base: 5
There are a total of 2 penholodigital squares in base: 6
122^2 = 15324,221^2 = 53241
There are a total of 1 penholodigital squares in base: 7
645^2 = 623514
There are a total of 1 penholodigital squares in base: 8
2453^2 = 6532471
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
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
There are a total of 20 penholodigital squares 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 a total of 23 penholodigital squares 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 a total of 0 penholodigital squares in base: 13
There are a total of 160 penholodigital squares in base: 14
There are a total of 419 penholodigital squares in base: 15
There are a total of 740 penholodigital squares in base: 16
Total runtime in s 50.755
@home:Total runtime in s 18.130
There are a total of 0 penholodigital squares in base: 17 ( 1min 47 for this )
Starting base 18 takes a lot of time
base 18 delta
11150FC0G^2 = 123CD8ABH5G79F6E4 9,026,292,072
111B9DC9B^2 = 12489573CFGBAHE6D 12,270,685
111HF0AAD^2 = 1253FCA98B6DG4EH7 11,890,820
11223514F^2 = 1258F7CA3E4BDGH69 4,435,130
112237HG2^2 = 1258FDG67B9CHE3A4 17,051
1122775FB^2 = 1259637EGF84AHBCD 416,007
....stopped
base 19 no startvalue after 20 min..
</pre>
=={{header|Raku}}==
| |||