Sieve of Pritchard: Difference between revisions

m
m (→‎{{header|Pascal}}: fpc 3.2.2 does the job. My old fpc 3.3.1 can't run " SetLength( smallPrimes, SP_STEP);" , maybe installation problem.)
Line 31:
if (limit < 2) then return {}
script o
property primeswheel : {2}
property wheelextension : {1,missing 2}value
end script
set {oldCircumference, circumference} to {missing value, count o's wheel}
set {x, newCircumference, currentPrime, mv} to {0, 2, 1, missing value}
set prime to 1
repeat until (primecurrentPrime * primecurrentPrime > limit)
-- Get the lowestnext primeconfirmed currentlyprime infrom the wheel.
set primex to o'sx wheel's+ second item1
set endcurrentPrime ofto o's primeswheel's toitem primex
-- ExpandGet thean wheel'sextension circumferencelist tonominally prime timesexpanding the currentwheel value.to Populatethe with thelesser existingof
-- numbers added to multiples of theits current circumference, omitting* multiplescurrentPrime ofand the primelimit parameter.
-- It'll be far longer than needed, but hey.
set oldCircumference to circumference
set searchLimitoldCircumference to (count o's wheel)newCircumference
set circumferencenewCircumference to oldCircumference * primecurrentPrime
if (circumferencenewCircumference > limit) then set circumferencenewCircumference to limit
set o's extension to makeList(newCircumference - oldCircumference, mv)
repeat with augend from oldCircumference to (circumference - 1) by oldCircumference
-- Insert numbers that repeatare witholdCircumference iadded fromto 1 and to searchLimiteach number currently in the
-- unpartitioned part of the wheel, except where the results are multiples of currentPrime.
set k to 0
set listLen to (count o's wheel)
repeat with augend from oldCircumference to (circumferencenewCircumference - 1) by oldCircumference
set n to augend + 1
if (n mod currentPrime > 0) then
set k to k + 1
set o's extension's item k to n
end if
repeat with i from x to listLen
set n to augend + (o's wheel's item i)
if (n > circumferencenewCircumference) then exit repeat
if (n mod primecurrentPrime > 0) then set end of o's wheel to n
set k to k + 1
set o's extension's item k to n
end if
end repeat
end repeat
-- Find and delete multiples of the current prime occurringwhich occur in the old part of the wheel.
set maxCompFactormaxMultiple to oldCircumference div primecurrentPrime
set i to 2x
repeat while ((o's wheel's item i) < maxCompFactormaxMultiple)
set i to i + 1
end repeat
repeat with i from i to 1x by -1
set j to binarySearch((o's wheel's item i) * primecurrentPrime, o's wheel, i, searchLimitlistLen)
if (j > 0) then
set o's wheel's item j to missing valuemv
set searchLimitlistLen to j - 1
end if
end repeat
-- Keep the undeleted numbers and any in the extension list.
set o's wheel to o's wheel's numbers
if (k > 0) then set o's wheel to o's wheel & o's extension's items 1 thru k
end repeat
return o's primes & rest of o's wheel
end sieveOfPritchard
 
on makeList(limit, filler)
if (limit < 1) then return {}
script o
property lst : {filler}
end script
set primecounter to 1
repeat until (counter + counter > limit)
set o's lst to o's lst & o's lst
set counter to counter + counter
end repeat
if (counter < limit) then set o's lst to o's lst & o's lst's items 1 thru (limit - counter)
return o's lst
end makeList
 
on binarySearch(n, theList, l, r)
Line 79 ⟶ 108:
repeat until (l = r)
set m to (l + r) div 2
if (item m of o's lst's item m < n) then
set l to m + 1
else
Line 86 ⟶ 115:
end repeat
if (item l of o's lst's item l is n) then return l
return 0
end binarySearch
557

edits