Anonymous user
Ludic numbers: Difference between revisions
→{{header|Pascal}}: a new Version using a big array
(Changed code so that ludic function is only called once for the largest value) |
(→{{header|Pascal}}: a new Version using a big array) |
||
Line 1,885:
=={{header|Pascal}}==
=== ===
Inspired by "rotors" of perl 6 .
Runtime nearly quadratic: maxLudicCnt = 10000 -> 0.03 s =>maxLudicCnt= 100000 -> 3 s
Line 2,030 ⟶ 2,031:
LastLucid(LudicList,maxLudicCnt,5);
triples(LudicList,250);//all-> (LudicList,LudicList[High(LudicList)].dNum);
END.</lang>
{{Output}}
<pre>
First 25 ludic numbers:1,2,3,5,7,11,13,17,23,25,29,37,41,43,47,53,61,67,71,77,83,89,91,97,107
There are 142 ludic numbers below 1000
2000.th to 2005.th ludic number
Line 2,043 ⟶ 2,045:
(1,3,7) (5,7,11) (11,13,17) (23,25,29) (41,43,47) (173,175,179) (221,223,227) (233,235,239)
real 0m2.921s
</pre>
=== ===
Using an array of byte, each containing the distance to the next ludic number. 64-Bit needs only ~ 60% runtime of 32-Bit.
Three times slower than the Version 1. Much space left for improvements, like memorizing the count of ludics of intervals of size 1024 or so, to do bigger steps.Something like skiplist.
<lang pascal>program ludic;
{$IFDEF FPC}{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
sysutils;
const
MAXNUM =21511;// > 1
//1561333;-> 100000 ludic numbers
//1561243,1561291,1561301,1561307,1561313,1561333
type
tarrLudic = array of byte;
tLudics = array of LongWord;
var
Ludiclst : tarrLudic;
procedure Firsttwentyfive;
var
i,actLudic : NativeInt;
Begin
writeln('First 25 ludic numbers');
actLudic:= 1;
For i := 1 to 25 do
Begin
write(actLudic:3,',');
inc(actLudic,Ludiclst[actLudic]);
IF i MOD 5 = 0 then
writeln(#8#32);
end;
writeln;
end;
procedure CountBelowOneThousand;
var
cnt,actLudic : NativeInt;
Begin
write('Count of ludic numbers below 1000 = ');
actLudic:= 1;
cnt := 1;
while actLudic <= 1000 do
Begin
inc(actLudic,Ludiclst[actLudic]);
inc(cnt);
end;
dec(cnt);
writeln(cnt);writeln;
end;
procedure Show2000til2005;
var
cnt,actLudic : NativeInt;
Begin
writeln('ludic number #2000 to #2005');
actLudic:= 1;
cnt := 1;
while cnt < 2000 do
Begin
inc(actLudic,Ludiclst[actLudic]);
inc(cnt);
end;
while cnt < 2005 do
Begin
write(actLudic,',');
inc(actLudic,Ludiclst[actLudic]);
inc(cnt);
end;
writeln(actLudic);writeln;
end;
procedure ShowTriplets;
var
actLudic,lastDelta : NativeInt;
Begin
writeln('ludic numbers triplets below 250');
actLudic:= 1;
while actLudic < 250-5 do
Begin
IF (Ludiclst[actLudic] <> 0) AND
(Ludiclst[actLudic+2] <> 0) AND
(Ludiclst[actLudic+6] <> 0) then
writeln('{',actLudic,'|',actLudic+2,'|',actLudic+6,'} ');
inc(actLudic);
end;
writeln;
end;
procedure CheckMaxdist;
var
actLudic,Delta,MaxDelta : NativeInt;
Begin
MaxDelta := 0;
actLudic:= 1;
repeat
delta := Ludiclst[actLudic];
inc(actLudic,delta);
IF MAxDelta<delta then
MAxDelta:= delta;
until actLudic>= MAXNUM;
writeln('MaxDist ',MAxDelta);writeln;
end;
function GetLudics:tLudics;
//Array of byte containing the distance to next ludic number
//eliminated numbers are set to 0
var
i,actLudic,actcnt,delta,actPos,lastPos,ludicCnt: NativeInt;
Begin
setlength(Ludiclst,MAXNUM+1);
For i := MAXNUM downto 0 do
Ludiclst[i]:= 1;
actLudic := 1;
ludicCnt := 1;
repeat
inc(actLudic,Ludiclst[actLudic]);
IF actLudic> MAXNUM then
BREAK;
inc(ludicCnt);
actPos := actLudic;
actcnt := 0;
// Only if there are enough ludics left
IF MaxNum-ludicCnt-actPos > actPos then
Begin
//eliminate every element in actLudic-distance
//delta so i can set Ludiclst[actpos] to zero
delta := Ludiclst[actpos];
repeat
lastPos := actPos;
inc(actpos,delta);
if actPos>=MAXNUM then
BREAK;
delta := Ludiclst[actpos];
inc(actcnt);
IF actcnt= actLudic then
Begin
inc(Ludiclst[LastPos],delta);
//mark as not ludic
Ludiclst[actpos] := 0;
actcnt := 0;
end;
until false;
end;
until false;
writeln(ludicCnt,' ludic numbers upto ',MAXNUM,#13#10);
end;
BEGIN
GetLudics;
CheckMaxdist;
Firsttwentyfive;CountBelowOneThousand;Show2000til2005;ShowTriplets ;
setlength(Ludiclst,0)
END.</lang>
{{Out}}
<pre>2005 ludic numbers upto 21511
MaxDist 56
First 25 ludic numbers
1, 2, 3, 5, 7
11, 13, 17, 23, 25
29, 37, 41, 43, 47
53, 61, 67, 71, 77
83, 89, 91, 97,107
Count of ludic numbers below 1000 = 142
ludic number #2000 to #2005
21475,21481,21487,21493,21503,21511
ludic numbers triplets below 250
{1|3|7}
{5|7|11}
{11|13|17}
{23|25|29}
{41|43|47}
{173|175|179}
{221|223|227}
{233|235|239}
real 0m0.003s
100000 ludic numbers upto 1561334
...
real 0m8.438s</pre>
=={{header|Perl}}==
| |||