Rosetta Code

Colorful numbers: Difference between revisions

Page Discussion

Colorful numbers (view source)

Revision as of 11:49, 1 February 2023

1,600 bytes added ,  1 year ago
m
→‎{{header|Free Pascal}}: added Output for coloful numbers< 100.
m (→‎{{header|C}}: best runtime on TIO.RUN with -Ofast)
m (→‎{{header|Free Pascal}}: added Output for coloful numbers< 100.)
Line 1,146:
I've created a lexical permutation of [2,3,4,5,6,7,8,9] which results in 40320 arrangements.<br>
So 0,1 are missing. The test of 3 digits is simple a test of the first three digits of these arrangments every delta = (8-3)! = 120 (for one digit = (8-1)! = 5040 ).<BR>
At home, the [[#C|C]]-Version compiled with -Ofast is still faster with best 15.03 ms vs 17ms18ms of my version<br>But such short timings differ extrem from run to run.
 
<syntaxhighlight lang="pascal">{$IFDEF FPC}
{$IFDEF FPC}
{$mode Delphi}
{$Optimization ON,All}
{$Coperators ON}
{$CODEALIGN proc=1,loop=1}
{$ENDIF}
{$IFDEF WINDOWS}
Line 1,166 ⟶ 1,164:
tpDgt = pInt8;
tDgtfield = array[0..7] of tdgt;
tpDgtfield = ^tDgtfield;
tPermfield = tDgtfield;
tAllPermDigits = array[0..EightFak-1] of tDgtfield;
tMarkNotColorful = array[0..EightFak-1] of byte;
 
tDat = Uint32;
tDatfieldtusedMultiples = array[0..08*9 DIV 2-2] of tdattDat;
tpDat =^tDatfield;
 
tusedMultiples = array[0..8*9 DIV 2] of tDat;
var
AllPermDigits :tAllPermDigits;
MarkNotColorful:tMarkNotColorful;
permcnt: NativeUint;,
totalCntColorFul,CntColorFul : Int32;
 
procedure OutNum(const num:tPermfield;dgtCnt: Int32);
var
i : integer;
Begin
For i := 0 to dgtcnt-1 do
write(num[i]);
writeln;
end;
 
function Check(pDat :tpDat; maxIdx : Int32;dat :tDat):boolean;
var
I : Int32;
begin
i := maxIdx;
if i>= 0 then
repeat
if dat = pDat[i] then
EXIT(true);
Dec(i);
until i
<0;
pDat[maxIdx+1]:= dat;
result := false;
end;
 
function CheckColorful(dgtCnt: NativeInt;idx:Int32):boolean;
var
usedMultiples : tusedMultiples;
pDgtfield : ^tDgtfield;
TestDgtCnt,StartIdx,l,value,maxIdx : Int32;
begin
IF MarkNotColorful[idx] <> 0 then
EXIT(false);
pDgtfield := @AllPermDigits[idx];
maxIdx := -1;
// needn't to test product of all digits.It's a singular max value
dec(dgtCnt);
//multiples of TestDgtCnt digits next to one another
For TestDgtCnt := 0 to dgtCnt do
begin
For StartIdx := 0 to dgtCnt-TestDgtCnt do
begin
value := 1;
For l := 0 to TestDgtCnt do
value *=pDgtfield[StartIdx+l];
if Check(@usedMultiples[0],maxIdx,value) then
begin
MarkNotColorful[idx] := dgtcnt+1;
EXIT(false);
end;
inc(MaxIdx);
end;
end;
inc(totalCntColorFul);
inc(CntColorFul);
result := true;
end;
 
procedure PermLex(n: Int32;StartVal:Int8);
Line 1,246 ⟶ 1,186:
pDat :tpDgt;
begin
For j := 0 to n-1 do
Perm[j]:= j+StartVal;
permcnt := 0;
dec(n);
Line 1,294 ⟶ 1,235:
end;
 
procedure OutNum(const num:tPermfield;dgtCnt: Int32);
var
i : integer;
Begin
For i := 0 to dgtcnt-1 do
write(num[i]);
writeln;
end;
 
function isAlreadyExisting(var uM :tusedMultiples; maxIdx : Int32;dat :tDat):boolean;
var
I : Int32;
begin
if maxIdx >= 0 then
begin
i := maxIdx;
repeat
if dat = uM[i] then
EXIT(true);
Dec(i);
until i <0;
end;
uM[maxIdx+1]:= dat;
result := false;
end;
 
function CalcValue(pDgtfield : tpDgtfield;TestDgtCnt:Int32):int32;
begin
result := 1;
repeat
result *=pDgtfield[TestDgtCnt];
dec(TestDgtCnt);
until TestDgtCnt <0;
end;
function isCheckColorful(dgtCnt: NativeInt;idx:Int32):boolean;
var
usedMultiples : tusedMultiples;
pDgtfield : ^tDgtfield;
TestDgtCnt,StartIdx,value,maxIdx : Int32;
begin
//needn't to test product of all digits.It's a singular max value
dec(dgtCnt);
pDgtfield := @AllPermDigits[idx];
maxIdx := -1;
 
//multiples of TestDgtCnt digits next to one another
For TestDgtCnt := 0 to dgtCnt do
begin
For StartIdx := 0 to dgtCnt-TestDgtCnt do
begin
value := CalcValue(@pDgtfield[StartIdx],TestDgtCnt);
// value := 1; For l := 0 to TestDgtCnt do value *=pDgtfield[StartIdx+l];
if isAlreadyExisting(usedMultiples,maxIdx,value) then
EXIT(false);
inc(MaxIdx);
end;
end;
inc(totalCntColorFul);
inc(CntColorFul);
result := true;
end;
 
procedure CheckDgtCnt(dgtCnt,delta:Int32);
var
i,j : int32;
begin
i := 0;
Line 1,303 ⟶ 1,306:
if dgtCnt = 1 then
CntColorFul := 2;//0,1
 
while i <= High(AllPermDigits) do
if delta = 1 then
begin
For i := i to EightFak-1 do
CheckColorful(dgtCnt,i);
IF (MarkNotColorful[i]=0) AND not isCheckColorful(dgtCnt,i)then
inc(i,delta);
MarkNotColorful[i] := dgtcnt;
end
else
Begin
if dgtcnt<3 then
//always colorful
begin
repeat
isCheckColorful(dgtCnt,i);
inc(i,delta);
until i>EightFak-1;
end
else
begin
repeat
IF (MarkNotColorful[i]=0) AND not isCheckColorful(dgtCnt,i) then
begin
//mark a range as not colorful
j := i+delta-1;
repeat
MarkNotColorful[j] := dgtcnt;
dec(j);
until j < i;
end;
inc(i,delta);
until i>EightFak-1;
end;
end;
end;
Line 1,316 ⟶ 1,347:
T0 := GetTickCount64;
PermLex(8,2);
delta := EightFak-1;
//takes ~1 ms til here
delta := 15;
 
Writelnwriteln('First colorful numbers less digitsthan count100');
For i := 0 to 9 do
Begin
write(i:4);
dec(delta);
end;
For i := 2 to 9 do
For j := 2 to 9 do
if j<> i then
begin
//write(i:3,j);
dec(delta);
if delta = 0 then
begin
delta:= 15;
Writeln;
end;
end;
writeln;
writeln;
Writeln(' digits count of colorful numbers');
totalCntColorFul := 2;//0,1,
delta := EightFak-1;
delta := (delta+1) DIV 8;
j := 7;
Line 1,331 ⟶ 1,382:
dec(j);
until false;
Writeln;
Writeln('Total number of colorful numbers: ',totalCntColorFul);
Write('Highest Value :');
Line 1,340 ⟶ 1,391:
BREAK;
end;
 
Writeln('Runtime in ms ',GetTickCount64-T0);
end.
Line 1,345 ⟶ 1,397:
{{out|@TIO.RUN}}
<pre>
First colorful numbers less than 100
digits count
0 1 2 3 4 5 6 7 8 9 23 24 25 26 27
28 29 32 34 35 36 37 38 39 42 43 45 46 47 48
49 52 53 54 56 57 58 59 62 63 64 65 67 68 69
72 73 74 75 76 78 79 82 83 84 85 86 87 89 92
93 94 95 96 97 98
 
digits count of colorful numbers
1 10
2 56
Line 1,354 ⟶ 1,413:
7 21596
8 14256
 
Total number of colorful numbers: 57256
Highest Value :98746253
 
Runtime in ms 27</pre>
Runtime in ms 38 (= best TIO.Run up to 51 ms )
Runtime in ms 18 (= best up to 27 ms @home )
</pre>
 
=={{header|Perl}}==
Horst
132

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/336267"