Disarium numbers: Difference between revisions
m
→{{header|Free Pascal}}: correct by accident correct value for base 10.Now run correct in Base 11 too
Alextretyak (talk | contribs) (Added 11l) |
m (→{{header|Free Pascal}}: correct by accident correct value for base 10.Now run correct in Base 11 too) |
||
Line 1,933:
<syntaxhighlight lang="pascal">
program disarium;
//compile with fpc -O3 -Xs
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
Line 1,938 ⟶ 1,939:
{$IFDEF FPC}
{$Mode Delphi}
uses
sysutils;
Line 1,948 ⟶ 1,947:
const
MAX_BASE = 16;
cDigits : array[0..MAX_BASE-1] of char =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
MAX_DIGIT_CNT = 31;
type
tDgt_cnt= 0..MAX_DIGIT_CNT-1;
tdgtPows = array[tDgt_cnt,0..MAX_BASE] of Uint64;
tdgtMaxSumPot = array[tDgt_cnt] of Uint64;
tmyDigits = record
dgtSumPot : array[tDgt_cnt] of Uint64;
dgtNumber : UInt64;
dgtMaxLen : tDgt_cnt;
end;
const
var
Line 1,966 ⟶ 1,971:
dgtPows :tdgtPows;
procedure InitMyPots(var mp :tdgtPows;base:int32);
var
p : Uint64;
begin
fillchar(mp,SizeOf(mp),#0);
For dgt := 0 to BASE do
begin
p := dgt;
For
begin
mp[
p := p*dgt;
end;
end;
p := 0;
end;
procedure Out_Digits(
var
i : Int32;
Line 1,988 ⟶ 1,995:
with md do
begin
write('dgtNumber ',dgtNumber,' = ',dgtSumPot[0],' in Base ');
For i := dgtMaxLen-1 downto
writeln;
end;
end;
procedure
var
PotSum : Uint64;
potBase: nativeInt;
dg
Begin
with md do
begin
pot := dgtMaxLen-1;
dg := digit[0]+1;
if dg < BASE then
begin
inc(dgtNumber);
digit[0]:= dg;
dgtSumPot[0] := dgtSumPot[1] + dgtPot[0];
EXIT;
end;
dec(dgtNumber,Base-1);
digit[0]:= 0;
dgtPot[0]:= 0;
dgtSumPot[0] := dgtSumPot[1];
potbase := Base;
idx := 1;
dec(pot);
Line 2,024 ⟶ 2,038:
inc(dgtNumber,potbase);
digit[idx]:= dg;
PotSum := dgtSumPot[idx+1];
//update sum
while idx>=0 do
begin
inc(PotSum,dgtPot[idx]);
dgtSumPot[idx] := PotSum;
dec(idx);
end;
EXIT;
end;
dec(dgtNumber,(dg-1)*PotBase
potbase *= Base;
digit[idx]:= 0;
dec(pot);
inc(idx);
end;
For pot := idx
Begin
dgtPot[idx] :=0;
dgtSumPot[pot] := 1;
end;
digit[idx] := 1;
dgtMaxLen := idx+1;
dgtNumber := potbase;
end;
end;
procedure OneRun(var s: tmyDigits;base:UInt32;Limit:Int64);
var
cnt : Int32;
begin
Writeln('Base = ',base);
InitMyPots(dgtPows,base);
fillchar(s,SizeOf(s),#0);
s.dgtMaxLen := 1;
i := 0;
cnt :=
repeat
if s.dgtSumPot[0] = s.dgtNumber then
Begin
Line 2,057 ⟶ 2,087:
inc(cnt);
end;
IncByOne(s,base);
inc(i);
until (i>=Limit);
writeln ( i,' increments and found ',cnt);
end;
Line 2,064 ⟶ 2,096:
{$Align 32}
s : tmyDigits;
T0: TDateTime;
base: nativeInt;
Begin
base := 10;
T0 := time;
OneRun(s,base,2646799);
T0 := (time-T0)*86400;
writeln(T0:8:3,' s');
writeln;
base := 11;
T0 := time;
OneRun(s,base,100173172);
T0 := (time-T0)*86400;
writeln(T0:8:3,' s');
Line 2,080 ⟶ 2,116:
{$ENDIF}
end.
</syntaxhighlight>
{{out|@TIO.RUN}}
<pre>
Base = 10
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber
dgtNumber 1676 = 1676 in Base 1676
dgtNumber 2427 = 2427 in Base 2427
dgtNumber 2646798 = 2646798 in Base 2646798
2646799 increments and found 19
0.008 s
Base = 11
dgtNumber 0 = 0 in Base 0
dgtNumber 1 = 1 in Base 1
dgtNumber 2 = 2 in Base 2
dgtNumber 3 = 3 in Base 3
dgtNumber 4 = 4 in Base 4
dgtNumber 5 = 5 in Base 5
dgtNumber 6 = 6 in Base 6
dgtNumber 7 = 7 in Base 7
dgtNumber 8 = 8 in Base 8
dgtNumber 9 = 9 in Base 9
dgtNumber 10 = 10 in Base A
dgtNumber 27 = 27 in Base 25
dgtNumber 39 = 39 in Base 36
dgtNumber 109 = 109 in Base 9A
dgtNumber 126 = 126 in Base 105
dgtNumber 525 = 525 in Base 438
dgtNumber 580 = 580 in Base 488
dgtNumber 735 = 735 in Base 609
dgtNumber 1033 = 1033 in Base 85A
dgtNumber 1044 = 1044 in Base 86A
dgtNumber 2746 = 2746 in Base 2077
dgtNumber 59178 = 59178 in Base 40509
dgtNumber 63501 = 63501 in Base 43789
dgtNumber 100173171 = 100173171 in Base 515AA64A
100173172 increments and found 24
0.294 s
</pre>
=={{header|Perl}}==
<syntaxhighlight lang="perl">use strict;
|