sieve of eratosthenes

in pascal

Source Code

``````unit sieve;

interface

uses crt;

const
n = 50; { n cells }

type
Cell = Record
marked : Boolean; { True if a number is marked, false if not. }
number : Integer; { Number in cell }
end;

Row = Array[0..n] of Cell; { A row is an array of Cells }
PRow = ^Row;               { Pointer Type of Row }
procedure row_fill( var a_row : Row );
procedure row_print( var a_row : Row );
procedure row_mark( a_row : PRow ; p : Integer );
function row_lastnotmarked( a_row : Row ; p : Integer ) : Integer;
procedure row_solve( var a_row : Row );

implementation

{ row is filled of numbers from 2 to n+1 }
procedure row_fill( var a_row : Row );
var
i: Integer;
begin
for i := 0 to n-1 do
begin
a_row[i].number := i+2;
end;
end;

{ print a row as follow:
[ n-3 ], [ n-2 ], ... [ n ]

where a number not marked is white
and a marked is red.

when is printed i_ln cells in a row then
a new line is wrote
}
procedure row_print( var a_row : Row );
var
i: Integer;
i_ln: Integer = 4;
begin
for i:= 0 to n-1 do
begin
textColor(White);
if a_row[i].number < 10 then
write('[  ')
else
begin
write('[ ');
end;

if a_row[i].marked = True then
textColor(LightRed)
else
begin
textColor(White);
end;

write(a_row[i].number);
textColor(White);
write(' ], ');

if (i + 1) mod i_ln = 0 then
writeln;

end;
writeln;
end;

{ mark cells where number is a multiple of p }
procedure row_mark( a_row : PRow ; p : Integer );
var i : Integer;
begin
for i := 0 to n-1 do
begin
if a_row^[i].number mod p = 0 then
begin
if a_row^[i].number > p then
begin
a_row^[i].marked := True;
end;
end;
end;
end;

{ return the last number not marked greater than p }
function row_lastnotmarked( a_row : Row ; p : Integer ) : Integer;
var
i : Integer;
begin
for i := 0 to n-1 do
begin
if a_row[i].number > p then
begin
if a_row[i].marked = False then
begin
row_lastnotmarked := a_row[i].number;
break;
end;
end;
end;
end;

{ Solve Sieve of Eratosthenes.
Cells in Row that are not marked has prime numbers.
}
procedure row_solve( var a_row : Row );
var
i, p: Integer;
begin
p := 2; { first prime number }

for i := 0 to n-1 do
begin
{ determine when to stop marking }
if p * p > n then
begin
break;
end;

if a_row[i].number = p then
begin
row_mark( @a_row, p );
p := row_lastnotmarked( a_row, p);
end;
end;
end;

end.
``````
``````program sieve_test;

uses crt, sieve;

{ Compare Cells not marked
with given prime numbers
}
procedure check( a_row: Row ; prime_numbers : Array of Integer );
var
i : Integer;
j : Integer = 0;
begin
for i := 0 to n-1 do
begin
if j < Length(prime_numbers) then
begin
if a_row[i].marked = False then
begin
if a_row[i].number <> prime_numbers[j] then
begin
write(a_row[i].number);
writeln(' is not prime.');
exit;
end;
j := j + 1;
end;
end;
end;

write('OK, All cells not marked have primes.');
end;

var
a_row : Row;
begin
clrScr;

row_fill( a_row );
row_solve( a_row );
row_print( a_row );

