Data commit

Task/Self-numbers/Pascal/self-numbers.pas

@@ -0,0 +1,97 @@
+program selfnumb;
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$Optimization ON,ALL}
+{$IFEND}
+{$IFDEF DELPHI} {$APPTYPE CONSOLE} {$IFEND}
+uses
+  sysutils;
+const
+  MAXCOUNT =103*10000*10000+11*9+ 1;
+type
+  tDigitSum9999 = array[0..9999] of Uint8;
+  tpDigitSum9999 = ^tDigitSum9999;
+var
+  DigitSum9999 : tDigitSum9999;
+  sieve : array of boolean;
+
+procedure dosieve;
+var
+  pSieve : pBoolean;
+  pDigitSum :tpDigitSum9999;
+  n,c,b,a,s : NativeInt;
+Begin
+  pSieve := @sieve[0];
+  pDigitSum := @DigitSum9999[0];
+  n := 0;
+  for a := 0 to 102 do
+    for b := 0 to 9999 do
+    Begin
+      s := pDigitSum^[a]+pDigitSum^[b]+n;
+      for c := 0 to 9999 do
+      Begin
+        pSieve[pDigitSum^[c]+s] := true;
+        s+=1;
+      end;
+      inc(n,10000);
+    end;
+end;
+
+procedure InitDigitSum;
+var
+  i,d,c,b,a : NativeInt;
+begin
+  i := 9999;
+  for a := 9 downto 0 do
+    for b := 9 downto 0 do
+      for c := 9 downto 0 do
+        for d := 9 downto 0 do
+        Begin
+          DigitSum9999[i] := a+b+c+d;
+          dec(i);
+        end;
+end;
+
+procedure OutPut(cnt,i:NativeUint);
+Begin
+  writeln(cnt:10,i:12);
+end;
+
+var
+  pSieve : pboolean;
+  T0 : Uint64;
+  i,cnt,limit,One: NativeUInt;
+BEGIN
+  setlength(sieve,MAXCOUNT);
+  pSieve := @sieve[0];
+  T0 := GetTickCount64;
+  InitDigitSum;
+  dosieve;
+  writeln('Sievetime : ',(GetTickCount64-T0 )/1000:8:3,' sec');
+  //find first 50
+  cnt := 0;
+  for i := 0 to MAXCOUNT do
+  Begin
+    if NOT(pSieve[i]) then
+    Begin
+      inc(cnt);
+      if cnt <= 50 then
+        write(i:4)
+      else
+        BREAK;
+    end;
+  end;
+  writeln;
+  One := 1;
+  limit := One;
+  cnt := 0;
+  for i := 0 to MAXCOUNT do
+  Begin
+    inc(cnt,One-Ord(pSieve[i]));
+    if cnt = limit then
+    Begin
+      OutPut(cnt,i);
+      limit := limit*10;
+    end;
+  end;
+END.