Practical numbers: Difference between revisions

Content added Content deleted

Inline

@@ Line 341: / Line 341: @@
 ==={{header|alternative}}===
 Now without generating sum of allset.
-<lang pascal>program practicalnumbers;
+<lang pascal>program practicalnumbers2;
 {$IFDEF FPC}
   {$MODE DELPHI}{$OPTIMIZATION ON,ALL}
@@ Line 348: / Line 349: @@
 {$ENDIF}
 uses
-  sysutils;
+  SysUtils;
 type
   tdivs = record
-             DivsVal : array[0..2048-1] of Uint32;
+    DivsVal: array[0..1024 - 1] of Uint32;
-          end;
+  end;
 var
   Divs: tDivs;
-function CheckIsPractical(var Divs:tdivs;n:Uint32):boolean;
+  function CheckIsPractical(var Divs: tdivs; n: Uint32): boolean;
-//calc all divisors,calc sum of divisors
+    //calc all divisors,calc sum of divisors
-var
+  var
-  i,quot,ug,og : UInt32;
+    sum: UInt64;
+    i :NativeInt;
-  sum: UInt64;
+    quot,ug,sq,de: UInt32;
-Begin
-  with Divs do
-  Begin
+  begin
-    sum := 0;
+    with Divs do
-    ug := Low(tdivs.DivsVal);
-    og := High(tdivs.DivsVal);
-    i := 1;
-    while i*i < n do
     begin
-      quot := n div i;
+      sum := 1;
-      IF n - quot*i = 0 then
+      ug := Low(tdivs.DivsVal);
-      Begin
+      i  := 2;
-        if sum+1 < i then
+      sq := 4;
-          EXIT(FALSE);
+      de := 5;
-        DivsVal[og] := quot;
+      while sq < n do
+      begin
+        quot := n div i;
+        if n - quot * i = 0 then
+        begin
+          if sum + 1 < i then
+            EXIT(false);
+          Inc(sum, i);
+          DivsVal[ug] := quot;
+          Inc(ug);
+        end;
+        Inc(i);
+        sq += de;
+        de := de+2;
+      end;
+      if sq = n then
+      begin
+        if sum + 1 < i then
+          EXIT(false);
         DivsVal[ug] := i;
-        inc(sum,i);
+        Inc(sum, i);
-        dec(og);
+        Inc(ug);
-        inc(ug);
       end;
-      inc(i);
+      //check higher
+      while ug > 0 do
-    end;
-    If i*i = n then
+      begin
-    Begin
+        Dec(ug);
-      if sum+1 < i then
+        i := DivsVal[ug];
-      if sum+1 < i then
+        if sum + 1 < i then
-        EXIT(FALSE);
+          EXIT(false);
-      DivsVal[og] := i;
+        Inc(sum, i);
-      inc(sum,i);
+        if sum >= n - 1 then
-      dec(og);
+          break;
-    end;
+      end;
-    //check higher
+    end;//with
+    result := true;
-    while og < High(tDivs.DivsVal) do
-    begin
+  end;
-      inc(og);
-      i := DivsVal[og];
-      if sum+1 < i then
-        EXIT(FALSE);
-      inc(sum,i);
-      If sum>=n-1 then
-        EXIT(TRUE);
-    end;
-  end;//with
-end;
-function isPractical(n:Uint32):boolean;
+  function isPractical(n: Uint32): boolean;
+  begin
-Begin
-  if n= 1 then
+    if n in [1,2] then
-    EXIT(True);
+      EXIT(True);
-  if ODD(n) then
+    if ODD(n) then
-    EXIT(false);
+      EXIT(False);
-  result:=CheckIsPractical(Divs,n);
+    Result := CheckIsPractical(Divs, n);
-end;
+  end;
-procedure OutIsPractical(n:nativeInt);
+  procedure OutIsPractical(n: nativeInt);
-begin
+  begin
-  If isPractical(n) then
+    if isPractical(n) then
-    writeln(n,' is practical')
+      writeln(n, ' is practical')
-  else
+    else
-    writeln(n,' is not practical');
+      writeln(n, ' is not practical');
-end;
+  end;
 const
- ColCnt = 10;
+  ColCnt = 10;
- MAX = 333;
+  MAX = 333;
 var
-  T0 : INt64;
+  T0 : int64;
-  n,col,count : NativeInt;
+  n, col, Count: NativeInt;
+begin
-Begin
-  col:=ColCnt;
+  col := ColCnt;
-  count := 0;
+  Count := 0;
-  For n := 1 to MAX do
+  for n := 1 to MAX do
     if isPractical(n) then
     begin
-      write(n:5);
+      Write(n: 5);
-      inc(count);
+      Inc(Count);
-      dec(col);
+      Dec(col);
       if col = 0 then
-      Begin
+      begin
         writeln;
-        col :=ColCnt;
+        col := ColCnt;
       end;
     end;
   writeln;
-  writeln('There are ',count,' pratical numbers from 1 to ',MAX);
+  writeln('There are ', Count, ' pratical numbers from 1 to ', MAX);
   writeln;
-  T0 := GetTickCount64;
   OutIsPractical(666);
   OutIsPractical(6666);
@@ Line 453: / Line 460: @@
   OutIsPractical(954432);
   OutIsPractical(720);
-  OutIsPractical(5384);
+  OutIsPractical(5184);
   OutIsPractical(1441440);
   OutIsPractical(99998640);
-  Writeln( (GetTickCount64- T0)/1000:7:5,' s');
+  T0 := GetTickCOunt64;
-  {$IFDEF WINDOWS}  readln;{$ENDIF}
+  count := 0;
-end.</lang>
+  For n := 1 to 1000*1000 do
+    inc(count,Ord(isPractical(n)));
+  writeln('Count of practical numbers til 1,000,000 ',count,(GetTickCount64-t0)/1000:8:4,' s');
+  {$IFDEF WINDOWS}
+  readln;
+  {$ENDIF}
+end.
+</lang>
 {{out}}
 <pre> TIO.RUN
@@ Line 476: / Line 491: @@
 is not practical
 is practical
-is not practical
+is practical
 1441440 is practical
 99998640 is not practical
+Count of practical numbers til 1,000,000 97385  2.1380 s
-.00000 s</pre>
+Real time: 2.277 s CPU share: 99.55 %</pre>
 =={{header|Perl}}==