{ first 1000 primes
https://primes.utm.edu/lists/small/1000.txt
}
check( a_row,
[ 2, 3, 5, 7,  11,  13,  17,  19,  23,  29
,  31,  37,  41,  43,  47,  53,  59,  61,  67,  71
,  73,  79,  83,  89,  97, 101, 103, 107, 109, 113
, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173
, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229
, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281
, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349
, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409
, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463
, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541
, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601
, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659
, 661, 673, 677, 683, 691, 701, 709, 719, 727, 733
, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809
, 811, 821, 823, 827, 829, 839, 853, 857, 859, 863
, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941
, 947, 953, 967, 971, 977, 983, 991, 997,1009,1013
,1019,1021,1031,1033,1039,1049,1051,1061,1063,1069
,1087,1091,1093,1097,1103,1109,1117,1123,1129,1151
,1153,1163,1171,1181,1187,1193,1201,1213,1217,1223
,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291
,1297,1301,1303,1307,1319,1321,1327,1361,1367,1373
,1381,1399,1409,1423,1427,1429,1433,1439,1447,1451
,1453,1459,1471,1481,1483,1487,1489,1493,1499,1511
,1523,1531,1543,1549,1553,1559,1567,1571,1579,1583
,1597,1601,1607,1609,1613,1619,1621,1627,1637,1657
,1663,1667,1669,1693,1697,1699,1709,1721,1723,1733
,1741,1747,1753,1759,1777,1783,1787,1789,1801,1811
,1823,1831,1847,1861,1867,1871,1873,1877,1879,1889
,1901,1907,1913,1931,1933,1949,1951,1973,1979,1987
,1993,1997,1999,2003,2011,2017,2027,2029,2039,2053
,2063,2069,2081,2083,2087,2089,2099,2111,2113,2129
,2131,2137,2141,2143,2153,2161,2179,2203,2207,2213
,2221,2237,2239,2243,2251,2267,2269,2273,2281,2287
,2293,2297,2309,2311,2333,2339,2341,2347,2351,2357
,2371,2377,2381,2383,2389,2393,2399,2411,2417,2423
,2437,2441,2447,2459,2467,2473,2477,2503,2521,2531
,2539,2543,2549,2551,2557,2579,2591,2593,2609,2617
,2621,2633,2647,2657,2659,2663,2671,2677,2683,2687
,2689,2693,2699,2707,2711,2713,2719,2729,2731,2741
,2749,2753,2767,2777,2789,2791,2797,2801,2803,2819
,2833,2837,2843,2851,2857,2861,2879,2887,2897,2903
,2909,2917,2927,2939,2953,2957,2963,2969,2971,2999
,3001,3011,3019,3023,3037,3041,3049,3061,3067,3079
,3083,3089,3109,3119,3121,3137,3163,3167,3169,3181
,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257
,3259,3271,3299,3301,3307,3313,3319,3323,3329,3331
,3343,3347,3359,3361,3371,3373,3389,3391,3407,3413
,3433,3449,3457,3461,3463,3467,3469,3491,3499,3511
,3517,3527,3529,3533,3539,3541,3547,3557,3559,3571
,3581,3583,3593,3607,3613,3617,3623,3631,3637,3643
,3659,3671,3673,3677,3691,3697,3701,3709,3719,3727
,3733,3739,3761,3767,3769,3779,3793,3797,3803,3821
,3823,3833,3847,3851,3853,3863,3877,3881,3889,3907
,3911,3917,3919,3923,3929,3931,3943,3947,3967,3989
,4001,4003,4007,4013,4019,4021,4027,4049,4051,4057
,4073,4079,4091,4093,4099,4111,4127,4129,4133,4139
,4153,4157,4159,4177,4201,4211,4217,4219,4229,4231
,4241,4243,4253,4259,4261,4271,4273,4283,4289,4297
,4327,4337,4339,4349,4357,4363,4373,4391,4397,4409
,4421,4423,4441,4447,4451,4457,4463,4481,4483,4493
,4507,4513,4517,4519,4523,4547,4549,4561,4567,4583
,4591,4597,4603,4621,4637,4639,4643,4649,4651,4657
,4663,4673,4679,4691,4703,4721,4723,4729,4733,4751
,4759,4783,4787,4789,4793,4799,4801,4813,4817,4831
,4861,4871,4877,4889,4903,4909,4919,4931,4933,4937
,4943,4951,4957,4967,4969,4973,4987,4993,4999,5003
,5009,5011,5021,5023,5039,5051,5059,5077,5081,5087
,5099,5101,5107,5113,5119,5147,5153,5167,5171,5179
,5189,5197,5209,5227,5231,5233,5237,5261,5273,5279
,5281,5297,5303,5309,5323,5333,5347,5351,5381,5387
,5393,5399,5407,5413,5417,5419,5431,5437,5441,5443
,5449,5471,5477,5479,5483,5501,5503,5507,5519,5521
,5527,5531,5557,5563,5569,5573,5581,5591,5623,5639
,5641,5647,5651,5653,5657,5659,5669,5683,5689,5693
,5701,5711,5717,5737,5741,5743,5749,5779,5783,5791
,5801,5807,5813,5821,5827,5839,5843,5849,5851,5857
,5861,5867,5869,5879,5881,5897,5903,5923,5927,5939
,5953,5981,5987,6007,6011,6029,6037,6043,6047,6053
,6067,6073,6079,6089,6091,6101,6113,6121,6131,6133
,6143,6151,6163,6173,6197,6199,6203,6211,6217,6221
,6229,6247,6257,6263,6269,6271,6277,6287,6299,6301
,6311,6317,6323,6329,6337,6343,6353,6359,6361,6367
,6373,6379,6389,6397,6421,6427,6449,6451,6469,6473
,6481,6491,6521,6529,6547,6551,6553,6563,6569,6571
,6577,6581,6599,6607,6619,6637,6653,6659,6661,6673
,6679,6689,6691,6701,6703,6709,6719,6733,6737,6761
,6763,6779,6781,6791,6793,6803,6823,6827,6829,6833
,6841,6857,6863,6869,6871,6883,6899,6907,6911,6917
,6947,6949,6959,6961,6967,6971,6977,6983,6991,6997
,7001,7013,7019,7027,7039,7043,7057,7069,7079,7103
,7109,7121,7127,7129,7151,7159,7177,7187,7193,7207
,7211,7213,7219,7229,7237,7243,7247,7253,7283,7297
,7307,7309,7321,7331,7333,7349,7351,7369,7393,7411
,7417,7433,7451,7457,7459,7477,7481,7487,7489,7499
,7507,7517,7523,7529,7537,7541,7547,7549,7559,7561
,7573,7577,7583,7589,7591,7603,7607,7621,7639,7643
,7649,7669,7673,7681,7687,7691,7699,7703,7717,7723
,7727,7741,7753,7757,7759,7789,7793,7817,7823,7829
,7841,7853,7867,7873,7877,7879,7883,7901,7907,7919 ]  );