def char2value(c):
  assert c not in 'AEIOU', "No vowels"
  return int(c, 36)

sedolweight = [1,3,1,7,3,9]

def checksum(sedol):
    tmp = sum(map(lambda ch, weight: char2value(ch) * weight,
                  sedol, sedolweight)
               )
    return str((10 - (tmp % 10)) % 10)

for sedol in '''
    710889
    B0YBKJ
    406566
    B0YBLH
    228276
    B0YBKL
    557910
    B0YBKR
    585284
    B0YBKT
    '''.split():
    print sedol + checksum(sedol)


: prime? ( n -- ? ) here + [email protected] 0= ;
: composite! ( n -- ) here + 1 swap c! ;

: sieve ( n -- )
  here over erase
  2
  begin
    2dup dup * >
  while
    dup prime? if
      2dup dup * do
        i composite!
      dup +loop
    then
    1+
  repeat
  drop
  ." Primes: " 2 do i prime? if i . then loop ;

100 sieve


#include <iomanip>
#include <iostream>

int prime_factor_sum(int n) {
    int sum = 0;
    for (; (n & 1) == 0; n >>= 1)
        sum += 2;
    for (int p = 3, sq = 9; sq <= n; p += 2) {
        for (; n % p == 0; n /= p)
            sum += p;
        sq += (p + 1) << 2;
    }
    if (n > 1)
        sum += n;
    return sum;
}

int prime_divisor_sum(int n) {
    int sum = 0;
    if ((n & 1) == 0) {
        sum += 2;
        n >>= 1;
        while ((n & 1) == 0)
            n >>= 1;
    }
    for (int p = 3, sq = 9; sq <= n; p += 2) {
        if (n % p == 0) {
            sum += p;
            n /= p;
            while (n % p == 0)
                n /= p;
        }
        sq += (p + 1) << 2;
    }
    if (n > 1)
        sum += n;
    return sum;
}

int main() {
    const int limit = 30;
    int dsum1 = 0, fsum1 = 0, dsum2 = 0, fsum2 = 0;

    std::cout << "First " << limit << " Ruth-Aaron numbers (factors):\n";
    for (int n = 2, count = 0; count < limit; ++n) {
        fsum2 = prime_factor_sum(n);
        if (fsum1 == fsum2) {
            ++count;
            std::cout << std::setw(5) << n - 1
                      << (count % 10 == 0 ? '\n' : ' ');
        }
        fsum1 = fsum2;
    }

    std::cout << "\nFirst " << limit << " Ruth-Aaron numbers (divisors):\n";
    for (int n = 2, count = 0; count < limit; ++n) {
        dsum2 = prime_divisor_sum(n);
        if (dsum1 == dsum2) {
            ++count;
            std::cout << std::setw(5) << n - 1
                      << (count % 10 == 0 ? '\n' : ' ');
        }
        dsum1 = dsum2;
    }

    dsum1 = 0, fsum1 = 0, dsum2 = 0, fsum2 = 0;
    for (int n = 2;; ++n) {
        int fsum3 = prime_factor_sum(n);
        if (fsum1 == fsum2 && fsum2 == fsum3) {
            std::cout << "\nFirst Ruth-Aaron triple (factors): " << n - 2
                      << '\n';
            break;
        }
        fsum1 = fsum2;
        fsum2 = fsum3;
    }
    for (int n = 2;; ++n) {
        int dsum3 = prime_divisor_sum(n);
        if (dsum1 == dsum2 && dsum2 == dsum3) {
            std::cout << "\nFirst Ruth-Aaron triple (divisors): " << n - 2
                      << '\n';
            break;
        }
        dsum1 = dsum2;
        dsum2 = dsum3;
    }
}


function findIn(%haystack,%needles)
{
	%hc = getWordCount(%haystack);
	%nc = getWordCount(%needles);

	for(%i=0;%i<%nc;%i++)
	{
		%nword = getWord(%needles,%i);
		%index[%nword] = -1;
	}

	for(%i=0;%i<%hc;%i++)
	{
		%hword = getWord(%haystack,%i);

		for(%j=0;%j<%nc;%j++)
		{
			%nword = getWord(%needles,%j);

			if(%hword $= %nword)
			{
				%index[%nword] = %i;
			}
		}
	}

	for(%i=0;%i<%nc;%i++)
	{
		%nword = getWord(%needles,%i);
		%string = %string SPC %[email protected]"_"@%index[%nword];
		%string = trim(%string);
	}

	return %string;
}


$$ MODE TUSCRIPT
SET haystack="Zig'Zag'Wally'Ronald'Bush'Krusty'Charlie'Bush'Bozo"
PRINT "haystack=",haystack
LOOP needle="Washington'Bush'Wally"
SET table  =QUOTES (needle)
BUILD S_TABLE needle = table
 IF (haystack.ct.needle) THEN
  BUILD R_TABLE needle = table
  SET position=FILTER_INDEX(haystack,needle,-)
  RELEASE R_TABLE needle
  PRINT "haystack contains ", needle, " on position(s): ",position
 ELSE
  PRINT "haystack not contains ",needle
 ENDIF
RELEASE S_TABLE needle
ENDLOOP


if [ $1 ];then
haystack="Zip Zag Wally Ronald Bush Krusty Charlie Bush Bozo"

index=$(echo $haystack|tr " " "\n"|grep -in "^$1$")
if [ $? = 0 ];then
quantity_of_hits=$(echo $index|tr " " "\n"|wc -l|tr -d " ")
first_index=$(echo $index|cut -f 1 -d ":")
if [ $quantity_of_hits = 1 ];then
echo The sole index for $1 is: $first_index
else
echo The smallest index for $1 is: $first_index
greatest_index=$(echo $index|tr " " "\n"|tail -1|cut -f 1 -d ":")
echo "The greatest index for $1 is: $greatest_index";fi
else echo $1 is absent from haystatck.;fi
else echo Must provide string to find in haystack.;fi


