program Merten; {$IFDEF FPC} {$MODE DELPHI} {$Optimization ON,ALL} {$ELSE} {$APPTYPE CONSOLE} {$ENDIF} uses sysutils; const BigLimit = 10*1000*1000*1000;//1e10 type tSieveElement = Int8; tpSieve = pInt8; tMoebVal = array[-1..1] of Int64; var MertensValues : array[-40000..50500] of NativeInt; primes : array of byte; sieve : array of tSieveElement; procedure CompactPrimes; //searching for needed primes //last primes are marked with -1 var pSieve : tpSieve; i,lmt,dp:NativeInt; Begin setlength(Primes,74500);//suffices for primes to calc square upto 1e12 //extract difference of primes i := 2; lmt := 0; dp := 2; pSieve :=@sieve[0]; repeat IF pSieve[i]= 0 then Begin //mark for Moebius pSieve[i]:= -1; primes[lmt] := dp; dp := 0; inc(lmt); end; inc(dp); inc(i); until i*i >BigLimit; setlength(Primes,lmt+1); repeat IF pSieve[i]= 0 then //mark for Moebius pSieve[i]:= -1; inc(i); until i >BigLimit; end; procedure SieveSquares; //mark all powers >=2 of prime => all powers = 2 is sufficient var pSieve : tpSieve; i,sq,k,prime : NativeInt; Begin pSieve := @sieve[0]; prime := 0; For i := 0 to High(primes) do Begin prime := prime+primes[i]; sq := prime*prime; k := sq; if sq > BigLimit then break; repeat pSieve[k] := 0; inc(k,sq); until k> BigLimit; end; end; procedure initPrimes; var pSieve : tpSieve; fakt, sieveprime : NativeUint; begin pSieve := @sieve[0]; sieveprime := 2; repeat if pSieve[sieveprime]=0 then begin fakt := sieveprime+sieveprime; while fakt <=BigLimit do Begin //count divisors inc(pSieve[fakt]); inc(fakt,sieveprime); end; end; inc(sieveprime); until sieveprime>BigLimit DIV 2; //Möbius of 1 pSieve[1] := 1; //convert to Moebius For fakt := 2 to BigLimit do Begin sieveprime := pSieve[fakt]; IF sieveprime<>0 then pSieve[fakt] := 1-(2*(sieveprime AND 1)) ; end; CompactPrimes; SieveSquares; end; procedure OutMerten10(Lmt,ZeroCross:NativeInt;Const MoebVal:tMoebVal); var i,j: NativeInt; Begin Writeln(lmt:11,MoebVal[-1]:11,MoebVal[1]:11,MoebVal[-1]+MoebVal[1]:11, MoebVal[-1]-MoebVal[1]:7,MoebVal[0]:11); i:= low(MertensValues); while MertensValues[i] = 0 do inc(i); j:= High(MertensValues); while MertensValues[j] = 0 do dec(j); write('Merten min ',i:6,' max ',j:6,' zero''s ',MertensValues[0]:8); writeln(' zeroCross ',ZeroCross); writeln; end; procedure Count_x10; var MoebCount: tMoebVal; pSieve : tpSieve; i,lmt,Merten,Moebius,LastMert,ZeroCross: NativeInt; begin writeln('[1 to limit]'); Writeln('Limit Moeb. odd Moeb.even sqr-free Merten Zero''s'); pSieve := @sieve[0]; For i := -1 to 1 do MoebCount[i]:=0; ZeroCross := 0; LastMert :=1; Merten :=0; lmt := 10; i := 1; repeat while i <= lmt do Begin Moebius := pSieve[i]; inc(MoebCount[Moebius]); inc(Merten,Moebius); inc(MertensValues[Merten]);//MoebCount[1]-MoebCount[-1]]); inc(ZeroCross,ORD( (Merten = 0) AND (LastMert <> 0))); LastMert := Merten; inc(i); end; OutMerten10(Lmt,ZeroCross,MoebCount); IF lmt >= BigLimit then BREAK; lmt := lmt*10; IF lmt >BigLimit then lmt := BigLimit; until false; writeln; end; procedure OutMerten(lmt:NativeInt); var i,k,m : NativeInt; Begin iF lmt> BigLimit then lmt := BigLimit; writeln('Mertens numbers from 1 to ',lmt); k := 9; write('':3); m := 0; For i := 1 to lmt do Begin inc(m,sieve[i]); write(m:3); dec(k); IF k = 0 then Begin writeln; k := 10; end; end; writeln; end; procedure OutMoebius(lmt:NativeInt); var i,k : NativeInt; Begin iF lmt> BigLimit then lmt := BigLimit; writeln('Möbius numbers from 1 to ',lmt); k := 19; write('':3); For i := 1 to lmt do Begin write(sieve[i]:3); dec(k); IF k = 0 then Begin writeln; k := 20; end; end; writeln; end; Begin setlength(sieve,BigLimit+1); InitPrimes; SieveSquares; Count_x10; OutMoebius(199); OutMerten(99); setlength(primes,0); setlength(sieve,0); end.