Rosetta Code

Factors of an integer: Difference between revisions

Page Discussion

Factors of an integer (view source)

Revision as of 20:35, 17 February 2020

4,760 bytes added ,  4 years ago
m
→‎using Prime decomposition: added TryItOnline to show, it runs
(→‎improvement: Thinking about Zumkeller numbers, where the most time comsuming part ist getting the factors.Now using prime decomposition and Calc factors .InsertSort faster than Quicksort (n = [1..1e6] 520ms -> 300 ms //Without sort 240)
m (→‎using Prime decomposition: added TryItOnline to show, it runs)
Line 3,723:
</pre>
===using Prime decomposition===
like [[http://rosettacode.org/wiki/Factors_of_an_integer#Prime_factoring C Prime_factoring]].<BR>
Insertion sort was much faster."runtime overhead" +25% instead +100% for quicksort against no sort.
{{works with|Free Pascal}}
like [[http://rosettacode.org/wiki/Factors_of_an_integer#Prime_factoring C Prime_factoring]].<BR>
<lang pascal>program PropDivs;
Insertion sort was much faster, because mostly not so many factors need to be sorted.<BR>
"runtime overhead" +25% instead +100% for quicksort against no sort.<BR>
[https://tio.run/##rVjdc9pIEn/nr5iHrQJs8WU7XlsE3yU23nDlGG6draurlG9LiAEGhKSVRibelP/183X3fGiEYfce1g8JTHf/uqe/h2S64qFspUEeBlFrnoavr2mWLLJgw26DcDwfxZIveNavff9hdHszvGW3k@uXWqfD2Pcffj72xscvbManxULEC5YWWZrkvIa0z@ObIbsZ3k0@jV7oYJxKsRG/B1IkMRvfex/u7hThOpnxD5FYxAwUh4OLF1A1vHsYIhXIHyaTL/@eDNn1@P5hfDck6v3N6PalVuQ8B578OS@kiPJ@rSafU9QuJ4lkA5bxMMlmiGL@0kROMrHxds4@B9@Y/4uI5elJvyTxeAaQgJaCCAdn7IXUIHPEzZnPgiwLnr922@3e6SNL5mRLf5/AdSy9fec34ukQ6aHYjJGe76XeFxv84LM3N9m5z8MmiCK0l@dwJWvw@buzHpn8L7giSsuR5AQJXPcQtyeOyEQBI0SeZFaeborsRE01GaipK/gUZEB21PsVY1CWfH0DXt6kful5sBtzg8@KjLNRnPNMPiSZbKAi36rrszs@lx77WSyWEvygVEMCs6bRPfLYPxwCapyIpwS5tflTDqkMx3MwX/gD1mPHBMtkooFnCZANm5YHRrTiq3hUbl/BgWAt1lNft0sRcdZYsasBgTVZEM8Ymf919ciuFEhTQbvgTMGujnuP/kCzm8CClxqrpvpGsd1hZymC4jFRVfhdN4qq85WH0syTPIcy8VbeJviGERCzb25SiZwkwGXTJIl4EPdrH7XBpQAD/d1@Ndpfu494fKLijB9P8WPGUx5Isl7kqYIeMJkVXPvSYlV4Ic/ITqS6SkoHjW41y5HmvEK1csljWxrTjAdryz9H@iaZGWRQ67J/dMJSsXUeRDnv7we1kQGJuAxYEUPLMoLq7nMLaXW6GlG69G/TgLpXL8kU/mwnNxABwntCssqAFJ3SY/kyYr1z1uq9TZOJLsFxAeWWJSnP/I8q7AMMka0s4a0hI0YqSUwCb4VcuiWtEry81TYTkjeodXl1cHddX2uNXqUW2dIVdIvlSImAhbhu9UytGCWqAUMBlgQVUdXesZArkbfK9UioH9WblsgjmmIHOP9T9xQqCekKd41YO0b8gQkVWKO8ovqQYq1UYMJiSFxckoniRp0toK@BhJ4orR64WLPPTPsms3MYHD5x2gHTopgomxyLDmED8p9CNnc60byIQ9oFECKBdGyESZzLygSwA6Dp6zmCTVvEkYh5mWUZz4tIUsqUsm1j2xt9xqK/XJ@96oEqUoxJLtCMRmw2DqgfhHSUlzUF5ToPQi8EF2tP/1Yk8juUwEbEuE5x5XgAzF/syFPT9mNpblttB2BxjFEAONtTFSx@pUoTlgDJFbP3TtI6ZYshVrAq4bs24d2OpfPWqnW2LavPaU@hYwYc1mzmOU0/fdPuzcSFZp9mR2l2FVdatmrF9A09R7agy2x3VHJEQ5JbSPqWZS1XB0Cl5MGHlc5TZa34wmiurp92xKk/iPpb3sr0U38xcqH11XXP3JX@d69rpxfOAreXuIqPdhWbYaH89P6qjCctIiqFQEpDHvccUGcAKrXA23w7HZEinMlkZ2qnE7CpWKhaYxGuYskTz/5Wo9jFNL9s1HZj5obhD@JVjda@vHUD1Tsw292LlT45qaS5qhogAU6oFlB1VNahaVuGYtuKTpLd3vITx3U8b2Af2dvMqMMgi2/3dttiUgVc7uxU@l7EY9j/Ii/1Uni/eGsPGnplbzYeE8Zi6uCOevIEBEhAgO54vJDLBk2BMlY5l1FJ8FTwU3PRv@MHaCz2UG@P5HyQKz/jJzjAz7lqcnRe3RiqnZrGoQn/7pLSfrtLuPnR6XyG7i/S6JlxyMNnM/lga4c3A1dwcEkW862ChZKS4HMrj7t/kKYQR@TboHnIH4nc1LbafyjhWjbbUn2IxtmzCdW55dnpEETGai7TGN2ysm4Bv7mr1J6@Ra6PaJ8EsCP1vdyxKZDg9eOBZXVJWBbRoWYwgwfM2hJV2a/f2zaogxxV6ufAxEVGMEP1C3watvUzEQIj2aYIl9BQckmbUhCzfxYiXCMbGAgnImd5ykMRRCwMaOTsvDFzr@uRq8Dami7AW7NPqPqjsqoO9Z2S8/VyrGe7@Wo8vm9F8HYL6i8sN92kTfdwsDy7rpWbzgGdu73oQxRBw8nxsRDbN2PVD339ipjue0WsvZV9RBjHUDFUnKwMhMrodNjvPEvYFKI2Mz6sPFaMX3b35DL3gLgGp3XfrjnVUqm@OWgx17Xg1T37DNALMlHWj82Dr@@HlPPZF3hmNu5gjZM6bawfvkB@5h6ktxkL6JTzM72wqUXbL3@GwfO42EzBreyXHfcRlHYhfqYwKigHX68feGUFRH0U7032mZtjPVsprxIUkvJsttPV7XvBXhfeBI2qIS0ysNnpdbtdv@ufwlsi52FOP8D02u26RwZU4TaQOCxEefzhyT496qXHOhG5FfBcSRMH5eQ/86Rx5PCn0T31BLH7a1WlpkjeU1VVhhevdYT/NGkNtVcYxtiNAuPtKZdbDg2vR78MnZ1cnl2e/3hy@c7Xb2Ird3p22bu4uDjrdhm0LZAXIWfhMsH//Lqu2mAGrArZ5LjWczXYl@kWfaLKRDPDeMOXhUlut7h3oq1XbIsDeRIVM/xNOP7/UTza@cqawV6@lDLN/U6Hx@2tWIuUz0TQTrJFB791PonFMnr@1fRM/qs2HJ4tn67vLQDIb7fbZQJRaxexaE0Fhz2SR7P2jHeCcCk2nSUhteU3SbN4LjLI1d4JeBmBhvc37dfX3snp2bvzHy8u/xvOo2CRv7bGp/8D Try it online!]
<lang pascal>program FacOfInteger;
{$IFDEF FPC}
// {$R+,O+} debuging purpose
{$MODE DELPHI}
{$Optimization ON,ALL}
Line 3,747 ⟶ 3,749:
pfPrims : array[0..13] of tPot;
pfCnt,
pfFacCntpfDivCnt,
pfSumOfDivs,
pfNum : Uint32;
end;
 
tSmallPrimes = array[0..6541] of Word;
tItem = NativeUint;
tDivisors = array of Uint32;
tpDivisortDivisors = pUint32array of tItem;
tpDivisor = pNativeUint;
var
SmallPrimes: tSmallPrimes;
primeDecomp: tprimeFac;
Divisors : tDivisors;
 
procedure InsertSort(pDiv:tpDivisor; Left, Right : LongIntNativeInt );
var
I, J: Int32NativeInt;
Pivot : Uint32tItem;
begin
for i:= 1 + Left to Right do
Line 3,808 ⟶ 3,812:
end;
 
procedure PrimeFacOut(primeDecompproper:tprimeFacBoolean=true);
var
i,k : Uint32Int32;
begin
with primeDecomp do
Begin
write(pfNum,' = ');
For ik := 0 to pfCnt-2 do1;
For i := 0 to k-1 do
with pfPrims[i] do
If potMax = 1 then
Line 3,821 ⟶ 3,826:
else
write(potPrim,'^',potMax,'*');
with pfPrims[pfCnt-1k] do
If potMax = 1 then
write(potPrim)
else
write(potPrim,'^',potMax);
if proper then
writeln(' got ',pfDivCnt-1,' proper divisors with sum : ',pfSumOfDivs-pfNum)
else
writeln(' got ',pfDivCnt,' divisors with sum : ',pfSumOfDivs);
end;
end;
 
function CntDivsDivCount(const primeDecomp:tprimeFac):NativeUintNativeUInt;inline;
begin
result := primeDecomp.pfFacCntpfDivCnt;
end;
 
function SumOfDiv(const primeDecomp:tprimeFac):NativeUInt;inline;
begin
result := primeDecomp.pfSumOfDivs;
end;
 
procedure PrimeDecomposition(n:Uint32;var res:tprimeFac);
var
i,pr,fac,cnt,cntFacDivCnt,quot{to minimize divisions} : NativeUint;
Begin
res.pfNum := n;
cnt := 0;
cntFacDivCnt := 1;
i := 0;
if n <= 1 then
Begin
with res.pfPrims[0] do
Begin
potPrim := n;
potMax := 1;
end;
cnt := 1;
end
else
repeat
pr := SmallPrimes[i];
Line 3,855 ⟶ 3,879:
potPrim := pr;
potMax := 0;
fac := pr;
repeat
n := quot;
quot := quot div pr;
inc(potMax);
fac *= pr;
until pr*quot <> n;
cntFacDivCnt *= (potMax+1);
end;
inc(Cnt);
Line 3,867 ⟶ 3,893:
until false;
//a big prime left over?
 
IF n > 1 then
with res do
Line 3,876 ⟶ 3,901:
potMax := 1;
end;
cntFac *= 2;
inc(Cnt);
DivCnt *= 2;
end;
res.pfCnt:= cnt;
res.pfFacCntpfDivCnt := cntFacDivCnt;
res.pfSumOfDivs := 0;
end;
 
functionprocedure GetDivSumGetDivs(constvar primeDecomp:tprimeFac;var Divs:tDivisors):NativeUint;
var
pDivs : tpDivisor;
i,len,j,k,l,p,valpPot,k,sum: NativeInt;
Begin
i := CntDivsDivCount(primeDecomp);
IF i > Length(DivisorsDivs) then
setlength(DivisorsDivs,i);
pDivs := @Divs[0];
pDivs[0] := 1;
len := 1;
l := len;
resultsum := 1;
For i := 0 to primeDecomp.pfCnt-1 do
with primeDecomp.pfPrims[i] do
Line 3,901 ⟶ 3,927:
//Multiply every divisor before with the new primefactors
//and append them to the list
p := potPrim;
val :=1;
k := potMax-1;
p := potPrim;
pPot :=1;
repeat
valpPot *= p;
For j := 0 to len-1 do
Begin
pDivs[l]:= valpPot*pDivs[j];
sum += pDivs[l];
inc(l);
end;
Line 3,915 ⟶ 3,942:
len := l;
end;
primeDecomp.pfSumOfDivs := sum;
//Sort. Insertsort much faster than QuickSort in this special case
InsertSort(pDivs,0,len-1);
end;
 
procedureFunction AllFacsOutGetDivisors(n: Uint32;var Divs:tDivisors):Int32;
var
k,ji:Int32;
Begin
PrimeDecomposition(n,primeDecomp);
ki := CntDivsDivCount(primeDecomp);
IF ki > Length(DivisorsDivs) then
setlength(DivisorsDivs,ki+1);
GetDivSumGetDivs(primeDecomp,DivisorsDivs);
result := DivCount(primeDecomp);
write(n:5,' got ',k:4,' divisors : ');
dec(k); // zero based
For j := 0 to k-1 do
write(Divisors[j],',');
writeln(Divisors[k]);
end;
 
procedure AllFacsOut(n: Uint32;Divs:tDivisors;proper:boolean=true);
var
k,j: Int32;
Begin
k := GetDivisors(n,Divs)-1;// zero based
PrimeFacOut(proper);
IF proper then
dec(k);
IF k > 0 then
Begin
For j := 0 to k-1 do
write(Divs[j],',');
writeln(Divs[k]);
end;
end;
 
procedure SpeedTest(Limit:Uint32);
var
Ticks,SumDivCnt : Int64;
Divisors : tDivisors;
number: UInt32;
Begin
Ticks := GetTickCount64;
SumDivCnt := 0;
For number := 1 to Limit do
inc(SumDivCnt,GetDivisors(number,Divisors));
writeln('SpeedTest ',(GetTickCount64-Ticks)/1000:0:3,' secs for 1..',Limit);
writeln('mean count of divisors ',SumDivCnt/limit:0:3);
writeln;
end;
 
var
Divisors : tDivisors;
number: Int32;
BEGIN
InitSmallPrimes;
setlength(Divisors,1);
SpeedTest(1000*1000);
 
writeln('Enter a number between 1 and 4294967295: ');
writewriteln('3491888400 is a nice choice :');
readln(number);
IF number >= 10 then
Begin
AllFacsOut(number);
writeln('Proper number version');
AllFacsOut(number,Divisors);
 
writeln('including n version');
AllFacsOut(number,Divisors,false);
end;
//https://en.wikipedia.org/wiki/Highly_composite_number <= HCN
//http://wwwhomes.uni-bielefeld.de/achim/highly.txt the first 1200 HCN
//AllFacsOut(3491888400);
END.</lang>
{out}}
<pre>
SpeedTest 0.296 secs for 1..1000000
mean count of divisors 13.970
**SpeedTest 5.707 secs for 1..10000000
**mean count of divisors 16.273
****SpeedTest 121.159 secs for 1..100000000
****mean count of divisors 18.575
 
Enter a number between 1 and 4294967295:
{{out}}
3491888400 is a nice choice :
<pre>Enter a number between 1 and 4294967295:
123456789
3491888400 is a nice choice 120
Proper number version
120 got 16 divisors : 1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120
123456789 = 3^2*3607*3803 got 11 proper divisors with sum : 54966027
</pre>
1,3,9,3607,3803,10821,11409,32463,34227,13717421,41152263
including n version
123456789 = 3^2*3607*3803 got 12 divisors with sum : 178422816
1,3,9,3607,3803,10821,11409,32463,34227,13717421,41152263,123456789</pre>
 
=={{header|Perl}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/126432"