# Read in data from text connection
datalines <- readLines(tc <- textConnection("710889
B0YBKJ
406566
B0YBLH
228276
B0YBKL
557910
B0YBKR
585284
B0YBKT")); close(tc)

# Check data valid
checkSedol <- function(datalines)
{
   ok <- grep("^[[:digit:][:upper:]]{6}$", datalines)
   if(length(ok) < length(datalines))
   {
      stop("there are invalid lines")
   }
}
checkSedol(datalines)

# Append check digit
appendCheckDigit <- function(x)
{
   if(length(x) > 1) return(sapply(x, appendCheckDigit))
   ascii <- as.integer(charToRaw(x))
   scores <- ifelse(ascii < 65, ascii - 48, ascii - 55)
   weights <- c(1, 3, 1, 7, 3, 9)
   chkdig <- (10 - sum(scores * weights) %% 10) %% 10
   paste(x, as.character(chkdig), sep="")
}
withchkdig <- appendCheckDigit(datalines)

#Print in format requested
writeLines(withchkdig)


program sieve

  implicit none
  integer, parameter :: i_max = 100
  integer :: i
  logical, dimension (i_max) :: is_prime

  is_prime = .true.
  is_prime (1) = .false.
  do i = 2, int (sqrt (real (i_max)))
    if (is_prime (i)) is_prime (i * i : i_max : i) = .false.
  end do
  do i = 1, i_max
    if (is_prime (i)) write (*, '(i0, 1x)', advance = 'no') i
  end do
  write (*, *)

end program sieve


USING: assocs.extras grouping io kernel lists lists.lazy math
math.primes.factors prettyprint ranges sequences ;

: pair-same? ( ... n quot: ( ... m -- ... n ) -- ... ? )
    [ dup 1 + ] dip same? ; inline

: RA-f? ( n -- ? ) [ factors sum ] pair-same? ;
: RA-d? ( n -- ? ) [ group-factors sum-keys ] pair-same? ;
: filter-naturals ( quot -- list ) 1 lfrom swap lfilter ; inline
: RA-f ( -- list ) [ RA-f? ] filter-naturals ;
: RA-d ( -- list ) [ RA-d? ] filter-naturals ;

: list. ( list -- )
    30 swap ltake list>array 10 group simple-table. ;

"First 30 Ruth-Aaron numbers (factors):" print
RA-f list. nl

"First 30 Ruth-Aaron numbers (divisors):" print
RA-d list.


package main

import (
    "fmt"
    "rcu"
)

func prune(a []int) []int {
    prev := a[0]
    b := []int{prev}
    for i := 1; i < len(a); i++ {
        if a[i] != prev {
            b = append(b, a[i])
            prev = a[i]
        }
    }
    return b
}

func main() {
    var resF, resD, resT, factors1 []int
    factors2 := []int{2}
    factors3 := []int{3}
    var sum1, sum2, sum3 int = 0, 2, 3
    var countF, countD, countT int
    for n := 2; countT < 1 || countD < 30 || countF < 30; n++ {
        factors1 = factors2
        factors2 = factors3
        factors3 = rcu.PrimeFactors(n + 2)
        sum1 = sum2
        sum2 = sum3
        sum3 = rcu.SumInts(factors3)
        if countF < 30 && sum1 == sum2 {
            resF = append(resF, n)
            countF++
        }
        if sum1 == sum2 && sum2 == sum3 {
            resT = append(resT, n)
            countT++
        }
        if countD < 30 {
            factors4 := make([]int, len(factors1))
            copy(factors4, factors1)
            factors5 := make([]int, len(factors2))
            copy(factors5, factors2)
            factors4 = prune(factors4)
            factors5 = prune(factors5)
            if rcu.SumInts(factors4) == rcu.SumInts(factors5) {
                resD = append(resD, n)
                countD++
            }
        }
    }
    fmt.Println("First 30 Ruth-Aaron numbers (factors):")
    fmt.Println(resF)
    fmt.Println("\nFirst 30 Ruth-Aaron numbers (divisors):")
    fmt.Println(resD)
    fmt.Println("\nFirst Ruth-Aaron triple (factors):")
    fmt.Println(resT[0])

    resT = resT[:0]
    factors1 = factors1[:0]
    factors2 = factors2[:1]
    factors2[0] = 2
    factors3 = factors3[:1]
    factors3[0] = 3
    countT = 0
    for n := 2; countT < 1; n++ {
        factors1 = factors2
        factors2 = factors3
        factors3 = prune(rcu.PrimeFactors(n + 2))
        sum1 = sum2
        sum2 = sum3
        sum3 = rcu.SumInts(factors3)
        if sum1 == sum2 && sum2 == sum3 {
            resT = append(resT, n)
            countT++
        }
    }
    fmt.Println("\nFirst Ruth-Aaron triple (divisors):")
    fmt.Println(resT[0])
}


#import std

indices = ||<'missing'>!% ~&nSihzXB+ ~&lrmPE~|^|/~& num


Function IsInArray(stringToBeFound As Variant, arr As Variant, _
    Optional start As Integer = 1, Optional reverse As Boolean = False) As Long
'Adapted from https://stackoverflow.com/questions/12414168/use-of-custom-data-types-in-vba
    Dim i As Long, lo As Long, hi As Long, stp As Long
    ' default return value if value not found in array
    IsInArray = -1
    If reverse Then
        lo = UBound(arr): hi = start: stp = -1
    Else
        lo = start: hi = UBound(arr): stp = 1
    End If
    For i = lo To hi Step stp 'start in stead of LBound(arr)
        If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
            IsInArray = i
            Exit For
        End If
    Next i
End Function
Public Sub search_a_list()
    Dim haystack() As Variant, needles() As Variant
    haystack = [{"Zig","Zag","Wally","Ronald","Bush","Krusty","Charlie","Bush","Bozo"}]
    needles = [{"Washington","Bush"}]
    For i = 1 To 2
        If IsInArray(needles(i), haystack) = -1 Then
            Debug.Print needles(i); " not found in haystack."
        Else
            Debug.Print needles(i); " is at position "; CStr(IsInArray(needles(i), haystack)); ".";
            Debug.Print " And last position is ";
            Debug.Print CStr(IsInArray(needles(i), haystack, 1, True)); "."
        End If
    Next i
End Sub


data = "foo,bar,baz,quux,quuux,quuuux,bazola,ztesch,foo,bar,thud,grunt," &_
		"foo,bar,bletch,foo,bar,fum,fred,jim,sheila,barney,flarp,zxc," &_
		"spqr,wombat,shme,foo,bar,baz,bongo,spam,eggs,snork,foo,bar," &_
		"zot,blarg,wibble,toto,titi,tata,tutu,pippo,pluto,paperino,aap," &_
		"noot,mies,oogle,foogle,boogle,zork,gork,bork"

haystack = Split(data,",")

Do
	WScript.StdOut.Write "Word to search for? (Leave blank to exit) "
	needle = WScript.StdIn.ReadLine
	If needle <> "" Then
		found = 0
		For i = 0 To UBound(haystack)
			If UCase(haystack(i)) = UCase(needle) Then
				found = 1
				WScript.StdOut.Write "Found " & Chr(34) & needle & Chr(34) & " at index " & i
				WScript.StdOut.WriteLine
			End If
		Next
		If found < 1 Then
			WScript.StdOut.Write Chr(34) & needle & Chr(34) & " not found."
			WScript.StdOut.WriteLine
		End If
	Else
		Exit do
	End If
Loop


#lang racket
;;; Since the Task gives us unchecksummed and checksummed SEDOLs, and
;;; we'll just take a list of the output SEDOLs and remove their last
;;; characters for the input
(define output-SEDOLS
  (list "7108899" "B0YBKJ7" "4065663"
        "B0YBLH2" "2282765" "B0YBKL9"
        "5579107" "B0YBKR5" "5852842"
        "B0YBKT7" "B000300"))
(define (output->input-SEDOL S) (substring S 0 6))
(define input-SEDOLS (map output->input-SEDOL output-SEDOLS))

;;; checksum calculation
(define (SEDOL-character-value c)
  (if (char-numeric? c)
      (- (char->integer c) (char->integer #\0))
      (+ 10 (- (char->integer c) (char->integer #\A)))))
(define (SEDOL-character-sum S)
  (for/sum ((c S)  ; if we run out of c's before the final 1 in weight, we'll have the unchecksummed weighted sum
            (weight (in-list '(1 3 1 7 3 9 1))))
    (* weight (SEDOL-character-value c))))
(define (SEDOL-checksum S) (number->string (modulo (- 10 (SEDOL-character-sum S)) 10)))

;;; build output from input
(define (SEDOL-append-checksum S) (string-append S (SEDOL-checksum S)))

;;; Extra credit -- according to wikipedia:
;;; "SEDOLs are seven characters in length"
;;; "vowels are never used"
;;; there seems to be no statement as to case, but we'll assert that too!
;;;
;;; valid-SEDOL? is a predicate... it doesn't report a reason
(define (invalid-SEDOL? S)
  (define (invalid-SEDOL-character? c)
    (if
     (and (not (char-upper-case? c)) (not (char-numeric? c)))
     (format "contains non upper case/non numeric ~a" c)
     (case c [(#\A #\E #\I #\O #\U) (format "contains vowel ~a" c)] [else #f])))
  (cond
    [(< (string-length S) 7) "too few characters"]
    [(> (string-length S) 7) "too many characters"]
    [(not (zero? (modulo (SEDOL-character-sum S) 10))) "invalid checksum"]
    [(for/first ((c S) #:when (invalid-SEDOL-character? c)) c) => identity]
    [else #f])) ; a.k.a. valid!

(module+ main
  (for* ((S input-SEDOLS))
    (displayln (SEDOL-append-checksum S)))
  (newline)
  (displayln "Extra Credit!")
  (displayln (invalid-SEDOL? "B0YBKT7")) ; expect #f output
  (displayln (invalid-SEDOL? "B000301")) ; expect "invalid checksum" output
  )

(module+ test
  (require rackunit)
  (check-= (SEDOL-character-value #\3) 3 0)
  (check-= (SEDOL-character-value #\B) 11 0)
  (check-equal? (invalid-SEDOL? "B000301") "invalid checksum")
  (for ((S output-SEDOLS))
    (check-false (invalid-SEDOL? S))
    (check-equal? (SEDOL-append-checksum (substring S 0 6))
                  S (format "test SEDOL for ~a" S))))


sub sedol( Str $s ) {
    die 'No vowels allowed' if $s  ~~ /<[AEIOU]>/;
    die 'Invalid format'    if $s !~~ /^ <[0..9B..DF..HJ..NP..TV..Z]>**6 $ /;

    my %base36 = (flat 0..9, 'A'..'Z') »=>« ^36;
    my @weights = 1, 3, 1, 7, 3, 9;

    my @vs = %base36{ $s.comb };
    my $checksum = [+] @vs Z* @weights;
    my $check_digit = (10 - $checksum % 10) % 10;
    return $s ~ $check_digit;
}

say sedol($_) for <
    710889
    B0YBKJ
    406566
    B0YBLH
    228276
    B0YBKL
    557910
    B0YBKR
    585284
    B0YBKT
    B00030
>;


         ╔════════════════════════════════════════════════════════════════════╗
         ║  If the SEDOL is 6 characters, a check digit is added.             ║
         ║                                                                    ║
         ║  If the SEDOL is 7 characters, a check digit is created and it's   ║
         ║  verified that it's equal to the check digit already on the SEDOL. ║
         ╚════════════════════════════════════════════════════════════════════╝


program prime_sieve;
{$mode objfpc}{$coperators on}
uses
  SysUtils, GVector;
type
  TPrimeList = specialize TVector<DWord>;
function Sieve(aLimit: DWord): TPrimeList;
var
  IsPrime: array of Boolean;
  I, SqrtBound: DWord;
  J: QWord;
begin
  Result := TPrimeList.Create;
  Inc(aLimit, Ord(aLimit < High(DWord))); //not a problem because High(DWord) is composite
  SetLength(IsPrime, aLimit);
  FillChar(Pointer(IsPrime)^, aLimit, Byte(True));
  SqrtBound := Trunc(Sqrt(aLimit));
  for I := 2 to aLimit do
    if IsPrime[I] then
      begin
        Result.PushBack(I);
        if I <= SqrtBound then
          begin
            J := I * I;
            repeat
              IsPrime[J] := False;
              J += I;
            until J > aLimit;
          end;
      end;
end;

 //usage

var
  Limit: DWord = 0;
function ReadLimit: Boolean;
var
  Lim: Int64;
begin
  if (ParamCount = 1) and Lim.TryParse(ParamStr(1), Lim) then
    if (Lim >= 0) and (Lim <= High(DWord)) then
      begin
        Limit := DWord(Lim);
        exit(True);
      end;
  Result := False;
end;
procedure PrintUsage;
begin
  WriteLn('Usage: prime_sieve Limit');
  WriteLn('  where Limit in the range [0, ', High(DWord), ']');
  Halt;
end;
procedure PrintPrimes(aList: TPrimeList);
var
  I: DWord;
begin
  for I := 0 to aList.Size - 2 do
    Write(aList[I], ', ');
  WriteLn(aList[aList.Size - 1]);
  aList.Free;
end;
begin
  if not ReadLimit then
    PrintUsage;
  try
    PrintPrimes(Sieve(Limit));
  except
    on e: Exception do
      WriteLn('An exception ', e.ClassName, ' occurred with message: ', e.Message);
  end;
end.


import qualified Data.Set as S
import Data.List.Split ( chunksOf )

divisors :: Int -> [Int]
divisors n = [d | d <- [2 .. n] , mod n d == 0]

--for obvious theoretical reasons the smallest divisor of a number bare 1
--must be prime
primeFactors :: Int -> [Int]
primeFactors n = snd $ until ( (== 1) . fst ) step (n , [] )
 where
  step :: (Int , [Int] ) -> (Int , [Int] )
  step (n , li) = ( div n h , li ++ [h] )
   where
    h :: Int
    h = head $ divisors n

primeDivisors :: Int -> [Int]
primeDivisors n = S.toList $ S.fromList $ primeFactors n

solution :: (Int -> [Int] ) -> [Int]
solution f = snd $ until ( (== 30 ) . length . snd ) step ([2 , 3] , [] )
 where
  step :: ([Int] , [Int] ) -> ([Int] , [Int])
  step ( neighbours , ranums ) =  ( map ( + 1 ) neighbours , if (sum $ f
   $ head neighbours ) == (sum $ f $ last neighbours) then
   ranums ++ [ head neighbours ] else ranums )

formatNumber :: Int -> String -> String
formatNumber width num
   |width > l = replicate ( width -l ) ' ' ++ num
   |width == l = num
   |width < l = num
    where
     l = length num

main :: IO ( )
main = do
   let ruth_aaron_pairs = solution primeFactors
       maxlen = length $ show $ last ruth_aaron_pairs
       numberlines = chunksOf 8 $ map show ruth_aaron_pairs
       ruth_aaron_divisors = solution primeDivisors
       maxlen2 = length $ show $ last ruth_aaron_divisors
       numberlines2 = chunksOf 8 $ map show ruth_aaron_divisors
       putStrLn "First 30 Ruth-Aaaron numbers ( factors ) :"
   mapM_ (\nlin -> putStrLn $ foldl1 ( ++ ) $ map (\st -> formatNumber (maxlen + 2) st )
    nlin ) numberlines
   putStrLn " "
   putStrLn "First 30 Ruth-Aaron numbers( divisors ):"
   mapM_ (\nlin -> putStrLn $ foldl1 ( ++ ) $ map (\st -> formatNumber (maxlen2 + 2) st )
    nlin ) numberlines2


def (pos x (seq | (head ... tail)) n)
  default n :to 0
  if seq
    if (head = x)
      n
      (pos x tail n+1)


import "/seq" for Lst

var find = Fn.new { |haystack, needle|
    var res = Lst.indicesOf(haystack, needle)
    if (!res[0]) Fiber.abort("Needle not found in haystack.")
    System.print("The needle occurs %(res[1]) time(s) in the haystack.")
    if (res[1] == 1) {
        System.print("It occurs at index %(res[2][0])")
    } else {
        System.print("It first occurs at index %(res[2][0])")
        System.print("It last  occurs at index %(res[2][-1])")
    }
    System.print()
}

var haystack = ["Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Boz", "Zag"]
System.print("The haystack is:\n%(haystack)\n")
var needles = ["Wally", "Bush", "Zag", "George"]
for (needle in needles) {
    System.print("The needle is %(needle).")
    find.call(haystack, needle)
}


see sedol("710889") + nl
see sedol("B0YBKJ") + nl
see sedol("406566") + nl
see sedol("B0YBLH") + nl
see sedol("228276") + nl
see sedol("B0YBKL") + nl
see sedol("557910") + nl
see sedol("B0YBKR") + nl
see sedol("585284") + nl
see sedol("B0YBKT") + nl
see sedol("B00030") + nl

func sedol d
     d = upper(d)
     s = 0
     weights  = [1, 3, 1, 7, 3, 9]
     for i = 1 to 6
         a = substr(d,i,1)
         if ascii(a) >= 48 and ascii(a) <= 57
            s += number(a) * weights[i]
         else
            s += (ascii(a) - 55) * weights[i] ok
     next
     return d + (10 - (s % 10)) % 10


Sedol_char = "0123456789BCDFGHJKLMNPQRSTVWXYZ"
Sedolweight = [1,3,1,7,3,9]

def char2value(c)
  raise ArgumentError, "Invalid char #{c}" unless Sedol_char.include?(c)
  c.to_i(36)
end

def checksum(sedol)
  raise ArgumentError, "Invalid length" unless sedol.size == Sedolweight.size
  sum = sedol.chars.zip(Sedolweight).sum{|ch, weight| char2value(ch) * weight }
  ((10 - (sum % 10)) % 10).to_s
end

data = %w(710889
          B0YBKJ
          406566
          B0YBLH
          228276
          B0YBKL
          557910
          B0YBKR
          585284
          B0YBKT
          B00030
          C0000
          1234567
          00000A)

data.each do |sedol|
  print "%-8s " % sedol
  begin
    puts sedol + checksum(sedol)
  rescue => e
    p e
  end
end


fn sedol(input: &str) -> Option<String> {
    let weights = vec![1, 3, 1, 7, 3, 9, 1];
    let valid_chars = "0123456789BCDFGHJKLMNPQRSTVWXYZ";

    if input.len() != 6 {
        return None;
    }

    // could be done by regex if needed
    for c in input.chars() {
        if !valid_chars.contains(c) {
            return None;
        }
    }

    let mut result: u32 = input
        .chars()
        .map(|c| {
            if c.is_digit(10) {
                c as u32 - 48
            } else {
                c as u32 - 55
            }
        })
        .zip(weights)
        .map(|(cnum, w)| w * cnum)
        .collect::<Vec<u32>>()
        .iter()
        .sum();

    result = (10 - result % 10) % 10;

    Some(input.to_owned() + &result.to_string())
}

fn main() {
    let inputs = vec![
        "710889", "B0YBKJ", "406566", "B0YBLH", "228276", "B0YBKL", "557910", "B0YBKR", "585284",
        "B0YBKT", "B00030",
    ];

    for input in inputs {
        println!("{} SEDOL: {:?}", &input, sedol(&input).unwrap());
    }
}


' FB 1.05.0

Sub sieve(n As Integer)
  If n < 2 Then Return
  Dim a(2 To n) As Integer
  For i As Integer = 2 To n : a(i) = i : Next
  Dim As Integer p = 2, q
  ' mark non-prime numbers by setting the corresponding array element to 0
  Do
    For j As Integer = p * p To n Step p
      a(j) = 0
    Next j
    ' look for next non-zero element in array after 'p'
    q = 0
    For j As Integer = p + 1 To Sqr(n)
      If a(j) <> 0 Then
        q = j
        Exit For
      End If
    Next j
    If q = 0 Then Exit Do
    p = q
  Loop

  ' print the non-zero numbers remaining i.e. the primes
  For i As Integer = 2 To n
    If a(i) <> 0 Then
      Print Using "####"; a(i);
    End If
  Next
  Print
End Sub

Print "The primes up to 1000 are :"
Print
sieve(1000)
Print
Print "Press any key to quit"
Sleep


using Lazy
using Primes

sumprimedivisors(n) = sum([p[1] for p in factor(n)])
ruthaaron(n) = sumprimedivisors(n) == sumprimedivisors(n + 1)
ruthaarontriple(n) = sumprimedivisors(n) == sumprimedivisors(n + 1) ==
   sumprimedivisors(n + 2)

sumprimefactors(n) = sum([p[1] * p[2] for p in factor(n)])
ruthaaronfactors(n) = sumprimefactors(n) == sumprimefactors(n + 1)
ruthaaronfactorstriple(n) = sumprimefactors(n) == sumprimefactors(n + 1) ==
   sumprimefactors(n + 2)

raseq = @>> Lazy.range() filter(ruthaaron)
rafseq = @>> Lazy.range() filter(ruthaaronfactors)

println("30 Ruth Aaron numbers:")
foreach(p -> print(lpad(p[2], 6), p[1] % 10 == 0 ? "\n" : ""),
   enumerate(collect(take(30, raseq))))

println("\n30 Ruth Aaron factor numbers:")
foreach(p -> print(lpad(p[2], 6), p[1] % 10 == 0 ? "\n" : ""),
   enumerate(collect(take(30, rafseq))))

println("\nRuth Aaron triple starts at: ", findfirst(ruthaarontriple, 1:100000000))
println("\nRuth Aaron factor triple starts at: ", findfirst(ruthaaronfactorstriple, 1:10000000))


program RuthAaronNumb;
// gets factors of consecutive integers fast
// limited to 1.2e11
{$IFDEF FPC}
  {$MODE DELPHI}  {$OPTIMIZATION ON,ALL}  {$COPERATORS ON}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,
  strutils //Numb2USA
{$IFDEF WINDOWS},Windows{$ENDIF}
  ;
//######################################################################
//prime decomposition
const
//HCN(86) > 1.2E11 = 128,501,493,120     count of divs = 4096   7 3 1 1 1 1 1 1 1
  HCN_DivCnt  = 4096;
  //used odd size for test only
  SizePrDeFe = 32768;//*72 <= 64kb level I or 2 Mb ~ level 2 cache
type
  tItem     = Uint64;
  tDivisors = array [0..HCN_DivCnt] of tItem;
  tpDivisor = pUint64;

  tdigits = array [0..31] of Uint32;
  //the first number with 11 different prime factors =
  //2*3*5*7*11*13*17*19*23*29*31 = 2E11
  //56 byte
  tprimeFac = packed record
                 pfSumOfDivs,
                 pfRemain  : Uint64;
                 pfDivCnt  : Uint32;
                 pfMaxIdx  : Uint32;
                 pfpotPrimIdx : array[0..9] of word;
                 pfpotMax  : array[0..11] of byte;
               end;
  tpPrimeFac = ^tprimeFac;

  tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;
  tPrimes = array[0..65535] of Uint32;

var
  {$ALIGN 8}
  SmallPrimes: tPrimes;
  {$ALIGN 32}
  PrimeDecompField :tPrimeDecompField;
  pdfIDX,pdfOfs: NativeInt;

procedure InitSmallPrimes;
//get primes. #0..65535.Sieving only odd numbers
const
  MAXLIMIT = (821641-1) shr 1;
var
  pr : array[0..MAXLIMIT] of byte;
  p,j,d,flipflop :NativeUInt;
Begin
  SmallPrimes[0] := 2;
  fillchar(pr[0],SizeOf(pr),#0);
  p := 0;
  repeat
    repeat
      p +=1
    until pr[p]= 0;
    j := (p+1)*p*2;
    if j>MAXLIMIT then
      BREAK;
    d := 2*p+1;
    repeat
      pr[j] := 1;
      j += d;
    until j>MAXLIMIT;
  until false;

  SmallPrimes[1] := 3;
  SmallPrimes[2] := 5;
  j := 3;
  d := 7;
  flipflop := (2+1)-1;//7+2*2,11+2*1,13,17,19,23
  p := 3;
  repeat
    if pr[p] = 0 then
    begin
      SmallPrimes[j] := d;
      inc(j);
    end;
    d += 2*flipflop;
    p+=flipflop;
    flipflop := 3-flipflop;
  until (p > MAXLIMIT) OR (j>High(SmallPrimes));
end;

function OutPots(pD:tpPrimeFac;n:NativeInt):Ansistring;
var
  s: String[31];
  chk,p,i: NativeInt;
Begin
  str(n,s);
  result := Format('%15s : ',[Numb2USA(s)]);

  with pd^ do
  begin
    chk := 1;
    For n := 0 to pfMaxIdx-1 do
    Begin
      if n>0 then
        result += '*';
      p := SmallPrimes[pfpotPrimIdx[n]];
      chk *= p;
      str(p,s);
      result += s;
      i := pfpotMax[n];
      if i >1 then
      Begin
        str(pfpotMax[n],s);
        result += '^'+s;
        repeat
          chk *= p;
          dec(i);
        until i <= 1;
      end;
     end;
    p := pfRemain;
    If p >1 then
    Begin
      str(p,s);
      chk *= p;
      result += '*'+s;
    end;
  end;
end;

function CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint):NativeInt;
//n must be multiple of base aka n mod base must be 0
var
  q,r: Uint64;
  i : NativeInt;
Begin
  fillchar(dgt,SizeOf(dgt),#0);
  i := 0;
  n := n div base;
  result := 0;
  repeat
    r := n;
    q := n div base;
    r  -= q*base;
    n := q;
    dgt[i] := r;
    inc(i);
  until (q = 0);
  //searching lowest pot in base
  result := 0;
  while (result<i) AND (dgt[result] = 0) do
    inc(result);
  inc(result);
end;

function IncByBaseInBase(var dgt:tDigits;base:NativeInt):NativeInt;
var
  q :NativeInt;
Begin
  result := 0;
  q := dgt[result]+1;
  if q = base then
    repeat
      dgt[result] := 0;
      inc(result);
      q := dgt[result]+1;
    until q <> base;
  dgt[result] := q;
  result +=1;
end;

function SieveOneSieve(var pdf:tPrimeDecompField):boolean;
var
  dgt:tDigits;
  i,j,k,pr,fac,n,MaxP : Uint64;
begin
  n := pdfOfs;
  if n+SizePrDeFe >= sqr(SmallPrimes[High(SmallPrimes)]) then
    EXIT(FALSE);
  //init
  for i := 0 to SizePrDeFe-1 do
  begin
    with pdf[i] do
    Begin
      pfDivCnt := 1;
      pfSumOfDivs := 1;
      pfRemain := n+i;
      pfMaxIdx := 0;
      pfpotPrimIdx[0] := 0;
      pfpotMax[0] := 0;
    end;
  end;
  //first factor 2. Make n+i even
  i := (pdfIdx+n) AND 1;
  IF (n = 0) AND (pdfIdx<2)  then
    i := 2;

  repeat
    with pdf[i] do
    begin
      j := BsfQWord(n+i);
      pfMaxIdx := 1;
      pfpotPrimIdx[0] := 0;
      pfpotMax[0] := j;
      pfRemain := (n+i) shr j;
      pfSumOfDivs := (Uint64(1) shl (j+1))-1;
      pfDivCnt := j+1;
    end;
    i += 2;
  until i >=SizePrDeFe;
  //i now index in SmallPrimes
  i := 0;
  maxP := trunc(sqrt(n+SizePrDeFe))+1;
  repeat
    //search next prime that is in bounds of sieve
    if n = 0 then
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end
    else
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if (k = pr) AND (n>0) then
          k:= 0;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end;

    //no need to use higher primes
    if pr*pr > n+SizePrDeFe then
      BREAK;

    //j is power of prime
    j := CnvtoBASE(dgt,n+k,pr);
    repeat
      with pdf[k] do
      Begin
        pfpotPrimIdx[pfMaxIdx] := i;
        pfpotMax[pfMaxIdx] := j;
        pfDivCnt *= j+1;
        fac := pr;
        repeat
          pfRemain := pfRemain DIV pr;
          dec(j);
          fac *= pr;
        until j<= 0;
        pfSumOfDivs *= (fac-1)DIV(pr-1);
        inc(pfMaxIdx);
        k += pr;
        j := IncByBaseInBase(dgt,pr);
      end;
    until k >= SizePrDeFe;
  until false;

  //correct sum of & count of divisors
  for i := 0 to High(pdf) do
  Begin
    with pdf[i] do
    begin
      j := pfRemain;
      if j <> 1 then
      begin
        pfSumOFDivs *= (j+1);
        pfDivCnt *=2;
      end;
    end;
  end;
  result := true;
end;

function NextSieve:boolean;
begin
  dec(pdfIDX,SizePrDeFe);
  inc(pdfOfs,SizePrDeFe);
  result := SieveOneSieve(PrimeDecompField);
end;

function GetNextPrimeDecomp:tpPrimeFac;
begin
  if pdfIDX >= SizePrDeFe then
    if Not(NextSieve) then
      EXIT(NIL);
  result := @PrimeDecompField[pdfIDX];
  inc(pdfIDX);
end;

function Init_Sieve(n:NativeUint):boolean;
//Init Sieve pdfIdx,pdfOfs are Global
begin
  pdfIdx := n MOD SizePrDeFe;
  pdfOfs := n-pdfIdx;
  result := SieveOneSieve(PrimeDecompField);
end;
//end prime decomposition
//######################################################################

procedure Get_RA_Prime(cntlimit:NativeUInt;useFactors:Boolean);
var
  pPrimeDecomp :tpPrimeFac;
  pr,sum0,sum1,n,i,cnt : NativeUInt;
begin
  write('First 30 Ruth-Aaron numbers (');
  if useFactors then
    writeln('factors ):')
  else
    writeln('divisors ):');

  cnt := 0;
  sum1:= 0;
  n := 2;
  Init_Sieve(n);
  repeat
    pPrimeDecomp:= GetNextPrimeDecomp;
    with pPrimeDecomp^ do
    begin
      sum0:= pfRemain;
      //if not(prime)
      if (sum0 <> n) then
      begin
        if sum0 = 1 then
          sum0 := 0;
        For i := 0 to pfMaxIdx-1 do
        begin
          pr := smallprimes[pfpotPrimIdx[i]];
          if useFactors then
            sum0 += pr*pfpotMax[i]
          else
            sum0 += pr;
        end;
        if sum1 = sum0 then
        begin
          write(n-1:10);
          inc(cnt);
          if cnt mod 8 = 0 then
            writeln;
        end;
        sum1 := sum0;
      end
      else
        sum1:= 0;
    end;
    inc(n);
  until cnt>=cntlimit;
  writeln;
end;

function findfirstTripplesFactor(useFactors:boolean):NativeUint;
var
  pPrimeDecomp :tpPrimeFac;
  pr,sum0,sum1,sum2,i : NativeUInt;
begin
  sum1:= 0;
  sum2:= 0;
  result:= 2;
  Init_Sieve(result);
  repeat
    pPrimeDecomp:= GetNextPrimeDecomp;
    with pPrimeDecomp^ do
    begin
      sum0:= pfRemain;
      //if not(prime)
      if (sum0 <> result) then
      begin
        if sum0 = 1 then
          sum0 := 0;
        For i := 0 to pfMaxIdx-1 do
        begin
          pr := smallprimes[pfpotPrimIdx[i]];
          if useFactors then
            pr *= pfpotMax[i];
          sum0 += pr
        end;
        if (sum2 = sum0) AND (sum1=sum0) then
          Exit(result-2);
      end
      else
        sum0 := 0;
      sum2:= sum1;
      sum1 := sum0;
    end;
    inc(result);
  until false
end;

Begin
  InitSmallPrimes;
  Get_RA_Prime(30,false);
  Get_RA_Prime(30,true);
  writeln;
  writeln('First Ruth-Aaron triple (factors) :');
  writeln(findfirstTripplesFactor(true):10);
  writeln;
  writeln('First Ruth-Aaron triple (divisors):');
  writeln(findfirstTripplesFactor(false):10);
end.


\Based on C example:
include c:\cxpl\stdlib;     \provides StrCmp routine, etc.
int Haystack;               \('int' is used instead of 'char' for 2D array)

func Search(Str, First);    \Return first (or last) index for string in haystack
char Str; int First;
int I, SI;
[I:= 0;  SI:= 0;
repeat  if StrCmp(Str, Haystack(I)) = 0 then
                [if First then return I;
                SI:= I;     \save index
                ];
        I:= I+1;
until   Haystack(I) = 0;
return SI;
];

[Haystack:= ["Zig", "Zag", "Wally", "Ronald", "Bush",
             "Krusty", "Charlie", "Bush", "Boz", "Zag", 0];
Text(0, "Bush is at ");  IntOut(0, Search("Bush", true));  CrLf(0);
if Search("Washington", true) = 0 then
        Text(0, "Washington is not in the haystack^M^J");
Text(0, "First index for Zag: ");  IntOut(0, Search("Zag", true));  CrLf(0);
Text(0,  "Last index for Zag: ");  IntOut(0, Search("Zag", false)); CrLf(0);
]


list$ = "mouse,hat,cup,deodorant,television,soap,methamphetamine,severed cat heads,cup"

dim item$(1)

n = token(list$, item$(), ",")

line input "Enter string to search: " line$
for i = 1 to n
    if line$ = item$(i) then
        if not t print "First index for ", line$, ": ", i
        t = i
        j = j + 1
    end if
next

if t = 0 then
    print "String not found in list"
else
    if j > 1 print "Last index for ", line$, ": ", t
end if


haystack = ["Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Bozo"];
needles = ["Bush", "Washington"];
for(i = 1; i <= numberof(needles); i++) {
    w = where(haystack == needles(i));
    if(!numberof(w))
        error, "Needle "+needles(i)+" not found";
    write, format="Needle %s appears first at index %d\n", needles(i), w(1);
    if(numberof(w) > 1)
        write, format="Needle %s appears last at index %d\n", needles(i), w(0);
}


L("Krusty","Charlie","Bozo","Bozo").index("Charlie") //--> 1
L("Krusty","Charlie","Bozo","Bozo").index("fred") //--> throws index error


class SEDOL(s: String) {
  require(s.size == 6 || s.size == 7, "SEDOL length must be 6 or 7 characters")
  require(s.size == 6 || s(6).asDigit == chksum, "Incorrect SEDOL checksum")
  require(s forall (c => !("aeiou" contains c.toLower)), "Vowels not allowed in SEDOL")
  def chksum = 10 - ((s zip List(1, 3, 1, 7, 3, 9) map { case (c, w) => c.asDigit * w } sum) % 10)
  override def toString = s.take(6) + chksum
}


$ include "seed7_05.s7i";

const func char: sedolCheckDigit (in string: sedol) is func
  result
    var char: checkDigit is ' ';
  local
    const array integer: weight is [] (1, 3, 1, 7, 3, 9);
    var char: ch is ' ';
    var integer: index is 0;
    var integer: item is 0;
    var integer: sum is 0;
   begin
     for ch key index range sedol do
       case ch of
         when {'0' .. '9'}:
           item := ord(ch) - ord('0');
         when {'A' .. 'Z'} - {'A', 'E', 'I', 'O', 'U'}:
           item := ord(ch) - ord('A') + 10;
         otherwise:
           raise RANGE_ERROR;
       end case;
       sum +:= item * weight[index];
     end for;
     checkDigit := chr(-sum mod 10 + ord('0'));
   end func;

const proc: main is func
  local
    var string: sedol is "";
  begin
    for sedol range [] ("710889", "B0YBKJ", "406566", "B0YBLH", "228276", "B0YBKL",
                        "557910", "B0YBKR", "585284", "B0YBKT", "B00030") do
      writeln(sedol <& sedolCheckDigit(sedol));
    end for;
  end func;


func sedol(s) {

    die 'No vowels allowed' if (s ~~ /[AEIOU]/);
    die 'Invalid format'    if (s !~ /^[0-9B-DF-HJ-NP-TV-Z]{6}$/);

    const base36 = ((@(0..9) + @('A'..'Z')) ~Z @(0..35) -> flatten.to_h);
    const weights = [1, 3, 1, 7, 3, 9];

    var vs = [base36{ s.chars... }];
    var checksum = (vs ~Z* weights -> sum);
    var check_digit = ((10 - checksum%10) % 10);
    return (s + check_digit);
}

%w(
    710889
    B0YBKJ
    406566
    B0YBLH
    228276
    B0YBKL
    557910
    B0YBKR
    585284
    B0YBKT
    B00030
).each { |s|
    say sedol(s);
}


n = eval[input["Enter highest number: "]]
results = array[sieve[n]]
println[results]
println[length[results] + " prime numbers less than or equal to " + n]

sieve[n] :=
{
   // Initialize array
   array = array[0 to n]
   [email protected] = 0

   for i = 2 to ceil[sqrt[n]]
      if [email protected] != 0
         for j = i^2 to n step i
            [email protected] = 0

   return select[array, { |x| x != 0 }]
}


#!/usr/bin/perl

use strict;
use warnings;
use ntheory qw( factor vecsum );
use List::AllUtils qw( uniq );

#use Data::Dump 'dd'; dd factor(6); exit;

my $n = 1;
my @answers;
while( @answers < 30 )
  {
  vecsum(factor($n)) == vecsum(factor($n+1)) and push @answers, $n;
  $n++;
  }
print "factors:\n\n@answers\n\n" =~ s/.{60}\K /\n/gr;

$n = 1;
@answers = ();
while( @answers < 30 )
  {
  vecsum(uniq factor($n)) == vecsum(uniq factor($n+1)) and push @answers, $n;
  $n++;
  }
print "divisors:\n\n@answers\n" =~ s/.{60}\K /\n/gr;


with javascript_semantics
procedure ruth_aaron(bool d, integer n=30, l=2, i=1)
    string fd = iff(d?"divisors":"factors"),
           ns = iff(n=1?"":sprintf(" %d",n)),
           ss = iff(n=1?"":"s"),
           nt = iff(l=2?"number":"triple")
    printf(1,"First%s Ruth-Aaron %s%s (%s):\n",{ns,nt,ss,fd})
    integer prev = -1, k = i, c = 0
    while n do
        sequence f = prime_factors(k,true,-1)
        if d then f = unique(f) end if
        integer s = sum(f)
        if s and s=prev then
            c += 1
            if c=l-1 then
                printf(1,"%d ",k-c)
                n -= 1
            end if
        else
            c = 0
        end if
        prev = s
        k += 1
    end while
    printf(1,"\n\n")
end procedure
atom t0 = time()
ruth_aaron(false)   -- https://oeis.org/A039752
ruth_aaron(true)    -- https://oeis.org/A006145
ruth_aaron(false, 1, 3) -- (2.1s)
-- give this one a little leg-up :-) ...
ruth_aaron(true, 1, 3, 89460000) -- (0.1s)
--ruth_aaron(true, 1, 3) -- (24 minutes 30s)


String extend [
  includesAnyOf: aSet [
      aSet do: [ :e | (self includes: e) ifTrue: [ ^true ] ].
      ^false
  ]
].


--#SET TERMINATOR @

SET SERVEROUTPUT ON@

CREATE OR REPLACE FUNCTION CHECK_SEDOL (
  IN TEXT VARCHAR(6)
   ) RETURNS VARCHAR(7)
 BEGIN
  DECLARE TYPE SEDOL AS CHAR(1) ARRAY [6];
--declare text varchar(6) default 'B12345';
  DECLARE WEIGHT SEDOL;
  DECLARE I SMALLINT;
  DECLARE SENTENCE VARCHAR(256);
  DECLARE CHAR_AT CHAR(1);
  DECLARE OUTPUT CHAR(1);
  DECLARE SUM SMALLINT;
  DECLARE CHECK SMALLINT;
  DECLARE INVALID_CHAR CONDITION FOR SQLSTATE '22004' ;
  DECLARE STMT STATEMENT;

  -- Converts all to upper.
  SET TEXT = UPPER (TEXT);
  -- CALL DBMS_OUTPUT.PUT_LINE(TEXT);
  -- Checks the characters.
  SET I = 1;
  WHILE (I <= 6) DO
   SET CHAR_AT = SUBSTR(TEXT, I, 1);
   -- CALL DBMS_OUTPUT.PUT_LINE('Char ' || CHAR_AT);
   SET SENTENCE = 'SET ? = (SELECT SEDOL FROM (SELECT ''' || CHAR_AT
     || ''' SEDOL FROM SYSIBM.SYSDUMMY1) WHERE SEDOL IN (''B'',''C'',''D'',''F'',''G'',''H'',''J'','
     || '''K'',''L'',''M'',''N'',''P'',''Q'',''R'',''S'',''T'',''V'',''W'',''X'',''Y'',''Z'',''0'','
     || '''1'',''2'',''3'',''4'',''5'',''6'',''7'',''8'',''9''))';
   PREPARE STMT FROM SENTENCE;
   EXECUTE STMT INTO OUTPUT;
   IF (OUTPUT IS NULL) THEN
    SIGNAL INVALID_CHAR;
   END IF;
   SET I = I + 1;
  END WHILE;

  -- Assigns weight
  SET WEIGHT[1] = '1';
  SET WEIGHT[2] = '3';
  SET WEIGHT[3] = '1';
  SET WEIGHT[4] = '7';
  SET WEIGHT[5] = '3';
  SET WEIGHT[6] = '9';

  -- Process the SEDOL.
  SET SUM = 0;
  SET I = 1;
  WHILE (I <= 6) DO
   SET CHAR_AT = SUBSTR(TEXT, I, 1);
   IF (ASCII(CHAR_AT) > 65) THEN
    SET SUM = SUM + WEIGHT[I] * (ASCII(CHAR_AT) - 64 + 9);
   ELSE
    SET SUM = SUM + WEIGHT[I] * CHAR_AT;
   END IF;
   SET I = I + 1;
  END WHILE;
  SET CHECK = MOD((10 - MOD(SUM, 10)), 10);
  CALL DBMS_OUTPUT.PUT_LINE(CHECK);
  RETURN TEXT || CHECK;
 END @


tick sto startingtick
#g 100000 sto MAX
@MAX mem !maximize sto primeNumbers
one count
@primeNumbers 0 2 [^]
2 @MAX külső: {||
@count {|
{}§külső {} []@primeNumbers !/ else{<}§külső
|} // @count vége
@primeNumbers @count++ {} [^]
|} // @MAX vége
@primeNumbers free
."Time : " tick @startingtick - print ." tick\n"
."Prímek száma = " @count printnl
end
{ „MAX” } { „startingtick” } { „primeNumbers” } { „count” }


  [ behead dup dip nested rot
    witheach
      [ tuck != if
          [ dup dip
            [ nested join ] ] ]
    drop ]                         is -duplicates   ( [ --> [ )

 [ primefactors -duplicates ]      is primedivisors ( n --> n )

 [ 0 swap witheach + ]             is sum           ( [ --> n )

  [ [] temp put
    3 2 primefactors sum
    [ over primefactors sum
      tuck = if
        [ over 1 -
          temp take
          swap join
          temp put ]
      dip 1+
      temp share size 30 = until ]
   2drop
   temp take ]                     is raf         (   -->   )

  [ [] temp put
    3 2 primedivisors sum
    [ over primedivisors sum
      tuck = if
        [ over 1 -
          temp take
          swap join
          temp put ]
      dip 1+
      temp share size 30 = until ]
   2drop
   temp take ]                     is rad          (   -->   )

  raf echo
  cr cr
  rad echo


use Prime::Factor;

my @pf  = lazy (^∞).hyper(:1000batch).map: *.&prime-factors.sum;
my @upf = lazy (^∞).hyper(:1000batch).map: *.&prime-factors.unique.sum;

# Task: < 1 second
put "First 30 Ruth-Aaron numbers (Factors):\n" ~
(1..∞).grep( { @pf[$_] == @pf[$_ + 1] } )[^30];

put "\nFirst 30 Ruth-Aaron numbers (Divisors):\n" ~
(1..∞).grep( { @upf[$_] == @upf[$_ + 1] } )[^30];

# Stretch: ~ 5 seconds
put "\nFirst Ruth-Aaron triple (Factors):\n" ~
(1..∞).first: { @pf[$_] == @pf[$_ + 1] == @pf[$_ + 2] }

# Really, really, _really_ slow. 186(!) minutes... but with no cheating or "leg up".
put "\nFirst Ruth-Aaron triple (Divisors):\n" ~
(1..∞).first: { @upf[$_] == @upf[$_ + 1] == @upf[$_ + 2] }


say "First 30 Ruth-Aaron numbers (factors):"
say 30.by {|n| (sopfr(n) == sopfr(n+1)) && (n > 0) }.join(' ')

say "\nFirst 30 Ruth-Aaron numbers (divisors):"
say 30.by {|n| ( sopf(n) ==  sopf(n+1)) && (n > 0) }.join(' ')


fun char2value c =
  if List.exists (fn x => x = c) (explode "AEIOU") then raise Fail "no vowels"
  else if Char.isDigit c then ord c - ord #"0"
  else if Char.isUpper c then ord c - ord #"A" + 10
  else raise Match

val sedolweight = [1,3,1,7,3,9]

fun checksum sedol = let
  val tmp = ListPair.foldlEq (fn (ch, weight, sum) => sum + char2value ch * weight)
              0 (explode sedol, sedolweight)
in
  Int.toString ((10 - (tmp mod 10)) mod 10)
end

app (fn sedol => print (sedol ^ checksum sedol ^ "\n"))
  [ "710889",
    "B0YBKJ",
    "406566",
    "B0YBLH",
    "228276",
    "B0YBKL",
    "557910",
    "B0YBKR",
    "585284",
    "B0YBKT" ];


namespace eval sedol {
    variable chars {0 1 2 3 4 5 6 7 8 9 "" B C D "" F G H "" J K L M N "" P Q R S T "" V W X Y Z}
    variable weight {1 3 1 7 3 9 1}

    proc checksum {alnum6} {
        variable chars
        variable weight
        set sum 0
        set col 0
        foreach char [split [string toupper [string range $alnum6 0 5]] ""] {
            if {[set idx [lsearch -exact $chars $char]] == -1} {
                error "invalid character: $char"
            }
            incr sum [expr {$idx * [lindex $weight $col]}]
            incr col
        }
        return [expr {(10 - ($sum % 10)) % 10}]
    }

    proc valid {alnum7} {
        expr {[checksum [string range $alnum7 0 5]] == [string index $alnum7 6]}
    }
}

proc assert {condition {message "Assertion failed!"}} {
    if { ! [uplevel 1 [list expr $condition]]} {
        return -code error $message
    }
}

set codes {710889 B0YBKJ 406566 B0YBLH 228276 B0YBKL 557910 B0YBKR 585284 B0YBKT}
set answers {7108899 B0YBKJ7 4065663 B0YBLH2 2282765 B0YBKL9 5579107 B0YBKR5 5852842 B0YBKT7}

foreach code $codes answer $answers {
    set sedol "${code}[sedol::checksum $code]"
    assert {$sedol eq $answer} "assertion failed: $sedol ne $answer"
    puts $sedol
}


window 1, @"Sieve of Eratosthenes", (0,0,720,300)

begin globals
dynamic gPrimes(1) as Boolean
end globals

local fn SieveOfEratosthenes( n as long )
  long i, j

  for i = 2 to  n
    for j = i * i to n step i
      gPrimes(j) = _true
    next
    if gPrimes(i) = 0 then print i,
  next i
  kill gPrimes
end fn

fn SieveOfEratosthenes( 100 )

HandleEvents


import "./math" for Int, Nums
import "./seq" for Lst
import "./fmt" for Fmt

var resF = []
var resD = []
var resT = [] // factors only
var n = 2
var factors1 = []
var factors2 = [2]
var factors3 = [3]
var sum1 = 0
var sum2 = 2
var sum3 = 3
var countF = 0
var countD = 0
var countT = 0
while (countT < 1 || countD < 30 || countF < 30) {
    factors1 = factors2
    factors2 = factors3
    factors3 = Int.primeFactors(n+2)
    sum1 = sum2
    sum2 = sum3
    sum3 = Nums.sum(factors3)
    if (countF < 30 && sum1 == sum2) {
        resF.add(n)
        countF = countF + 1
    }
    if (sum1 == sum2 && sum2 == sum3) {
        resT.add(n)
        countT = countT + 1
    }
    if (countD < 30) {
        var factors4 = factors1.toList
        var factors5 = factors2.toList
        Lst.prune(factors4)
        Lst.prune(factors5)
        if (Nums.sum(factors4) == Nums.sum(factors5)) {
            resD.add(n)
            countD = countD + 1
        }
    }
    n = n + 1
}

System.print("First 30 Ruth-Aaron numbers (factors):")
System.print(resF.join(" "))
System.print("\nFirst 30 Ruth-Aaron numbers (divisors):")
System.print(resD.join(" "))
System.print("\nFirst Ruth-Aaron triple (factors):")
System.print(resT[0])

resT = [] // divisors only
n = 2
factors1 = []
factors2 = [2]
factors3 = [3]
sum1 = 0
sum2 = 2
sum3 = 3
countT = 0
while (countT < 1) {
    factors1 = factors2
    factors2 = factors3
    factors3 = Int.primeFactors(n+2)
    Lst.prune(factors3)
    sum1 = sum2
    sum2 = sum3
    sum3 = Nums.sum(factors3)
    if (sum1 == sum2 && sum2 == sum3) {
        resT.add(n)
        countT = countT + 1
    }
    n = n + 1
}

System.print("\nFirst Ruth-Aaron triple (divisors):")
System.print(resT[0])


CREATE FUNCTION [dbo].[fn_CheckSEDOL]
( @SEDOL varchar(50) )
RETURNS varchar(7)
AS
BEGIN
	declare	@true bit = 1,
		@false bit = 0,
		@isSEDOL bit,
		@sedol_weights varchar(6) ='131739',
		@sedol_len int = LEN(@SEDOL),
		@sum int = 0

	if ((@sedol_len = 6))
	begin
		select @SEDOL = UPPER(@SEDOL)
		Declare	@vowels varchar(5) = 'AEIOU',
			@letters varchar(21) = 'BCDFGHJKLMNPQRSTVWXYZ',
			@i int=1,
			@isStillGood bit = @true,
			@char char = '',
			@weighting int =0

		select @isSEDOL = @false

		while ((@i < 7) and (@isStillGood = @true))
		begin
			select	@char = SUBSTRING(@SEDOL,@i,1),
				@weighting = CONVERT (INT,SUBSTRING(@sedol_weights, @i, 1))
			if (CHARINDEX(@char, @vowels) > 0) -- no vowels please
			begin
				select @isStillGood=@false
			end
			else
			begin
				if (ISNUMERIC(@char) = @true) -- is a number
				begin
					select @sum = @sum + (ASCII(@char) - 48) * @weighting
				end
				else if (CHARINDEX(@char, @letters) = 0) -- test for the rest of the alphabet
				begin
					select @isStillGood=@false
				end
				else
				begin
					select @sum = @sum + (ASCII(@char) - 55) * @weighting
				end
			end
			select @i = @i +1
		end -- of while loop
		if (@isStillGood = @true)
		begin
			declare @checksum int = (10 - (@sum%10))%10
			select @SEDOL = @SEDOL + CONVERT(CHAR,@checksum)
		end
	end
	else
	begin
		select @SEDOL = ''
	end
	-- Return the result of the function
	RETURN @SEDOL
END


Eratosthenes := function(n)
    local a, i, j;
    a := ListWithIdenticalEntries(n, true);
    if n < 2 then
        return [];
    else
        for i in [2 .. n] do
            if a[i] then
                j := i*i;
                if j > n then
                    return Filtered([2 .. n], i -> a[i]);
                else
                    while j <= n do
                        a[j] := false;
                        j := j + i;
                    od;
                fi;
            fi;
        od;
    fi;
end;

Eratosthenes(100);

[ 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 ]


func DivSum(N, AllDiv); \Return sum of divisors
int  N, AllDiv; \all divisors vs. only prime divisors
int  F, F0, S, Q;
[F:= 2;  F0:= 0;  S:= 0;
repeat  Q:= N/F;
        if rem(0) = 0 then
            [if AllDiv then S:= S+F
            else if F # F0 then
                [S:= S+F;  F0:= F];
            N:= Q;
            ]
        else F:= F+1;
until   F > N;
return S;
];

proc Ruth(AllDiv);      \Show Ruth-Aaron numbers
int  AllDiv;
int  C, S, S0, N;
[C:= 0;  S0:= 0;
N:= 2;
repeat  S:= DivSum(N, AllDiv);
        if S = S0 then
            [IntOut(0, N-1);
            C:= C+1;
            if rem(C/10) = 0 then CrLf(0) else ChOut(0, ^ );
            ];
        S0:= S;
        N:= N+1;
until   C >= 30;
];

[Ruth(true);
CrLf(0);
Ruth(false);
]


$$ MODE TUSCRIPT
check="1'3'1'7'3'9"
values="123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
value=STRINGS (values,":<%:")
BUILD r_TABLE/or illegal=":A:E:I:O:U:"
LOOP input="710889'B0YBKJ'406566'B0YBLH'228276'B0YBKL'557910'B0YBKR'585284'B0YBKT'BOYAKT'B00030",sum=""
  IF (input.ma.illegal) THEN
   PRINT/ERROR input, " illegal"
   CYCLE
  ENDIF
  strings=STRINGS (input,":<%:")
  LOOP d,nr=strings
   c=SELECT (check,#d)
   IF (nr!='digits') nr=FILTER_INDEX (value,":{nr}:",-)
   x=nr*c, sum=APPEND(sum,x)
  ENDLOOP
  endsum=SUM(sum), checksum=10-(endsum%10)
  IF (checksum==10) checksum=0
  PRINT input, " checkdigit: ", checksum
ENDLOOP


#import std
#import nat

alphabet = digits-- ~=`A-~r letters
weights  = <1,3,1,7,3,9>
charval  = -:@rlXS num alphabet
iprod    = sum:-0+ product*p/weights+ charval*
checksum = difference/10+ remainder\10+ iprod


Function getSedolCheckDigit(Input1)
    Dim mult(6) As Integer
    mult(1) = 1: mult(2) = 3: mult(3) = 1
    mult(4) = 7: mult(5) = 3: mult(6) = 9
    If Len(Input1) <> 6 Then
        getSedolCheckDigit = "Six chars only please"
        Exit Function
    End If
    Input1 = UCase(Input1)
    Total = 0
    For i = 1 To 6
        s1 = Mid(Input1, i, 1)
        If (s1 = "A") Or (s1 = "E") Or (s1 = "I") Or (s1 = "O") Or (s1 = "U") Then
                getSedolCheckDigit = "No vowels"
                Exit Function
        End If
        If (Asc(s1) >= 48) And (Asc(s1) <= 57) Then
                Total = Total + Val(s1) * mult(i)
        Else
                Total = Total + (Asc(s1) - 55) * mult(i)
        End If

    Next i
    getSedolCheckDigit = Input1 + CStr((10 - (Total Mod 10)) Mod 10)

End Function


arr = Array("710889",_
            "B0YBKJ",_
	    "406566",_
	    "B0YBLH",_
	    "228276",_
	    "B0YBKL",_
	    "557910",_
            "B0YBKR",_
	    "585284",_
	    "B0YBKT",_
	    "12345",_
	    "A12345",_
	    "B00030")

For j = 0 To UBound(arr)
	WScript.StdOut.Write arr(j) & getSEDOLCheckDigit(arr(j))
	WScript.StdOut.WriteLine
Next

Function getSEDOLCheckDigit(str)
	If Len(str) <> 6 Then
		getSEDOLCheckDigit = " is invalid. Only 6 character strings are allowed."
		Exit Function
	End If
	Set mult = CreateObject("Scripting.Dictionary")
	With mult
		.Add "1","1" : .Add "2", "3" : .Add "3", "1"
		.Add "4","7" : .Add "5", "3" : .Add "6", "9"
	End With
	total = 0
	For i = 1 To 6
		s  = Mid(str,i,1)
		If s = "A" Or s = "E" Or s = "I" Or s = "O" Or s = "U" Then
			getSEDOLCheckDigit = " is invalid. Vowels are not allowed."
			Exit Function
		End If
		If Asc(s) >= 48 And Asc(s) <=57 Then
			total = total + CInt(s) * CInt(mult.Item(CStr(i)))
		Else
			total = total + (Asc(s) - 55) * CInt(mult.Item(CStr(i)))
		End If
	Next
	getSEDOLCheckDigit = (10 - total Mod 10) Mod 10
End Function


#DEFINE ALPHABET "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
#DEFINE VOWELS "AEIOU"
#DEFINE VALIDCHARS "0123456789" + ALPHABET
LOCAL cMsg As String, cCode As String
LOCAL ARRAY codes[12]
codes[1] = "710889"
codes[2] = "B0YBKJ"
codes[3] = "406566"
codes[4] = "B0YBLH"
codes[5] = "228276"
codes[6] = "B0YBKL"
codes[7] = "557910"
codes[8] = "B0YBKR"
codes[9] = "585284"
codes[10] = "B0YBKT"
codes[11] = "B00030"
codes[12] = "B0030A"
DIMENSION w[6]
w[1] = 1
w[2] = 3
w[3] = 1
w[4] = 7
w[5] = 3
w[6] = 9
CLEAR
FOR EACH cCode IN codes
    cMsg = ""
    IF IsValidCode(@cCode, @cMsg)	&& Parameters passed by reference
	cCode = cCode + GetCheckDigit(cCode)
	? cCode
    ELSE
	? cCode, cMsg
    ENDIF
ENDFOR

FUNCTION GetCheckDigit(tcCode As String) As String
LOCAL i As Integer, c As String, s As Integer, k As Integer
s = 0
FOR i = 1 TO 6
    c = SUBSTR(tcCode, i, 1)
    IF ISDIGIT(c)
	k = VAL(c)
    ELSE
	k = 9 + AT(c, ALPHABET)
    ENDIF
    s = s + k*w[i]
ENDFOR
RETURN TRANSFORM((10 - s%10)%10)
ENDFUNC

FUNCTION IsValidCode(tcCode As String, tcMsg As String) As Boolean
LOCAL n As Integer, c As String, i As Integer
*!* Get rid of any spaces and convert to upper case
tcCode = UPPER(STRTRAN(tcCode, " "))
n = LEN(tcCode)
IF LEN(tcCode) # 6
    tcMsg = "Code must be 6 characters."
ELSE
    FOR i = 1 TO n
	c = SUBSTR(tcCode, i, 1)
	IF NOT c $ VALIDCHAR
	    tcMsg = c + " is not a valid character."
	    EXIT
	ELSE
	    IF c $ VOWELS
		tcMsg = "Vowels are not allowed."
		EXIT
	    ENDIF
	ENDIF
    ENDFOR
ENDIF
RETURN EMPTY(tcMsg)
ENDFUNC


import "/str" for Char
import "/fmt" for Conv

var sedol = Fn.new { |s|
    if (!(s is String && s.count == 6)) return false
    var weights = [1, 3, 1, 7, 3, 9]
    var sum = 0
    for (i in 0..5) {
        var c = s[i]
        if (!Char.isUpper(c) && !Char.isDigit(c)) return null
        if ("AEIOU".contains(c)) return null
        sum = sum + Conv.atoi(c, 36) * weights[i]
    }
    var cd = (10 - sum%10) % 10
    return s + "%(cd)"
}

var tests = [
    "710889",
    "B0YBKJ",
    "406566",
    "B0YBLH",
    "228276",
    "B0YBKL",
    "557910",
    "B0YBKR",
    "585284",
    "B0YBKT",
    "B00030",
    "I23456"
]

for (test in tests) {
    var a
    var ans = (a = sedol.call(test)) ? a : "not valid"
    System.print("%(test) -> %(ans)")
}


// Sieve of Eratosthenes (find primes)
// GLBasic implementation

GLOBAL n%, k%, limit%, flags%[]

limit = 100			// search primes up to this number

DIM flags[limit+1]		// GLBasic arrays start at 0

FOR n = 2 TO SQR(limit)
    IF flags[n] = 0
        FOR k = n*n TO limit STEP n
            flags[k] = 1
        NEXT
    ENDIF
NEXT

// Display the primes
FOR n = 2 TO limit
    IF flags[n] = 0 THEN STDOUT n + ", "
NEXT

KEYWAIT


string 0;               \use zero-terminated strings

func CheckDigit(Str);   \Return the check digit for a SEDOL
char Str;
int  Sum, I, C, V;
[Sum:= 0;
for I:= 0 to 6-1 do
    [C:= Str(I);
    case of
      C>=^0 & C<=^9: V:= C-^0;
      C>=^A & C<=^Z: V:= C-^A+10
    other V:= -1;
    case I of
      1, 4: V:= V*3;
      3: V:= V*7;
      5: V:= V*9
      other     [];
      Sum:= Sum+V;
      ];
return rem( (10 - rem(Sum/10)) / 10 ) + ^0;
];

int Sedol, N;
[Sedol:= ["710889",
          "B0YBKJ",
          "406566",
          "B0YBLH",
          "228276",
          "B0YBKL",
          "557910",
          "B0YBKR",
          "585284",
          "B0YBKT",
          "B00030"];
for N:= 0 to 11-1 do
        [Text(0, Sedol(N));
        ChOut(0, CheckDigit(Sedol(N)));
        CrLf(0);
        ];
]


data "710889", "B0YBKJ", "406566", "B0YBLH", "228276", "B0YBKL", "557910", "B0YBKR", "585284", "B0YBKT", "B00030", "AB", "B00A03", ""

do
    read d$
    if d$ = "" break
    print sedol$(d$)
loop

sub sedol$(d$)
    LOCAL a, i, s, weights$(1)

    a = len(d$)
    if a < 6 or a > 6 return d$ + ": Error in length"

    for i = 1 to 6
        if not instr("BCDFGHJKLMNPQRSTVWXYZ0123456789", mid$(d$, i, 1)) return d$ + ": Error in symbol " + mid$(d$, i, 1)
    next

    a = token("1 3 1 7 3 9", weights$())

    FOR i = 1 TO 6
      a = ASC(MID$(d$, i, 1)) - 48
      s = s + (a + 3 * (a > 9)) * val(weights$(i))
    NEXT
    return d$ + CHR$(48 + mod(10 - mod(s, 10), 10))
end sub


fcn checksum(text){
   ( text.len()!=6 or (text..matches("*[AEIOUaeioua-z]*")) ) and
      throw(Exception.ValueError("Invalid SEDOL text: "+text));

   text + (10 - text.pump(List,'wrap(c){
                    if("0"<=c<="9") c.toAsc()-0x30;
		    else c.toAsc()-55;
	          }).zipWith('*,T(1,3,1,7,3,9)).sum() % 10) % 10;
}


package main
import "fmt"

func main() {
    const limit = 201 // means sieve numbers < 201

    // sieve
    c := make([]bool, limit) // c for composite.  false means prime candidate
    c[1] = true              // 1 not considered prime
    p := 2
    for {
        // first allowed optimization:  outer loop only goes to sqrt(limit)
        p2 := p * p
        if p2 >= limit {
            break
        }
        // second allowed optimization:  inner loop starts at sqr(p)
        for i := p2; i < limit; i += p {
            c[i] = true // it's a composite

        }
        // scan to get next prime for outer loop
        for {
            p++
            if !c[p] {
                break
            }
        }
    }

    // sieve complete.  now print a representation.
    for n := 1; n < limit; n++ {
        if c[n] {
            fmt.Print("  .")
        } else {
            fmt.Printf("%3d", n)
        }
        if n%20 == 0 {
            fmt.Println("")
        }
    }
}


def sievePrimes = { bound ->
    def isPrime  = new BitSet(bound)
    isPrime[0..1] = false
    isPrime[2..bound] = true
    (2..(Math.sqrt(bound))).each { pc ->
        if (isPrime[pc]) {
            ((pc**2)..bound).step(pc) { isPrime[it] = false }
        }
    }
    (0..bound).findAll { isPrime[it] }
}


10  INPUT "ENTER NUMBER TO SEARCH TO: ";LIMIT
20  DIM FLAGS(LIMIT)
30  FOR N = 2 TO SQR (LIMIT)
40  IF FLAGS(N) < > 0 GOTO 80
50  FOR K = N * N TO LIMIT STEP N
60  FLAGS(K) = 1
70  NEXT K
80  NEXT N
90  REM  DISPLAY THE PRIMES
100  FOR N = 2 TO LIMIT
110  IF FLAGS(N) = 0 THEN PRINT N;", ";
120  NEXT N


{-# LANGUAGE FlexibleContexts #-} -- too lazy to write contexts...
{-# OPTIONS_GHC -O2 #-}

import Control.Monad.ST ( runST, ST )
import Data.Array.Base ( MArray(newArray, unsafeRead, unsafeWrite),
                         IArray(unsafeAt),
                         STUArray, unsafeFreezeSTUArray, assocs )
import Data.Time.Clock.POSIX ( getPOSIXTime ) -- for timing...

primesTo :: Int -> [Int] -- generate a list of primes to given limit...
primesTo limit = runST $ do
  let lmt = limit - 2-- raw index of limit!
  cmpsts <- newArray (2, limit) False -- when indexed is true is composite
  cmpstsf <- unsafeFreezeSTUArray cmpsts -- frozen in place!
  let getbpndx bp = (bp, bp * bp - 2) -- bp -> bp, raw index of start cull
      cullcmpst i = unsafeWrite cmpsts i True -- cull composite by raw ndx
      cull4bpndx (bp, si0) = mapM_ cullcmpst [ si0, si0 + bp .. lmt ]
  mapM_ cull4bpndx
        $ takeWhile ((>=) lmt . snd) -- for bp's <= square root limit
                    [ getbpndx bp | (bp, False) <- assocs cmpstsf ]
  return [ p | (p, False) <- assocs cmpstsf ] -- non-raw ndx is prime

-- testing...
main :: IO ()
main = do
  putStrLn $ "The primes up to 100 are " ++ show (primesTo 100)
  putStrLn $ "The number of primes up to a million is " ++
               show (length $ primesTo 1000000)
  let top = 1000000000
  start <- getPOSIXTime
  let answr = length $ primesTo top
  stop <- answr `seq` getPOSIXTime -- force result for timing!
  let elpsd =  round $ 1e3 * (stop - start) :: Int

  putStrLn $ "Found " ++ show answr ++ " to " ++ show top ++
               " in " ++ show elpsd ++ " milliseconds."


REAL :: N=100,  sieve(N)

sieve = $ > 1     ! = 0 1 1 1 1 ...
DO i = 1, N^0.5
  IF( sieve(i) ) THEN
     DO j = i^2, N, i
       sieve(j) = 0
     ENDDO
  ENDIF
ENDDO

DO i = 1, N
  IF( sieve(i) ) WRITE() i
ENDDO


::  Find primes by the sieve of Eratosthenes
!:
|=  [email protected]
=/  index  2
=/  primes  `(list @ud)`(gulf 1 end)
|-  ^-  (list @ud)
?:  (gte index (lent primes))  primes
$(index +(index), primes +:(skid primes |=([[email protected]] &((gth a index) =(0 (mod a index))))))


 procedure main()
    sieve(100)
 end

 procedure sieve(n)
    local p,i,j
    p:=list(n, 1)
    every i:=2 to sqrt(n) & j:= i+i to n by i & p[i] == 1
      do p[j] := 0
    every write(i:=2 to n & p[i] == 1 & i)
 end


(defn primes-before
  "Gives all the primes < limit"
  [limit]
  (assert (int? limit))
  # Janet has a buffer type (mutable string) which has easy methods for use as bitset
  (def buf-size (math/ceil (/ limit 8)))
  (def is-prime (buffer/new-filled buf-size (bnot 0)))
  (print "Size" buf-size "is-prime: " is-prime)
  (buffer/bit-clear is-prime 0)
  (buffer/bit-clear is-prime 1)
  (for n 0 (math/ceil (math/sqrt limit))
    (if (buffer/bit is-prime n) (loop [i :range-to [(* n n) limit n]]
      (buffer/bit-clear is-prime i))))
  (def res @[]) # Result: Mutable array
  (for i 0 limit
    (if (buffer/bit is-prime i)
      (array/push res i)))
  (def res (array/new limit))
  (for i 0 limit
    (if (buffer/bit is-prime i)
      (array/push res i)))
  res)


import java.util.LinkedList;

public class Sieve{
       public static LinkedList<Integer> sieve(int n){
               if(n < 2) return new LinkedList<Integer>();
               LinkedList<Integer> primes = new LinkedList<Integer>();
               LinkedList<Integer> nums = new LinkedList<Integer>();

               for(int i = 2;i <= n;i++){ //unoptimized
                       nums.add(i);
               }

               while(nums.size() > 0){
                       int nextPrime = nums.remove();
                       for(int i = nextPrime * nextPrime;i <= n;i += nextPrime){
                               nums.removeFirstOccurrence(i);
                       }
                       primes.add(nextPrime);
               }
               return primes;
       }
}


function eratosthenes(limit) {
    var primes = [];
    if (limit >= 2) {
        var sqrtlmt = Math.sqrt(limit) - 2;
        var nums = new Array(); // start with an empty Array...
        for (var i = 2; i <= limit; i++) // and
            nums.push(i); // only initialize the Array once...
        for (var i = 0; i <= sqrtlmt; i++) {
            var p = nums[i]
            if (p)
                for (var j = p * p - 2; j < nums.length; j += p)
                    nums[j] = 0;
        }
        for (var i = 0; i < nums.length; i++) {
            var p = nums[i];
            if (p)
                primes.push(p);
        }
    }
    return primes;
}

var primes = eratosthenes(100);

if (typeof print == "undefined")
    print = (typeof WScript != "undefined") ? WScript.Echo : alert;
print(primes);


START
FILE MYOUTPUT ... $ ''Insufficient information to complete this declaration''
PROC SIEVEE $
    '' define the sieve data structure ''
    ARRAY CANDIDATES 1000 B $
    FOR I =0,1,999 $
    BEGIN
        '' everything is potentially prime until proven otherwise ''
        CANDIDATES($I$) = 1$
    END
    '' Neither 1 nor 0 is prime, so flag them off ''
    CANDIDATES($0$) = 0$
    CANDIDATES($1$) = 0$
    '' start the sieve with the integer 0 ''
    FOR I = 0$
    BEGIN
        IF I GE 1000$
        GOTO DONE$
        '' advance to the next un-crossed out number. ''
        '' this number must be a prime ''
NEXTI.  IF I LS 1000 AND Candidates($I$) EQ 0 $
        BEGIN
            I = I + 1 $
            GOTO NEXTI $
        END
        '' insure against running off the end of the data structure ''
        IF I LT 1000 $
        BEGIN
            '' cross out all multiples of the prime, starting with 2*p. ''
            FOR J=2 $
            FOR K=0 $
            BEGIN
                K = J * I $
                IF K GT 999 $
                GOTO ADV $
                CANDIDATES($K$) = 0 $
                J = J + 1 $
            END
            '' advance to the next candidate ''
ADV.        I = I + 1 $
        END
    END
    '' all uncrossed-out numbers are prime (and only those numbers) ''
    '' print all primes ''
DONE. OPEN OUTPUT MYOUTPUT $
    FOR I=0,1,999$
    BEGIN
        IF CANDIDATES($I$) NQ 0$
        BEGIN
            OUTPUT MYOUTPUT I $
        END
    END
TERM$


# Denoting the input by $n, which is assumed to be a positive integer,
# eratosthenes/0 produces an array of primes less than or equal to $n:
def eratosthenes:

  # erase(i) sets .[i*j] to false for integral j > 1
  def erase(i):
    if .[i] then reduce range(2; (1 + length) / i) as $j (.; .[i * $j] = false)
    else .
    end;

  (. + 1) as $n
  | (($n|sqrt) / 2) as $s
  | [null, null, range(2; $n)]
  | reduce (2, 1 + (2 * range(1; $s))) as $i (.; erase($i))
  | map(select(.));


# Returns an array of positive prime numbers less than or equal to lim
function sieve(lim :: Int)
    if lim < 2 return [] end
    limi :: Int = (lim - 1) ÷ 2 # calculate the required array size
    isprime :: Array{Bool} = trues(limi)
    llimi :: Int = (isqrt(lim) - 1) ÷ 2 # and calculate maximum root prime index
    result :: Array{Int} = [2]  #Initial array
    for i in 1:limi
        if isprime[i]
            p = i + i + 1 # 2i + 1
            if i <= llimi
                for j = (p*p-1)>>>1:p:limi # quick shift/divide in case LLVM doesn't optimize divide by 2 away
                    isprime[j] = false
                end
            end
            push!(result, p)
        end
    end
    return result
end


include ..\Utilitys.tlhy

%limit %i
1000 !limit
( 1 $limit ) sequence

( 2 $limit sqrt int ) [ !i $i get [ ( 2 $limit 1 - $i / int ) [ $i * false swap set ] for ] if ] for
( 1 $limit false ) remove
pstack

"Press ENTER to end " input


import kotlin.math.sqrt

fun sieve(max: Int): List<Int> {
    val xs = (2..max).toMutableList()
    val limit = sqrt(max.toDouble()).toInt()
    for (x in 2..limit) xs -= x * x..max step x
    return xs
}

fun main(args: Array<String>) {
    println(sieve(100))
}


{def sieve

 {def sieve.rec2
 {lambda {:a :n :i :k}
  {if {< :k :n}
   then {sieve.rec2 {A.set! :k 0 :a} :n :i {+ :k :i}}
   else :a}}}

 {def sieve.rec1
  {lambda {:a :n :i}
   {if {< :i {sqrt :n}}
    then {sieve.rec1 {if {= {A.get :i :a} 1}
                     then {sieve.rec2 :a :n :i {* :i :i}}
                     else :a}
                     :n {+ :i 1}}
    else :a}}}

 {def sieve.disp
  {lambda {:s}
   {S.replace \s by space in
    {S.map {{lambda {:a :i} {if {= {A.get :i :a} 1} then :i else}} :s}
           {S.serie 2 {- {A.length :s} 1}}} }}}

 {lambda {:n}
  {sieve.disp
   {sieve.rec1 {A.new {S.map {lambda {_} 1} {S.serie 1 :n}}}
             :n 2}}}}
-> sieve

{sieve 100}
-> 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


val .sieve = f(.limit) {
    if .limit < 2 {
        return []
    }

    var .composite = arr .limit, false
    .composite[1] = true

    for .n in 2 to truncate(.limit ^/ 2) + 1 {
        if not .composite[.n] {
            for .k = .n^2; .k < .limit; .k += .n {
                .composite[.k] = true
            }
        }
    }

    where f(.n) not .composite[.n], series .limit-1
}

writeln .sieve(100)


    'Notice that arrays are globally visible to functions.
    'The sieve() function uses the flags() array.
    'This is a Sieve benchmark adapted from BYTE 1985
    ' May, page 286

    size = 7000
    dim flags(7001)
    start = time$("ms")
    print sieve(size); " primes found."
    print "End of iteration.  Elapsed time in milliseconds: "; time$("ms")-start
    end

    function sieve(size)
        for i = 0 to size
            if flags(i) = 0 then
                prime = i + i + 3
                k = i + prime
                while k <= size
                    flags(k) = 1
                    k = k + prime
                wend
                sieve = sieve + 1
            end if
        next i
    end function


implement Sieve;

include "sys.m";
	sys: Sys;
	print: import sys;
include "draw.m";
	draw: Draw;

Sieve : module
{
	init : fn(ctxt : ref Draw->Context, args : list of string);
};

init (ctxt: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;

	limit := 201;
	sieve : array of int;
	sieve = array [201] of {* => 1};
	(sieve[0], sieve[1]) = (0, 0);

	for (n := 2; n < limit; n++) {
		if (sieve[n]) {
			for (i := n*n; i < limit; i += n) {
				sieve[i] = 0;
			}
		}
	}

	for (n = 1; n < limit; n++) {
		if (sieve[n]) {
			print ("%4d", n);
		} else {
			print("   .");
		};
		if ((n%20) == 0)
			print("\n\n");
	}
}


-- parent script "sieve"
property _sieve

----------------------------------------
-- @constructor
----------------------------------------
on new (me)
    me._sieve = []
    return me
end

----------------------------------------
-- Returns list of primes <= n
----------------------------------------
on getPrimes (me, limit)
    if me._sieve.count<limit then me._primeSieve(limit)
    primes = []
    repeat with i = 2 to limit
        if me._sieve[i] then primes.add(i)
    end repeat
    return primes
end

----------------------------------------
-- Sieve of Eratosthenes
----------------------------------------
on _primeSieve (me, limit)
    me._sieve = [0]
    repeat with i = 2 to limit
        me._sieve[i] = 1
    end repeat
    c = sqrt(limit)
    repeat with i = 2 to c
        if (me._sieve[i]=0) then next repeat
        j = i*i -- start with square
        repeat while (j<=limit)
            me._sieve[j] = 0
            j = j + i
        end repeat
    end repeat
end


function sieveE int
    set itemdel to comma
    local sieve
    repeat with i = 2 to int
        put i into sieve[i]
    end repeat
    put 2 into n
    repeat while n < int
        repeat with p = n to int step n
            if p = n then
                next repeat
            else
                put empty into sieve[p]
            end if
        end repeat
        add 1 to n
    end repeat
    combine sieve with comma
    filter items of sieve without empty
    sort items of sieve ascending numeric
    return sieve
end sieveE


to sieve :limit
  make "a (array :limit 2)     ; initialized to empty lists
  make "p []
  for [i 2 :limit] [
    if empty? item :i :a [
      queue "p :i
      for [j [:i * :i] :limit :i] [setitem :j :a :i]
    ]
  ]
  output :p
end
print sieve 100   ; 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


due to the use of mod (modulo = division) in the filter function.


HAI 1.2
CAN HAS STDIO?

HOW IZ I Eratosumthin YR Max
  I HAS A Siv ITZ A BUKKIT
  Siv HAS A SRS 1 ITZ 0
  I HAS A Index ITZ 2
  IM IN YR Inishul UPPIN YR Dummy WILE DIFFRINT Index AN SUM OF Max AN 1
    Siv HAS A SRS Index ITZ 1
    Index R SUM OF Index AN 1
  IM OUTTA YR Inishul

  I HAS A Prime ITZ 2
  IM IN YR MainLoop UPPIN YR Dummy WILE BOTH SAEM Max AN BIGGR OF Max AN PRODUKT OF Prime AN Prime
    BOTH SAEM Siv'Z SRS Prime AN 1
    O RLY?
      YA RLY
        Index R SUM OF Prime AN Prime
        IM IN YR MarkMultipulz UPPIN YR Dummy WILE BOTH SAEM Max AN BIGGR OF Max AN Index
          Siv'Z SRS Index R 0
          Index R SUM OF Index AN Prime
        IM OUTTA YR MarkMultipulz
    OIC
    Prime R SUM OF Prime AN 1
  IM OUTTA YR MainLoop

  Index R 1
  I HAS A First ITZ WIN
  IM IN YR PrintPrimes UPPIN YR Dummy WILE BOTH SAEM Max AN BIGGR OF Max AN Index
    BOTH SAEM Siv'Z SRS Index AN 1
    O RLY?
      YA RLY
        First
        O RLY?
          YA RLY
            First R FAIL
          NO WAI
            VISIBLE ", "!
        OIC
        VISIBLE Index!
    OIC
    Index R SUM OF Index AN 1
  IM OUTTA YR PrintPrimes
  VISIBLE ""
IF U SAY SO

I IZ Eratosumthin YR 100 MKAY

KTHXBYE


function erato(n)
  if n < 2 then return {} end
  local t = {0} -- clears '1'
  local sqrtlmt = math.sqrt(n)
  for i = 2, n do t[i] = 1 end
  for i = 2, sqrtlmt do if t[i] ~= 0 then for j = i*i, n, i do t[j] = 0 end end end
  local primes = {}
  for i = 2, n do if t[i] ~= 0 then table.insert(primes, i) end end
  return primes
end


prime
 where
    prime = 2 fby (n whenever isprime(n));
    n = 3 fby n+2;
    isprime(n) = not(divs) asa divs or prime*prime > N
                    where
                      N is current n;
                      divs = N mod prime eq 0;
                    end;
 end


Module EratosthenesSieve (x) {
      \\ Κόσκινο του Ερατοσθένη
      If x>200000 Then Exit
      Dim i(x+1)
      k=2
      k2=sqrt(x)
      While k<=k2 {
            m=k+k
            While m<=x {
                  i(m)=1
                  m+=k
            }
            {k++:if i(k) then loop
            }
      }
      For i=2 to x {If i(i)=0 Then Print i,
      }
      Print
}
EratosthenesSieve 1000


            NORMAL MODE IS INTEGER

          R TO GENERATE MORE PRIMES, CHANGE BOTH THESE NUMBERS
            BOOLEAN PRIME
            DIMENSION PRIME(10000)
            MAXVAL = 10000
            PRINT FORMAT BEGIN,MAXVAL

          R ASSUME ALL ARE PRIMES AT BEGINNING
            THROUGH SET, FOR I=2, 1, I.G.MAXVAL
SET         PRIME(I) = 1B

          R REMOVE ALL PROVEN COMPOSITES
            SQMAX = SQRT.(MAXVAL)
            THROUGH NEXT, FOR P=2, 1, P.G.SQMAX
            WHENEVER PRIME(P)
                THROUGH MARK, FOR I=P*P, P, I.G.MAXVAL
MARK            PRIME(I) = 0B
NEXT        END OF CONDITIONAL

          R PRINT PRIMES
            THROUGH SHOW, FOR P=2, 1, P.G.MAXVAL
SHOW        WHENEVER PRIME(P), PRINT FORMAT NUMFMT, P

            VECTOR VALUES BEGIN = $13HPRIMES UP TO ,I9*$
            VECTOR VALUES NUMFMT = $I9*$
            END OF PROGRAM


Eratosthenes := proc(n::posint)
  local numbers_to_check, i, k;
  numbers_to_check := [seq(2 .. n)];
  for i from 2 to floor(sqrt(n)) do
      for k from i by i while k <= n do
          if evalb(k <> i) then
            numbers_to_check[k - 1] := 0;
          end if;
      end do;
  end do;
  numbers_to_check := remove(x -> evalb(x = 0), numbers_to_check);
  return numbers_to_check;
  end proc:


Eratosthenes[n_] := Module[{numbers = Range[n]},
  Do[If[numbers[[i]] != 0, Do[numbers[[i j]] = 0, {j, 2, n/i}]], {i,
    2, Sqrt[n]}];
  Select[numbers, # > 1 &]]

Eratosthenes[100]


function P = erato(x)        % Sieve of Eratosthenes: returns all primes between 2 and x

    P = [0 2:x];             % Create vector with all ints between 2 and x where
                             %   position 1 is hard-coded as 0 since 1 is not a prime.

    for n = 2:sqrt(x)        % All primes factors lie between 2 and sqrt(x).
       if P(n)               % If the current value is not 0 (i.e. a prime),
          P(n*n:n:x) = 0;    % then replace all further multiples of it with 0.
       end
    end                      % At this point P is a vector with only primes and zeroes.

    P = P(P ~= 0);           % Remove all zeroes from P, leaving only the primes.
end


sieve(n):=block(
   [a:makelist(true,n),i:1,j],
   a[1]:false,
   do (
      i:i+1,
      unless a[i] do i:i+1,
      if i*i>n then return(sublist_indices(a,identity)),
      for j from i*i step i while j<=n do a[j]:false
   )
)$


fn eratosthenes n =
(
    multiples = #()
    print 2
    for i in 3 to n do
    (
        if (findItem multiples i) == 0 then
        (
            print i
            for j in (i * i) to n by i do
            (
                append multiples j
            )
        )
    )
)

eratosthenes 100


:- module sieve.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module bool, array, int.

main(!IO) :-
    sieve(50, Sieve),
    dump_primes(2, size(Sieve), Sieve, !IO).

:- pred dump_primes(int, int, array(bool), io, io).
:- mode dump_primes(in, in, array_di, di, uo) is det.
dump_primes(N, Limit, !.A, !IO) :-
    ( if N < Limit then
        unsafe_lookup(!.A, N, Prime),
        (
            Prime = yes,
            io.write_line(N, !IO)
        ;
            Prime = no
        ),
        dump_primes(N + 1, Limit, !.A, !IO)
    else
        true
    ).

:- pred sieve(int, array(bool)).
:- mode sieve(in, array_uo) is det.
sieve(N, !:A) :-
    array.init(N, yes, !:A),
    sieve(2, N, !A).

:- pred sieve(int, int, array(bool), array(bool)).
:- mode sieve(in, in, array_di, array_uo) is det.
sieve(N, Limit, !A) :-
    ( if N < Limit then
        unsafe_lookup(!.A, N, Prime),
        (
            Prime = yes,
            sift(N + N, N, Limit, !A),
            sieve(N + 1, Limit, !A)
        ;
            Prime = no,
            sieve(N + 1, Limit, !A)
        )
    else
        true
    ).

:- pred sift(int, int, int, array(bool), array(bool)).
:- mode sift(in, in, in, array_di, array_uo) is det.
sift(I, N, Limit, !A) :-
    ( if I < Limit then
        unsafe_set(I, no, !A),
        sift(I + N, N, Limit, !A)
    else
        true
    ).


TextWindow.Write("Enter number to search to: ")
limit = TextWindow.ReadNumber()
For n = 2 To limit
  flags[n] = 0
EndFor
For n = 2 To math.SquareRoot(limit)
  If flags[n] = 0 Then
    For K = n * n To limit Step n
      flags[K] = 1
    EndFor
  EndIf
EndFor
' Display the primes
If limit >= 2 Then
  TextWindow.Write(2)
  For n = 3 To limit
    If flags[n] = 0 Then
      TextWindow.Write(", " + n)
    EndIf
  EndFor
  TextWindow.WriteLine("")
EndIf


MODULE Erato;
FROM InOut IMPORT WriteCard, WriteLn;
FROM MathLib IMPORT sqrt;

CONST Max = 100;

VAR prime: ARRAY [2..Max] OF BOOLEAN;
    i: CARDINAL;

PROCEDURE Sieve;
    VAR i, j, sqmax: CARDINAL;
BEGIN
    sqmax := TRUNC(sqrt(FLOAT(Max)));

    FOR i := 2 TO Max DO prime[i] := TRUE; END;
    FOR i := 2 TO sqmax DO
        IF prime[i] THEN
            j := i * 2;
            (* alas, the BY clause in a FOR loop must be a constant *)
            WHILE j <= Max DO
                prime[j] := FALSE;
                j := j + i;
            END;
        END;
    END;
END Sieve;

BEGIN
    Sieve;
    FOR i := 2 TO Max DO
        IF prime[i] THEN
            WriteCard(i,5);
            WriteLn;
        END;
    END;
END Erato.


MODULE Eratosthenes EXPORTS Main;

IMPORT IO;

FROM Math IMPORT sqrt;

CONST
  LastNum    = 1000;
  ListPrimes = TRUE;

VAR
  a: ARRAY[2..LastNum] OF BOOLEAN;

VAR
  n := LastNum - 2 + 1;

BEGIN

  (* set up *)
  FOR i := FIRST(a) TO LAST(a) DO
    a[i] := TRUE;
  END;

  (* declare a variable local to a block *)
  VAR b := FLOOR(sqrt(FLOAT(LastNum, LONGREAL)));

  (* the block must follow immediately *)
  BEGIN

    (* print primes and mark out composites up to sqrt(LastNum) *)
    FOR i := FIRST(a) TO b DO
      IF a[i] THEN
        IF ListPrimes THEN IO.PutInt(i); IO.Put(" "); END;
        FOR j := i*i TO LAST(a) BY i DO
          IF a[j] THEN
            a[j] := FALSE;
            DEC(n);
          END;
        END;
      END;
    END;

    (* print remaining primes *)
    IF ListPrimes THEN
      FOR i := b + 1 TO LAST(a) DO
        IF a[i] THEN
          IO.PutInt(i); IO.Put(" ");
        END;
      END;
    END;

  END;

  (* report *)
  IO.Put("There are ");         IO.PutInt(n);
  IO.Put(" primes from 2 to "); IO.PutInt(LastNum);
  IO.PutChar('\n');

END Eratosthenes.


ERATO1(HI)
 ;performs the Sieve of Erotosethenes up to the number passed in.
 ;This version sets an array containing the primes
 SET HI=HI\1
 KILL ERATO1 ;Don't make it new - we want it to remain after we quit the function
 NEW I,J,P
 FOR I=2:1:(HI**.5)\1 FOR J=I*I:I:HI SET P(J)=1
 FOR I=2:1:HI S:'$DATA(P(I)) ERATO1(I)=I
 KILL I,J,P
 QUIT


/* The Computer Language Shootout
   http://shootout.alioth.debian.org/

   contributed by Nicolas Cannasse
*/
fmt = function(i) {
        var s = $string(i);
        while( $ssize(s) < 8 )
                s = " "+s;
        return s;
}
nsieve = function(m) {
        var a = $amake(m);
        var count = 0;
        var i = 2;
        while( i < m ) {
                if $not(a[i]) {
                        count += 1;
                        var j = (i << 1);
                        while( j < m ) {
                                if( $not(a[j]) ) a[j] = true;
                                j += i;
                        }
                }
                i += 1;
        }
        $print("Primes up to ",fmt(m)," ",fmt(count),"\n");
}

var n = $int($loader.args[0]);
if( n == null ) n = 2;
var i = 0;
while( i < 3 ) {
        nsieve(10000 << (n - i));
        i += 1;
}


/* NetRexx */

options replace format comments java crossref savelog symbols binary

parse arg loWatermark hiWatermark .
if loWatermark = '' | loWatermark = '.' then loWatermark = 1
if hiWatermark = '' | hiWatermark = '.' then hiWatermark = 200

do
  if \loWatermark.datatype('w') | \hiWatermark.datatype('w') then -
    signal NumberFormatException('arguments must be whole numbers')
  if loWatermark > hiWatermark then -
    signal IllegalArgumentException('the start value must be less than the end value')

  seive = sieveOfEratosthenes(hiWatermark)
  primes = getPrimes(seive, loWatermark, hiWatermark).strip

  say 'List of prime numbers from' loWatermark 'to' hiWatermark 'via a "Sieve of Eratosthenes" algorithm:'
  say '  'primes.changestr(' ', ',')
  say '  Count of primes:' primes.words
catch ex = Exception
  ex.printStackTrace
end

return

method sieveOfEratosthenes(hn = long) public static binary returns Rexx

  sv = Rexx(isTrue)
  sv[1] = isFalse
  ix = long
  jx = long

  loop ix = 2 while ix * ix <= hn
    if sv[ix] then loop jx = ix * ix by ix while jx <= hn
      sv[jx] = isFalse
      end jx
    end ix

  return sv

method getPrimes(seive = Rexx, lo = long, hi = long) private constant binary returns Rexx

  primes = Rexx('')
  loop p_ = lo to hi
    if \seive[p_] then iterate p_
    primes = primes p_
    end p_

  return primes

method isTrue public constant binary returns boolean
  return 1 == 1

method isFalse public constant binary returns boolean
  return \isTrue


(set 'upper-bound 1000)

; The initial sieve is a list of all the numbers starting at 2.
(set 'sieve (sequence 2 upper-bound))

; Keep working until the list is empty.
(while sieve

	; The first number in the list is always prime
	(set 'new-prime (sieve 0))
	(println new-prime)

	; Filter the list leaving only the non-multiples of each number.
	(set 'sieve
		(filter
			(lambda (each-number)
				(not (zero? (% each-number new-prime))))
			sieve)))

(exit)


primes is sublist [ each (2 = sum eachright (0 = mod) [pass,count]), pass ] rest count


from math import sqrt

iterator primesUpto(limit: int): int =
  let sqrtLimit = int(sqrt(float64(limit)))
  var composites = newSeq[bool](limit + 1)
  for n in 2 .. sqrtLimit: # cull to square root of limit
    if not composites[n]: # if prime -> cull its composites
      for c in countup(n * n, limit, n): # start at ``n`` squared
        composites[c] = true
  for n in 2 .. limit: # separate iteration over results
    if not composites[n]:
      yield n

stdout.write "The primes up to 100 are:  "
for x in primesUpto(100):
   stdout.write(x, " ")
echo()

var count = 0
for p in primesUpto(1000000):
  count += 1
echo "There are ", count, " primes up to 1000000."


[ dup 2 < ] '<2 ;
[ 1 + 'count ; [ <2 [ , ] when ] count times ] 'fill-stack ;

0 'n ; 0 'v ;

[ .clr 0 'n ; 0 'v ; ] 'reset ;
[ len 1 - n - at 'v ; ] 'set-base ;
[ n 1 + 'n ; ] 'incr-n ;
[ mod 0 = ] 'is-factor ;
[ dup * ] 'sqr ;

[ set-base
  v sqr 2 at > not
  [ [ dup v = not swap v is-factor and ] remove-if incr-n run ] when ] 'run ;

[ fill-stack run ] 'sieve ;

( tests )

10 sieve .s ( => 2 3 5 7 9 ) reset newline
30 sieve .s ( => 2 3 5 7 11 13 17 19 23 29 )


MODULE Primes;

   IMPORT Out, Math;

   CONST N = 1000;

   VAR a: ARRAY N OF BOOLEAN;
      i, j, m: INTEGER;

BEGIN
   (* Set all elements of a to TRUE. *)
   FOR i := 1 TO N - 1 DO
      a[i] := TRUE;
   END;

   (* Compute square root of N and convert back to INTEGER. *)
   m := ENTIER(Math.Sqrt(N));

   FOR i := 2 TO m DO
      IF a[i] THEN
         FOR j := 2 TO (N - 1) DIV i DO
            a[i*j] := FALSE;
         END;
      END;
   END;

   (* Print all the elements of a that are TRUE. *)
   FOR i := 2 TO N - 1 DO
      IF a[i] THEN
         Out.Int(i, 4);
      END;
   END;
   Out.Ln;
END Primes.


let sieve n =
  let is_prime = Array.create n true in
  let limit = truncate(sqrt (float (n - 1))) in
  for i = 2 to limit do
    if is_prime.(i) then
      let j = ref (i*i) in
      while !j < n do
        is_prime.(!j) <- false;
        j := !j + i;
      done
  done;
  is_prime.(0) <- false;
  is_prime.(1) <- false;
  is_prime


: eratosthenes(n)
| i j |
   ListBuffer newSize(n) dup add(null) seqFrom(2, n) over addAll
   2 n sqrt asInteger for: i [
      dup at(i) ifNotNull: [ i sq n i step: j [ dup put(j, null) ] ]
      ]
   filter(#notNull) ;


# find and count safe and unsafe primes                                       #
# safe primes are primes p such that ( p - 1 ) / 2 is also prime              #
# unsafe primes are primes that are not safe                                  #
PR heap=128M PR # set heap memory size for Algol 68G                          #
# returns a string representation of n with commas                            #
PROC commatise = ( INT n )STRING:
     BEGIN
        STRING result      := "";
        STRING unformatted  = whole( n, 0 );
        INT    ch count    := 0;
        FOR c FROM UPB unformatted BY -1 TO LWB unformatted DO
            IF   ch count <= 2 THEN ch count +:= 1
            ELSE                    ch count  := 1; "," +=: result
            FI;
            unformatted[ c ] +=: result
        OD;
        result
     END # commatise # ;
# sieve values                                                                #
CHAR prime     = "P"; # unclassified prime                                    #
CHAR safe      = "S"; # safe prime                                            #
CHAR unsafe    = "U"; # unsafe prime                                          #
CHAR composite = "C"; # non-prime                                             #
# sieve of Eratosthenes: sets s[i] to prime if i is a prime,                  #
#                                     composite otherwise                     #
PROC sieve = ( REF[]CHAR s )VOID:
     BEGIN
        # start with everything flagged as prime                              #
        FOR i TO UPB s DO s[ i ] := prime OD;
        # sieve out the non-primes                                            #
        s[ 1 ] := composite;
        FOR i FROM 2 TO ENTIER sqrt( UPB s ) DO
            IF s[ i ] = prime THEN FOR p FROM i * i BY i TO UPB s DO s[ p ] := composite OD FI
        OD
     END # sieve # ;

INT max number = 10 000 000;
# construct a sieve of primes up to the maximum number                        #
[ 1 : max number ]CHAR primes;
sieve( primes );
# classify the primes                                                         #
# ( p - 1 ) OVER 2 is non-zero for p >= 3, thus we know 2 is unsafe           #
primes[ 2 ] := unsafe;
FOR p FROM 3 TO UPB primes DO
    IF primes[ p ] = prime THEN
        primes[ p ] := IF primes[ ( p - 1 ) OVER 2 ] = composite THEN unsafe ELSE safe FI
    FI
OD;
# count the primes of each type                                               #
INT safe1   := 0, safe10   := 0;
INT unsafe1 := 0, unsafe10 := 0;
FOR p FROM LWB primes TO UPB primes DO
    IF   primes[ p ] = safe  THEN
        safe10   +:= 1;
        IF p < 1 000 000 THEN safe1   +:= 1 FI
    ELIF primes[ p ] = unsafe THEN
        unsafe10 +:= 1;
        IF p < 1 000 000 THEN unsafe1 +:= 1 FI
    FI
OD;
INT safe count    := 0;
print( ( "first 35 safe   primes:", newline ) );
FOR p WHILE safe count   < 35 DO IF primes[ p ] = safe   THEN print( ( " ", whole( p, 0 ) ) ); safe count +:= 1 FI OD;
print( ( newline ) );
print( ( "safe   primes below   1,000,000: ", commatise(    safe1 ), newline ) );
print( ( "safe   primes below  10,000,000: ", commatise(   safe10 ), newline ) );
print( ( "first 40 unsafe primes:", newline ) );
INT unsafe count := 0;
FOR p WHILE unsafe count < 40 DO IF primes[ p ] = unsafe THEN print( ( " ", whole( p, 0 ) ) ); unsafe count +:= 1 FI OD;
print( ( newline ) );
print( ( "unsafe primes below   1,000,000: ", commatise(  unsafe1 ), newline ) );
print( ( "unsafe primes below  10,000,000: ", commatise( unsafe10 ), newline ) )


(define all (iota 999 2))

(print
   (let main ((left '()) (right all))
      (if (null? right)
         (reverse left)
         (unless (car right)
            (main left (cdr right))
            (let loop ((l '()) (r right) (n 0) (every (car right)))
               (if (null? r)
                  (let ((l (reverse l)))
                     (main (cons (car l) left) (cdr l)))
                  (if (eq? n every)
                     (loop (cons #false l) (cdr r) 1 every)
                     (loop (cons (car r) l) (cdr r) (+ n 1) every)))))))
)


-- Heavy-duty Sieve of Eratosthenes handler.
-- Returns a list containing either just the primes up to a given limit ('crossingsOut' = false) or, as in this task,
-- both the primes and 'missing values' representing the "crossed out" non-primes ('crossingsOut' = true).
on sieveForPrimes given limit:limit, crossingsOut:keepingZaps
    if (limit < 1) then return {}
    -- Build a list initially containing only 'missing values'. For speed, and to reduce the likelihood of hanging,
    -- do this by building sublists of at most 5000 items and concatenating them afterwards.
    script o
        property sublists : {}
        property numberList : {}
    end script
    set sublistSize to 5000
    set mv to missing value -- Use a single 'missing value' instance for economy.
    repeat sublistSize times
        set end of o's numberList to mv
    end repeat
    -- Start with a possible < 5000-item sublist.
    if (limit mod sublistSize > 0) then set end of o's sublists to items 1 thru (limit mod sublistSize) of o's numberList
    -- Then any 5000-item sublists needed.
    if (limit ≥ sublistSize) then
        set end of o's sublists to o's numberList
        repeat (limit div sublistSize - 1) times
            set end of o's sublists to o's numberList's items
        end repeat
    end if
    -- Concatenate them more-or-less evenly.
    set subListCount to (count o's sublists)
    repeat until (subListCount is 1)
        set o's numberList to {}
        repeat with i from 2 to subListCount by 2
            set end of o's numberList to (item (i - 1) of o's sublists) & (item i of o's sublists)
        end repeat
        if (i < subListCount) then set last item of o's numberList to (end of o's numberList) & (end of o's sublists)
        set o's sublists to o's numberList
        set subListCount to subListCount div 2
    end repeat
    set o's numberList to beginning of o's sublists

    -- Set the relevant list positions to 2, 3, 5, and numbers which aren't multiples of them.
    if (limit > 1) then set item 2 of o's numberList to 2
    if (limit > 2) then set item 3 of o's numberList to 3
    if (limit > 4) then set item 5 of o's numberList to 5
    if (limit < 36) then
        set n to -23
    else
        repeat with n from 7 to (limit - 29) by 30
            set item n of o's numberList to n
            tell (n + 4) to set item it of o's numberList to it
            tell (n + 6) to set item it of o's numberList to it
            tell (n + 10) to set item it of o's numberList to it
            tell (n + 12) to set item it of o's numberList to it
            tell (n + 16) to set item it of o's numberList to it
            tell (n + 22) to set item it of o's numberList to it
            tell (n + 24) to set item it of o's numberList to it
        end repeat
    end if
    repeat with n from (n + 30) to limit
        if ((n mod 2 > 0) and (n mod 3 > 0) and (n mod 5 > 0)) then set item n of o's numberList to n
    end repeat

    -- "Cross out" inserted numbers which are multiples of others.
    set inx to {0, 4, 6, 10, 12, 16, 22, 24}
    repeat with n from 7 to ((limit ^ 0.5) div 1) by 30
        repeat with inc in inx
            tell (n + inc)
                if (item it of o's numberList is it) then
                    repeat with multiple from (it * it) to limit by it
                        set item multiple of o's numberList to mv
                    end repeat
                end if
            end tell
        end repeat
    end repeat

    if (keepingZaps) then return o's numberList
    return o's numberList's numbers
end sieveForPrimes

-- Task code:
on doTask()
    set {safeQuantity, unsafeQuantity, max1, max2} to {35, 40, 1000000 - 1, 10000000 - 1}
    set {safePrimes, unsafePrimes, safeCount1, safeCount2, unsafeCount1, unsafeCount2} to {{}, {}, 0, 0, 0, 0}
    -- Get a list of 9,999,999 primes and "crossed out" non-primes! Also one with just the primes.
    script o
        property primesAndZaps : sieveForPrimes with crossingsOut given limit:max2
        property primesOnly : my primesAndZaps's numbers
    end script
    -- Work through the primes-only list, using the other as an indexable look-up to check the related numbers.
    set SophieGermainLimit to (max2 - 1) div 2
    repeat with n in o's primesOnly
        set n to n's contents
        if (n ≤ SophieGermainLimit) then
            tell (n * 2 + 1)
                if (item it of o's primesAndZaps is it) then
                    if (safeCount2 < safeQuantity) then set end of safePrimes to it
                    if (it < max1) then set safeCount1 to safeCount1 + 1
                    set safeCount2 to safeCount2 + 1
                end if
            end tell
        end if
        if ((n is 2) or (item ((n - 1) div 2) of o's primesAndZaps is missing value)) then
            if (unsafeCount2 < unsafeQuantity) then set end of unsafePrimes to n
            if (n < max1) then set unsafeCount1 to unsafeCount1 + 1
            set unsafeCount2 to unsafeCount2 + 1
        end if
    end repeat
    -- Format and output the results.
    set output to {}
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to ", "
    set end of output to "First 35 safe primes:"
    set end of output to safePrimes as text
    set end of output to "There are " & safeCount1 & " safe primes < 1,000,000 and " & safeCount2 & " < 10,000,000."
    set end of output to ""
    set end of output to "First 40 unsafe primes:"
    set end of output to unsafePrimes as text
    set end of output to "There are " & unsafeCount1 & " unsafe primes < 1,000,000 and " & unsafeCount2 & " < 10,000,000."
    set AppleScript's text item delimiters to linefeed
    set output to output as text
    set AppleScript's text item delimiters to astid

    return output
end doTask

return doTask()


declare
  fun {Sieve N}
     S = {Array.new 2 N true}
     M = {Float.toInt {Sqrt {Int.toFloat N}}}
  in
     for I in 2..M do
	if S.I then
	   for J in I*I..N;I do
	      S.J := false
	   end
	end
     end
     S
  end

  fun {Primes N}
     S = {Sieve N}
  in
     for I in 2..N collect:C do
	if S.I then {C I} end
     end
  end
in
  {Show {Primes 30}}


# syntax: GAWK -f SAFE_PRIMES_AND_UNSAFE_PRIMES.AWK
BEGIN {
    for (i=1; i<1E7; i++) {
      if (is_prime(i)) {
        arr[i] = ""
      }
    }
# safe:
    stop1 = 35 ; stop2 = 1E6 ; stop3 = 1E7
    count1 = count2 = count3 = 0
    printf("The first %d safe primes:",stop1)
    for (i=3; count1<stop1; i+=2) {
      if (i in arr && ((i-1)/2 in arr)) {
        count1++
        printf(" %d",i)
      }
    }
    printf("\n")
    for (i=3; i<stop3; i+=2) {
      if (i in arr && ((i-1)/2 in arr)) {
        count3++
        if (i < stop2) {
          count2++
        }
      }
    }
    printf("Number below %d: %d\n",stop2,count2)
    printf("Number below %d: %d\n",stop3,count3)
# unsafe:
    stop1 = 40 ; stop2 = 1E6 ; stop3 = 1E7
    count1 = count2 = count3 = 1 # since (2-1)/2 is not prime
    printf("The first %d unsafe primes: 2",stop1)
    for (i=3; count1<stop1; i+=2) {
      if (i in arr && !((i-1)/2 in arr)) {
        count1++
        printf(" %d",i)
      }
    }
    printf("\n")
    for (i=3; i<stop3; i+=2) {
      if (i in arr && !((i-1)/2 in arr)) {
        count3++
        if (i < stop2) {
          count2++
        }
      }
    }
    printf("Number below %d: %d\n",stop2,count2)
    printf("Number below %d: %d\n",stop3,count3)
    exit(0)
}
function is_prime(n,  d) {
    d = 5
    if (n < 2) { return(0) }
    if (n % 2 == 0) { return(n == 2) }
    if (n % 3 == 0) { return(n == 3) }
    while (d*d <= n) {
      if (n % d == 0) { return(0) }
      d += 2
      if (n % d == 0) { return(0) }
      d += 4
    }
    return(1)
}


Eratosthenes(lim)={
  my(v=Vecsmall(lim\1,unused,1));
  forprime(p=2,sqrt(lim),
    forstep(i=p^2,lim,p,
      v[i]=0
    )
  );
  for(i=1,lim,if(v[i],print1(i", ")))
};


arraybase 1
max = 1000000
sc1 = 0: usc1 = 0: sc2 = 0: usc2 = 0
safeprimes$ =""
unsafeprimes$ = ""

redim criba(max)
# False = prime, True = no prime
criba[0] = True
criba[1] = True

for i = 4 to max step 2
  criba[i] = 1
next i
for i = 3 to sqr(max) +1 step 2
  if criba[i] = False then
    for j = i * i to max step i * 2
      criba[j] = True
    next j
  end if
next

usc1 = 1
unsafeprimes$ = "2"
for i = 3 to 3001 step 2
  if criba[i] = False then
    if criba[i \ 2] = False then
      sc1 += 1
      if sc1 <= 35 then safeprimes$ += " " + string(i)
    else
      usc1 += 1
      if usc1 <= 40 then unsafeprimes$ +=  " " + string(i)
    end if
  end if
next i

for i = 3003 to max \ 10 step 2
  if criba[i] = False then
    if criba[i \ 2] = False then
      sc1 += 1
    else
      usc1 += 1
    end if
  end if
next i

sc2 = sc1
usc2 = usc1
for i = max \ 10 + 1 to max step 2
  if criba[i] = False then
    if criba[i \ 2] = False  then
      sc2 += 1
    else
      usc2 += 1
    end if
  end if
next i

print "the first 35 Safeprimes are: "; safeprimes$
print
print "the first 40 Unsafeprimes are:  "; unsafeprimes$
print
print "     Safeprimes   Unsafeprimes"
print "  Below  -------------------------"
print max \ 10, sc1, usc1
print max   , sc2, usc2
end


program primes(output)

const
 PrimeLimit = 1000;

var
 primes: set of 1 .. PrimeLimit;
 n, k: integer;
 needcomma: boolean;

begin
 { calculate the primes }
 primes := [2 .. PrimeLimit];
 for n := 1 to trunc(sqrt(PrimeLimit)) do
  begin
   if n in primes
    then
     begin
      k := n*n;
      while k < PrimeLimit do
       begin
        primes := primes - [k];
        k := k + n
       end
     end
  end;

  { output the primes }
  needcomma := false;
  for n := 1 to PrimeLimit do
   if n in primes
    then
     begin
      if needcomma
       then
        write(', ');
      write(n);
      needcomma := true
     end
end.


using static System.Console;
using System;
using System.Collections;
using System.Collections.Generic;
using System.Linq;

public static class SafePrimes
{
    public static void Main() {
        HashSet<int> primes = Primes(10_000_000).ToHashSet();
        WriteLine("First 35 safe primes:");
        WriteLine(string.Join(" ", primes.Where(IsSafe).Take(35)));
        WriteLine($"There are {primes.TakeWhile(p => p < 1_000_000).Count(IsSafe):n0} safe primes below {1_000_000:n0}");
        WriteLine($"There are {primes.TakeWhile(p => p < 10_000_000).Count(IsSafe):n0} safe primes below {10_000_000:n0}");
        WriteLine("First 40 unsafe primes:");
        WriteLine(string.Join(" ", primes.Where(IsUnsafe).Take(40)));
        WriteLine($"There are {primes.TakeWhile(p => p < 1_000_000).Count(IsUnsafe):n0} unsafe primes below {1_000_000:n0}");
        WriteLine($"There are {primes.TakeWhile(p => p < 10_000_000).Count(IsUnsafe):n0} unsafe primes below {10_000_000:n0}");

        bool IsSafe(int prime) => primes.Contains(prime / 2);
        bool IsUnsafe(int prime) => !primes.Contains(prime / 2);
    }

    //Method from maths library
    static IEnumerable<int> Primes(int bound) {
        if (bound < 2) yield break;
        yield return 2;

        BitArray composite = new BitArray((bound - 1) / 2);
        int limit = ((int)(Math.Sqrt(bound)) - 1) / 2;
        for (int i = 0; i < limit; i++) {
            if (composite[i]) continue;
            int prime = 2 * i + 3;
            yield return prime;
            for (int j = (prime * prime - 2) / 2; j < composite.Count; j += prime) composite[j] = true;
        }
        for (int i = limit; i < composite.Count; i++) {
            if (!composite[i]) yield return 2 * i + 3;
        }
    }

}