#import std
#import nat
#import flo

outcomes = <'aleph ','beth  ','gimel ','daleth','he    ','waw   ','zayin ','heth  '>
probabilities = ^lrNCT(~&,minus/1.+ plus:-0) div/*1. float* skip/5 iota12

simulation =

^(~&rn,div+ float~~rmPlX)^*D/~& iota; ^A(~&h,length)*K2+ * [email protected]/probabilities !* outcomes

format =

:/'        frequency   probability'+  * ^lrlrTPT/~&n (printf/'%12.8f')^~/~&m [email protected]

#show+

results = format simulation 1000000


item = Array("aleph","beth","gimel","daleth","he","waw","zayin","heth")
prob = Array(1/5.0, 1/6.0, 1/7.0, 1/8.0, 1/9.0, 1/10.0, 1/11.0, 1759/27720)
Dim cnt(7)

'Terminate script if sum of probabilities <> 1.
sum = 0
For i = 0 To UBound(prob)
	sum = sum + prob(i)
Next

If sum <> 1 Then
	WScript.Quit
End If

For trial = 1 To 1000000
	r = Rnd(1)
	p = 0
	For i = 0 To UBound(prob)
		p = p + prob(i)
		If r < p Then
			cnt(i) = cnt(i) + 1
			Exit For
		End If
	Next
Next

WScript.StdOut.Write "item" & vbTab & "actual" & vbTab & vbTab & "theoretical"
WScript.StdOut.WriteLine
For i = 0 To UBound(item)
	WScript.StdOut.Write item(i) & vbTab & FormatNumber(cnt(i)/1000000,6) & vbTab & FormatNumber(prob(i),6)
	WScript.StdOut.WriteLine
Next


import "/fmt" for Fmt
import "/math" for Int

for (i in 1..10) System.print("%(Fmt.d(2, i)) -> %(Int.properDivisors(i))")

System.print("\nThe number in the range [1, 20000] with the most proper divisors is:")
var number = 1
var maxDivs = 0
for (i in 2..20000) {
    var divs = Int.properDivisors(i).count
    if (divs > maxDivs) {
        number = i
        maxDivs = divs
    }
}
System.print("%(number) which has %(maxDivs) proper divisors.")


func PropDiv(N, Show);  \Count and optionally show proper divisors of N
int  N, Show, D, C;
[C:= 0;
if N > 1 then
    [D:= 1;
    repeat  if rem(N/D) = 0 then
                [C:= C+1;
                if Show then
                    [if D > 1 then ChOut(0, ^ );
                    IntOut(0, D);
                    ];
                ];
            D:= D+1;
    until   D >= N;
    ];
return C;
];

int N, SN, Cnt, Max;
[for N:= 1 to 10 do
    [ChOut(0, ^[);  PropDiv(N, true);  ChOut(0, ^]);
    ChOut(0, ^ );
    ];
CrLf(0);

Max:= 0;
for N:= 1 to 20000 do
    [Cnt:= PropDiv(N, false);
    if Cnt > Max then
        [Max:= Cnt;  SN:= N];
    ];
IntOut(0, SN);  ChOut(0, ^ ); IntOut(0, Max);  CrLf(0);
]


import "random" for Random
import "/fmt" for Fmt

var letters  = ["aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth"]
var actual   = [0] * 8
var probs    = [1/5, 1/6, 1/7, 1/8, 1/9, 1/10, 1/11, 0]
var cumProbs = [0] * 8

cumProbs[0] = probs[0]
for (i in 1..6) cumProbs[i] = cumProbs[i-1] + probs[i]
cumProbs[7] = 1
probs[7] = 1 - cumProbs[6]
var n = 1e6
var rand = Random.new()
(1..n).each { |i|
    var r = rand.float()
    var index = (r <= cumProbs[0]) ? 0 :
                (r <= cumProbs[1]) ? 1 :
                (r <= cumProbs[2]) ? 2 :
                (r <= cumProbs[3]) ? 3 :
                (r <= cumProbs[4]) ? 4 :
                (r <= cumProbs[5]) ? 5 :
                (r <= cumProbs[6]) ? 6 : 7
    actual[index] = actual[index] + 1
}

var sumActual = 0
System.print("Letter\t Actual    Expected")
System.print("------\t--------   --------")
for (i in 0..7) {
    var generated = actual[i]/n
    Fmt.print("$s\t$8.6f   $8.6f", letters[i], generated, probs[i])
    sumActual = sumActual + generated
}
System.print("\t--------   --------")
Fmt.print("\t$8.6f   1.000000", sumActual)


fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) }


dim letters$(7)
data "aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth"
letters$(0) = "aleph"
letters$(1) = "beth"
letters$(2) = "gimel"
letters$(3) = "daleth"
letters$(4) = "he"
letters$(5) = "waw"
letters$(6) = "zayin"
letters$(7) = "heth"
dim actual(7)
dim probs(7)
probs(0) = 1/5.0
probs(1) = 1/6.0
probs(2) = 1/7.0
probs(3) = 1/8.0
probs(4) = 1/9.0
probs(5) = 1/10.0
probs(6) = 1/11.0
probs(7) = 1759/27720
dim cumProbs(7)

cumProbs(0) = probs(0)
for i = 1 to 6
    cumProbs(i) = cumProbs(i - 1) + probs(i)
next i
cumProbs(7) = 1.0

n = 1000000
for test = 1 to n
    r = ran(1)
    p = 0.0
    for i = 1 to arraysize(probs(),1)
        p = p + probs(i)
        if r < p then
           actual(i) = actual(i) + 1
           break
        end if
    next i
next t

sumActual = 0.0
tab$ = chr$(9)
print "Letter          Actual          Expected"
print "------          --------        --------"
for i = 0 to 7
    print letters$(i), tab$,
    print actual(i)/n using "#.######",
    sumActual = sumActual + actual(i)/n
    print probs(i) using "#.######"
next i

print "                --------        --------"
print "                ", sumActual using "#.######", tab$, "1.000000"
end


var names=T("aleph", "beth", "gimel", "daleth",
			  "he", "waw", "zayin", "heth");
var ptable=T(5.0, 6.0, 7.0, 8.0, 9.0, 10.0, 11.0).apply('/.fp(1.0));
ptable=ptable.append(1.0-ptable.sum(0.0)); // add last weight to sum to 1.0
var [const] N=ptable.len();

fcn ridx{ i:=0; s:=(0.0).random(1);
   while((s-=ptable[i]) > 0) { i+=1 }
   i
}

const M=0d1_000_000;
var r=(0).pump(N,List,T(Ref,0));  // list of references to int 0
(0).pump(M,Void,fcn{r[ridx()].inc()}); // 1,000,000 weighted random #s

r=r.apply("value").apply("toFloat"); // (reference to int)-->int-->float

println("  Name  Count    Ratio Expected");
foreach i in (N){
   "%6s%7d %7.4f%% %7.4f%%".fmt(names[i], r[i], r[i]/M*100,
		ptable[i]*100).println();
}


NMOS_6502 equ 1
ifdef NMOS_6502
txa
pha
else
phx    ;NMOS_6502 doesn't have this instruction.
endif  ; every ifdef/ifndef needs an endif


#!/usr/local/bin/a68g --script #

PRAGMAT portcheck PRAGMAT
PR portcheck PR

BEGIN PR heap=256M PR # algol68g pragma #
  ~
END;

PROC (REAL)REAL s = sin();

SKIP


10 TRON: REM activate system trace pragma
20 TROFF: REM deactivate system trace pragma


/*Almost every C program has the below line,
the #include preprocessor directive is used to
instruct the compiler which files to load before compiling the program.

All preprocessor commands begin with #
*/
#include<stdio.h>

/*The #define preprocessor directive is often used to create abbreviations for code segments*/
#define Hi printf("Hi There.");

/*It can be used, or misused, for rather innovative uses*/

#define start int main(){
#define end return 0;}

start

Hi

/*And here's the nice part, want your compiler to talk to you ?
Just use the #warning pragma if you are using a C99 compliant compiler
like GCC*/
#warning "Don't you have anything better to do ?"

#ifdef __unix__
#warning "What are you doing still working on Unix ?"
printf("\nThis is an Unix system.");
#elif _WIN32
#warning "You couldn't afford a 64 bit ?"
printf("\nThis is a 32 bit Windows system.");
#elif _WIN64
#warning "You couldn't afford an Apple ?"
printf("\nThis is a 64 bit Windows system.");
#endif

end

/*Enlightened ?*/


-compile( [compressed, {inline,[pi/0]}] ).


&trace # controls execution tracing
&error # controls error handling


9!:1 random seed (incomplete specification of state -- see 9!:45)
9!:3 default display for non-nouns
9!:7 box drawing characters
9!:9 error messages
9!:11 print precision
9!:17 centering (or not) when box contents are smaller than boxes
9!:19 comparison tolerance
9!:21 memory limit
9!:25 security level
9!:27 text of immediate execution phrase
9!:29 enable immediate execution phrase
9!:33 execution time limit
9!:35 disable (or re-enable) assertions
9!:37 output control
9!:39 locales' hash table size
9!:41 retain (or not) whitespace and comments in explicit definitions
9!:43 which random number generator to use?
9!:45 what is the current state of that rng?
9!:49 enable reserved words for argument names


x = rand(100, 100)
y = rand(100, 100)

@inbounds begin
    for i = 1:100
        for j = 1:100
            x[i, j] *= y[i, j]
            y[i, j] += x[i, j]
        end
    end
end


// version 1.0.6

@Suppress("UNUSED_VARIABLE")

fun main(args: Array<String>) {
    val s = "To be suppressed"
}


ffi = require("ffi")
ffi.cdef[[
  #pragma pack(1)
  typedef struct { char c; int i; } foo;
  #pragma pack(4)
  typedef struct { char c; int i; } bar;
]]
print(ffi.sizeof(ffi.new("foo")))
print(ffi.sizeof(ffi.new("bar")))


{.checks: off, optimization: speed.}    # Checks are deactivated and code is generated for speed.

# Define a type Color as pure which implies that value names are declared in their own scope
# and may/should be accessed with their type qualifier (as Color.Red).
type Color {.pure.} = enum Red, Green, Blue

# Declare a procedure to inline if possible.
proc odd(x: int): bool {.inline.} = (x and 1) != 0

# Declaration of a C external procedure.
proc printf(formatstr: cstring) {.header: "<stdio.h>", importc: "printf", varargs.}

# Declaration of a deprecated procedure. If not used, no warning will be emitted.
proc notUsed(x: int) {.used, deprecated.} = echo x

# Declaration of a type with an alignment constraint.
type SseType = object
  sseData {.align(16).}: array[4, float32]

# Declaration of a procedure containing a variable to store in register, if possible, and a variable to store as global.
proc p() =
  var x {.register.}: int
  var y {.global.} = "abcdef"

{.push checks: on.}
# From here, checks are activated.
...
{.pop.}
# From here, checks are deactivated again.


use warnings;  # use warnings pragma module
use strict;    # use strict pragma module


requires(JS)
--requires(WINDOWS) -- (one of only, or
--requires(LINUX)   --  a special combo)
requires("1.0.2")
requires(32)        -- or 64


    declare (t(100),i) fixed binary;
    i=101;
    t(i)=0;


#Requires -Version <N>[.<n>]
#Requires –PSSnapin <PSSnapin-Name> [-Version <N>[.<n>]]
#Requires -Modules { <Module-Name> | <Hashtable> }
#Requires –ShellId <ShellId>
#Requires -RunAsAdministrator


Python 3.2 (r32:88445, Feb 20 2011, 21:30:00) [MSC v.1500 64 bit (AMD64)] on win32
Type "copyright", "credits" or "license()" for more information.
>>> import __future__
>>> __future__.all_feature_names
['nested_scopes', 'generators', 'division', 'absolute_import', 'with_statement', 'print_function', 'unicode_literals', 'barry_as_FLUFL']
>>>


use MONKEY-TYPING;
augment class Int {
    method times (&what) { what() xx self }  # pretend like we're Ruby
}


The REXX language has several pragmatic statements:
   ∙   NUMERIC DIGITS   {nnn}
   ∙   NUMERIC FORM     {ENGINEERING │ SCIENTIFIC}
   ∙   NUMERIC FUZZ     {nnn}
   ∙   OPTIONS          {xxx yyy zzz}
   ∙   TRACE            {options}
   ∙   SIGNAL           {ON │ OFF}   LOSTDIGITS
   ∙   SIGNAL           {ON │ OFF}   NOVALUE
   ∙   SIGNAL           {ON │ OFF}   SYNTAX
   ∙   SIGNAL │ CALL    {ON │ OFF}   ERROR
   ∙   SIGNAL │ CALL    {ON │ OFF}   FAILURE
   ∙   SIGNAL │ CALL    {ON │ OFF}   HALT
   ∙   SIGNAL │ CALL    {ON │ OFF}   NOTREADY


set -vx    # Activate both script line output and command line arguments pragma
set +vx    # Deactivate both pragmatic directives


/* windows.wren */

class Windows {
    static message { "Using Windows" }
    static lineSeparator { "\\r\\n" }
}


   string 0;   \makes all following strings in the code zero-terminated
   string 1;   \(or any non-zero argument) reverts to MSB termination


F is_wprime(Int64 n)
   R n > 1 & (n == 2 | (n % 2 & (factorial(n - 1) + 1) % n == 0))

V c = 20
print(‘Primes under #.:’.format(c), end' "\n  ")
print((0 .< c).filter(n -> is_wprime(n)))


	cpu	8086
	org	100h
section	.text
	jmp	demo
	;;;	Wilson primality test of CX.
	;;;	Zero flag set if CX prime. Destroys AX, BX, DX.
wilson:	xor	ax,ax		; AX will hold intermediate fac-mod value
	inc	ax
	mov	bx,cx		; BX = factorial loop counter
	dec	bx
.loop:	mul	bx		; DX:AX = AX*BX
	div	cx		; modulus goes in DX
	mov	ax,dx
	dec	bx		; Next value
	jnz	.loop		; If not zero yet, go again
	inc	ax		; fac-mod + 1 equal to input?
	cmp	ax,cx		; Set flags according to result
	ret
	;;;	Demo: print primes under 256
demo:	mov	cx,2
.loop:	call	wilson		; Is it prime?
	jnz	.next		; If not, try next number
	mov	ax,cx
	call	print		; Otherwise, print the number
.next:	inc	cl		; Next number.
	jnz	.loop		; If <256, try next number
	ret
	;;;	Print value in AX using DOS syscall
print:	mov	bp,10		; Divisor
	mov	bx,numbuf	; Pointer to buffer
.digit:	xor	dx,dx
	div	bp		; Divide AX and get digit in DX
	add	dl,'0'		; Make ASCII
	dec	bx		; Store in buffer
	mov	[bx],dl
	test	ax,ax		; Done yet?
	jnz	.digit		; If not, get next digit
	mov	dx,bx		; Print buffer
	mov	ah,9		; 9 = MS-DOS syscall to print a string
	int	21h
	ret
section	.data
	db	'*****'		; Space to hold ASCII number for output
numbuf:	db	13,10,'$'


--
-- Determine primality using Wilon's theorem.
-- Uses the approach from Algol W
-- allowing large primes without the use of big numbers.
--
with Ada.Text_IO; use Ada.Text_IO;

procedure Main is
   type u_64 is mod 2**64;
   package u_64_io is new modular_io (u_64);
   use u_64_io;

   function Is_Prime (n : u_64) return Boolean is
      fact_Mod_n : u_64 := 1;
   begin
      if n < 2 then
         return False;
      end if;
      for i in 2 .. n - 1 loop
         fact_Mod_n := (fact_Mod_n * i) rem n;
      end loop;
      return fact_Mod_n = n - 1;
   end Is_Prime;

   num : u_64 := 1;
   type cols is mod 12;
   count : cols := 0;
begin
   while num < 500 loop
      if Is_Prime (num) then
         if count = 0 then
            New_Line;
         end if;
         Put (Item => num, Width => 6);
         count := count + 1;
      end if;
      num := num + 1;
   end loop;
end Main;


BEGIN
    # find primes using Wilson's theorem:                               #
    #    p is prime if ( ( p - 1 )! + 1 ) mod p = 0                     #

    # returns true if p is a prime by Wilson's theorem, false otherwise #
    #         computes the factorial mod p at each stage, so as to      #
    #         allow numbers whose factorial won't fit in 32 bits        #
    PROC is wilson prime = ( INT p )BOOL:
         BEGIN
            INT factorial mod p := 1;
            FOR i FROM 2 TO p - 1 DO factorial mod p *:= i MODAB p OD;
            factorial mod p = p - 1
         END # is wilson prime # ;

    FOR i TO 100 DO IF is wilson prime( i ) THEN print( ( " ", whole( i, 0 ) ) ) FI OD
END


begin
    % find primes using Wilson's theorem:                               %
    %    p is prime if ( ( p - 1 )! + 1 ) mod p = 0                     %

    % returns true if n is a prime by Wilson's theorem, false otherwise %
    %         computes the factorial mod p at each stage, so as to      %
    %         allow numbers whose factorial won't fit in 32 bits        %
    logical procedure isWilsonPrime ( integer value n ) ;
    begin
        integer factorialModN;
        factorialModN := 1;
        for i := 2 until n - 1 do factorialModN := ( factorialModN * i ) rem n;
        factorialModN = n - 1
    end isWilsonPrime ;

    for i := 1 until 100 do if isWilsonPrime( i ) then writeon( i_w := 1, s_w := 0, " ", i );
end.


on isPrime(n)
    if (n < 2) then return false
    set f to n - 1
    repeat with i from (n - 2) to 2 by -1
        set f to f * i mod n
    end repeat

    return ((f + 1) mod n = 0)
end isPrime

local output, n
set output to {}
repeat with n from 0 to 500
    if (isPrime(n)) then set end of output to n
end repeat
output


factorial: function [x]-> product 1..x

wprime?: function [n][
    if n < 2 -> return false
    zero? mod add factorial sub n 1 1 n
]

print "Primes below 20 via Wilson's theorem:"
print select 1..20 => wprime?


# syntax: GAWK -f PRIMALITY_BY_WILSONS_THEOREM.AWK
# converted from FreeBASIC
BEGIN {
    start = 2
    stop = 200
    for (i=start; i<=stop; i++) {
      if (is_wilson_prime(i)) {
        printf("%5d%1s",i,++count%10?"":"\n")
      }
    }
    printf("\nWilson primality test range %d-%d: %d\n",start,stop,count)
    exit(0)
}
function is_wilson_prime(n,  fct,i) {
    fct = 1
    for (i=2; i<=n-1; i++) {
      # because (a mod n)*b = (ab mod n)
      # it is not necessary to calculate the entire factorial
      fct = (fct * i) % n
    }
    return(fct == n-1)
}


function wilson_prime(n)
    fct = 1
    for i = 2 to n-1
        fct = (fct * i) mod n
    next i
    if fct = n-1 then return True else return False
end function

print "Primes below 100" & Chr(10)
for i = 2 to 100
    if wilson_prime(i) then print i; "   ";
next i
end


#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>

uint64_t factorial(uint64_t n) {
    uint64_t product = 1;

    if (n < 2) {
        return 1;
    }

    for (; n > 0; n--) {
        uint64_t prev = product;
        product *= n;
        if (product < prev) {
            fprintf(stderr, "Overflowed\n");
            return product;
        }
    }

    return product;
}

// uses wilson's theorem
bool isPrime(uint64_t n) {
    uint64_t large = factorial(n - 1) + 1;
    return (large % n) == 0;
}

int main() {
    uint64_t n;

    // Can check up to 21, more will require a big integer library
    for (n = 2; n < 22; n++) {
        printf("Is %llu prime: %d\n", n, isPrime(n));
    }

    return 0;
}


using System;
using System.Linq;
using System.Collections;
using static System.Console;
using System.Collections.Generic;
using BI = System.Numerics.BigInteger;

class Program {

  // initialization
    const int fst = 120, skp = 1000, max = 1015; static double et1, et2; static DateTime st;
    static string ms1 = "Wilson's theorem method", ms2 = "Sieve of Eratosthenes method",
       fmt = "--- {0} ---\n\nThe first {1} primes are:", fm2 = "{0} prime thru the {1} prime:";
    static List<int> lst = new List<int>();

  // dumps a chunk of the prime list (lst)
    static void Dump(int s, int t, string f) {
        foreach (var item in lst.Skip(s).Take(t)) Write(f, item); WriteLine("\n"); }

  // returns the ordinal string representation of a number
    static string Ord(int x, string fmt = "{0:n0}") {
      var y = x % 10; if ((x % 100) / 10 == 10 || y > 3) y = 0;
      return string.Format(fmt, x) + "thstndrd".Substring(y << 1, 2); }

  // shows the results of one type of prime tabulation
    static void ShowOne(string title, ref double et) {
        WriteLine(fmt, title, fst); Dump(0, fst, "{0,-3} ");
        WriteLine(fm2, Ord(skp), Ord(max)); Dump(skp - 1, max - skp + 1, "{0,4} ");
        WriteLine("Time taken: {0}ms\n", et = (DateTime.Now - st).TotalMilliseconds); }

  // for stand-alone computation
    static BI factorial(int n) { BI res = 1; if (n < 2) return res;
        while (n > 0) res *= n--; return res; }

    static bool WTisPrimeSA(int n) { return ((factorial(n - 1) + 1) % n) == 0; }

    static BI[] facts;

    static void initFacts(int n) {
        facts = new BI[n]; facts[0] = facts[1] = 1;
        for (int i = 1, j = 2; j < n; i = j++)
            facts[j] = facts[i] * j; }

    static bool WTisPrime(int n) { return ((facts[n - 1] + 1) % n) == 0; }
  // end stand-alone

    static void Main(string[] args) { st = DateTime.Now;
        BI f = 1; for (int n = 2; lst.Count < max; f *= n++) if ((f + 1) % n == 0) lst.Add(n);
        ShowOne(ms1, ref et1);
        st = DateTime.Now; int lmt = lst.Last(); lst.Clear(); BitArray flags = new BitArray(lmt + 1);
        for (int n = 2; n <= lmt; n+=n==2?1:2) if (!flags[n]) {
                lst.Add(n); for (int k = n * n, n2=n<<1; k <= lmt; k += n2) flags[k] = true; }
        ShowOne(ms2, ref et2);
        WriteLine("{0} was {1:0.0} times slower than the {2}.", ms1, et1 / et2, ms2);

      // stand-alone computation
        WriteLine("\n" + ms1 + " stand-alone computation:");
        WriteLine("factorial computed for each item");
        st = DateTime.Now;
        for (int x = lst[skp - 1]; x <= lst[max - 1]; x++) if (WTisPrimeSA(x)) Write("{0,4} ", x);
        WriteLine(); WriteLine("\nTime taken: {0}ms\n", (DateTime.Now - st).TotalMilliseconds);

        WriteLine("factorials precomputed up to highest item");
        st = DateTime.Now; initFacts(lst[max - 1]);
        for (int x = lst[skp - 1]; x <= lst[max - 1]; x++) if (WTisPrime(x)) Write("{0,4} ", x);
        WriteLine(); WriteLine("\nTime taken: {0}ms\n", (DateTime.Now - st).TotalMilliseconds);
    }
}


#include <iomanip>
#include <iostream>

int factorial_mod(int n, int p) {
    int f = 1;
    for (; n > 0 && f != 0; --n)
        f = (f * n) % p;
    return f;
}

bool is_prime(int p) {
    return p > 1 && factorial_mod(p - 1, p) == p - 1;
}

int main() {
    std::cout << "  n | prime?\n------------\n";
    std::cout << std::boolalpha;
    for (int p : {2, 3, 9, 15, 29, 37, 47, 57, 67, 77, 87, 97, 237, 409, 659})
        std::cout << std::setw(3) << p << " | " << is_prime(p) << '\n';

    std::cout << "\nFirst 120 primes by Wilson's theorem:\n";
    int n = 0, p = 1;
    for (; n < 120; ++p) {
        if (is_prime(p))
            std::cout << std::setw(3) << p << (++n % 20 == 0 ? '\n' : ' ');
    }

    std::cout << "\n1000th through 1015th primes:\n";
    for (int i = 0; n < 1015; ++p) {
        if (is_prime(p)) {
            if (++n >= 1000)
                std::cout << std::setw(4) << p << (++i % 16 == 0 ? '\n' : ' ');
        }
    }
}


% Wilson primality test
wilson = proc (n: int) returns (bool)
    if n<2 then return (false) end
    fac_mod: int := 1
    for i: int in int$from_to(2, n-1) do
        fac_mod := fac_mod * i // n
    end
    return (fac_mod + 1 = n)
end wilson

% Print primes up to 100 using Wilson's theorem
start_up = proc ()
    po: stream := stream$primary_output()
    for i: int in int$from_to(1, 100) do
        if wilson(i) then
            stream$puts(po, int$unparse(i) || " ")
        end
    end
    stream$putl(po, "")
end start_up


(defun factorial (n)
  (if (< n 2) 1 (* n (factorial (1- n)))) )

(defun primep (n)
 "Primality test using Wilson's Theorem"
  (unless (zerop n)
    (zerop (mod (1+ (factorial (1- n))) n)) ))


include "cowgol.coh";

# Wilson primality test
sub wilson(n: uint32): (out: uint8) is
    out := 0;
    if n >= 2 then
        var facmod: uint32 := 1;
        var ct := n - 1;
        while ct > 0 loop
            facmod := (facmod * ct) % n;
            ct := ct - 1;
        end loop;
        if facmod + 1 == n then
            out := 1;
        end if;
    end if;
end sub;

# Print primes up to 100 according to Wilson
var i: uint32 := 1;
while i < 100 loop
    if wilson(i) == 1 then
        print_i32(i);
        print_char(' ');
    end if;
    i := i + 1;
end loop;
print_nl();


import std.bigint;
import std.stdio;

BigInt fact(long n) {
    BigInt f = 1;
    for (int i = 2; i <= n; i++) {
        f *= i;
    }
    return f;
}

bool isPrime(long p) {
    if (p <= 1) {
        return false;
    }
    return (fact(p - 1) + 1) % p == 0;
}

void main() {
    writeln("Primes less than 100 testing by Wilson's Theorem");
    foreach (i; 0 .. 101) {
        if (isPrime(i)) {
            write(i, ' ');
        }
    }
    writeln;
}


[Primes by Wilson's Theoem, for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
            T51K P64F  [address for G parameter: low-level subroutines]
            T47K P130F [M parameter: main routine + high-level subroutine]

[======== M parameter: Main routine + high-level subroutine ============]
            E25K TM GK
[Editable range of integers to be tested for primality.]
[Integers are stored right-justified, so e.g. 1000 is P500F.]
      [0]   P500F   [lowest]
      [1]   P550F   [highest]
[Constants used with the M parameter]
      [2]   PD      [17-bit 1; also serves as letter P]
      [3]   K2048F  [set letters mode]
      [4]   #F      [set figures mode]
      [5]   RF      [letter R]
      [6]   IF      [letter I]
      [7]   MF      [letter M in letters mode, dot in figures mode]
      [8]   @F      [carriage return]
      [9]   &F      [line feed]
     [10]   !F      [space character]
     [11]   K4096F  [null character]

[Subroutine for testing whether 17-bit integer n is a prime,
  using Wilson's Theorem with short cut.]
[Input:  n in 6F.]
[Output: 0F holds 0 if n is prime, negative if n is not prime.]
     [12]   A3F [email protected]        [plant return link as usual         ]
            A6F S2F [email protected]    [acc := n - 2, exit if n < 2]
            [email protected] [email protected]        [r := n - 1, clear acc]
            T7F             [extend n to 35 bits in 6D]
            [email protected] [email protected] [email protected]   [f := 1;  m := 1]
            A2F [email protected]        [m2inc := 3]
     [25]   [email protected] [email protected] [email protected]  [if r < m2inc jump to part 2]
            [email protected]            [dec( r, m2inc)]
            [email protected] [email protected] [email protected]   [inc( m)]
            [email protected] [email protected]       [acc := f*m]
[Note that f and m are held as f/2^16 and m/2^16, so their product is (f*m)/2^32.
 We want to store the product as (f*m)/2^34, hence need to shift 2 right]
            R1F T4D         [shift product and pass to modulo subroutine]
     [36]   [email protected] G38G       [call modulo subroutine]
            A4F [email protected]        [f := product modulo n]
            [email protected] A2F [email protected]   [inc( m2inc, 2)]
            [email protected]            [always loop back]
[Part 2: Euclid's algorithm]
     [44]   TF              [clear acc]
            [email protected]         [h := n]
     [47]   [email protected] [email protected]       [if f = 0 then jump to test HCF]
            TF              [clear acc]
            [email protected] T6F T7F    [f to 6F and extend to 35 bits in 6D]
            [email protected] T4F T5F    [h to 4F and extend to 35 bits in 4D]
     [56]   [email protected] G38G       [call subroutine, 4F := h modulo f]
            [email protected] [email protected]       [h := f]
            A4F [email protected]        [f := (old h) modulo f]
            [email protected]            [always loop back]
[Here with acc = 0. Test for h = 1]
     [63]   [email protected] [email protected]        [acc := h - 1]
            [email protected]            [return false if h = 0]
            TF SF           [acc := 1 - h]
     [68]   TF              [return result in 0F]
     [69]   ZF              [(planted) jump back to caller]
[Variables with names as in Pascal program]
     [70]   PF [m]
     [71]   PF [f]
     [72]   PF [r]
     [73]   PF [m2inc]
     [74]   PF [h]

[Subroutine for finding and printing primes between the passed-in limits]
[Input:  4F = minimum value, 5F = maximum value]
[Output: None. 4F and 5F are not preserved.]
     [75]   A3F [email protected]      [plant return link as usual]
           [Set letters mode, write 'PRIMES ', set figures mode]
            [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected]
            A5F [email protected]       [store maximum value locally]
            A4F [email protected]       [store minimum value locally]
            TF              [pass minimum value to print subroutine]
            [email protected] T1F        [pass null for leading zeros]
     [93]   [email protected] GG         [call print subroutine]
            [email protected] [email protected]         [print 2 dots for range]
            A130 @TF        [pass maximum value to print routine]
     [99]   [email protected] GG         [call print subroutine]
            [email protected] [email protected]         [print CRLF]
    [103]   [email protected]           [load n_max]
    [104]   [email protected]           [subtract n; also serves as letter S]
            [email protected]           [exit if n > n_max]
            TF              [clear acc]
            A129 @T6F       [pass current n to prime-testing subroutine]
    [109]   [email protected] G12M      [call prime-testing subroutine]
            AF [email protected]        [load result, skip printing if n isn't prime]
            [email protected]            [print space]
            A129 @TF        [pass n to print subroutine]
            [email protected] T1F        [pass null for leading zeros]
    [118]   [email protected] GG        [call print subroutine]
    [120]   TF              [clear acc]
            [email protected] [email protected] [email protected] [inc(n)]
    [124]   [email protected]           [always loop back; also serves as letter E]
    [125]   [email protected] [email protected]         [print CRLF]
            TF              [clear acc before return (EDSAC convention)]
    [128]   ZF              [(planted) jump back to caller]
[Variables]
    [129]   PF [n]
    [130]   PF [n_max]

[Enter with acc = 0]
    [131]   [email protected] T4F          [pass lower limit to prime-finding subroutine]
            [email protected] T5F         [pass upper limit to prime-finding subroutine]
    [135]   [email protected] G75M      [call prime-finding subroutine]
            [email protected]            [print null to flush printer buffer]
            ZF              [stop]

[==================== G parameter: Low-level subroutines ====================]
            E25K TG
[Subroutine to print non-negative 17-bit integer. Always prints 5 chars.]
[Caller specifies character for leading 0 (typically 0, space or null).]
[Parameters: 0F = integer to be printed (not preserved)]
            [1F = character for leading zero (preserved)]
[Workspace: 4F..7F, 38 locations]
      [0]   [email protected]@T6FT4#[email protected]#[email protected]@O7FA2F
            T6FT5FV4#FYFL8FT4#[email protected]@ZFP4FZ219DTF

[Subroutine to find X modulo M, where X and M are 35-bit integers.]
[Input:  X >= 0 in 4D, M > 0 in 6D.]
[Output: X modulo M in 4D, M preserved in 6D. Does not return the quotient.]
[Workspace: 0F.  27 locations.]
     [38]   [email protected]@[email protected]
            [email protected]@[email protected]

[======== M parameter again ============]
            E25K TM GK
            E131Z   [define entry point]
            PF      [acc = 0 on entry]
[end]


#! /usr/bin/escript

isprime(N) when N < 2 -> false;
isprime(N) when N band 1 =:= 0 -> N =:= 2;
isprime(N) -> fac_mod(N - 1, N) =:= N - 1.

fac_mod(N, M) -> fac_mod(N, M, 1).
fac_mod(1, _, A) -> A;
fac_mod(N, M, A) -> fac_mod(N - 1, M, A*N rem M).

main(_) ->
    io:format("The first few primes (via Wilson's theorem) are: ~n~p~n",
              [[K || K <- lists:seq(1, 128), isprime(K)]]).


// Wilsons theorem. Nigel Galloway: August 11th., 2020
let wP(n,g)=(n+1I)%g=0I
let fN=Seq.unfold(fun(n,g)->Some((n,g),((n*g),(g+1I))))(1I,2I)|>Seq.filter wP
fN|>Seq.take 120|>Seq.iter(fun(_,n)->printf "%A " n);printfn "\n"
fN|>Seq.skip 999|>Seq.take 15|>Seq.iter(fun(_,n)->printf "%A " n);printfn ""


USING: formatting grouping io kernel lists lists.lazy math
math.factorials math.functions prettyprint sequences ;

: wilson ( n -- ? ) [ 1 - factorial 1 + ] [ divisor? ] bi ;
: prime? ( n -- ? ) dup 2 < [ drop f ] [ wilson ] if ;
: primes ( -- list ) 1 lfrom [ prime? ] lfilter ;

"n    prime?\n---  -----" print
{ 2 3 9 15 29 37 47 57 67 77 87 97 237 409 659 }
[ dup prime? "%-3d  %u\n" printf ] each nl

"First 120 primes via Wilson's theorem:" print
120 primes ltake list>array 20 group simple-table. nl

"1000th through 1015th primes:" print
16 primes 999 [ cdr ] times ltake list>array
[ pprint bl ] each nl


Func Wilson(n) = if ((n-1)!+1)|n = 0 then 1 else 0 fi.;


: fac-mod ( n m -- r )
    >r 1 swap
    begin dup 0> while
        dup rot * [email protected] mod  swap 1-
    repeat drop rdrop ;

: ?prime ( n -- f )
    dup 1- tuck swap fac-mod = ;

: .primes ( n -- )
    cr 2 ?do i ?prime if i . then loop ;


function wilson_prime( n as uinteger ) as boolean
    dim as uinteger fct=1, i
    for i = 2 to n-1
        'because   (a mod n)*b = (ab mod n)
        'it is not necessary to calculate the entire factorial
        fct = (fct * i) mod n
    next i
    if fct = n-1 then return true else return false
end function

for i as uinteger = 2 to 100
    if wilson_prime(i) then print i,
next i


# find primes using Wilson's theorem:
#    p is prime if ( ( p - 1 )! + 1 ) mod p = 0

isWilsonPrime := function( p )
    local fModP, i;
    fModP := 1;
    for i in [ 2 .. p - 1 ] do fModP := fModP * i; fModP := fModP mod p; od;
    return fModP = p - 1;
end; # isWilsonPrime

prime := [];
for i in [ -4 .. 100 ] do if isWilsonPrime( i ) then Add( prime, i ); fi; od;
Display( prime );


package main

import (
    "fmt"
    "math/big"
)

var (
    zero = big.NewInt(0)
    one  = big.NewInt(1)
    prev = big.NewInt(factorial(20))
)

// Only usable for n <= 20.
func factorial(n int64) int64 {
    res := int64(1)
    for k := n; k > 1; k-- {
        res *= k
    }
    return res
}

// If memo == true, stores previous sequential
// factorial calculation for odd n > 21.
func wilson(n int64, memo bool) bool {
    if n <= 1 || (n%2 == 0 && n != 2) {
        return false
    }
    if n <= 21 {
        return (factorial(n-1)+1)%n == 0
    }
    b := big.NewInt(n)
    r := big.NewInt(0)
    z := big.NewInt(0)
    if !memo {
        z.MulRange(2, n-1) // computes factorial from scratch
    } else {
        prev.Mul(prev, r.MulRange(n-2, n-1)) // uses previous calculation
        z.Set(prev)
    }
    z.Add(z, one)
    return r.Rem(z, b).Cmp(zero) == 0
}

func main() {
    numbers := []int64{2, 3, 9, 15, 29, 37, 47, 57, 67, 77, 87, 97, 237, 409, 659}
    fmt.Println("  n  prime")
    fmt.Println("---  -----")
    for _, n := range numbers {
        fmt.Printf("%3d  %t\n", n, wilson(n, false))
    }

    // sequential memoized calculation
    fmt.Println("\nThe first 120 prime numbers are:")
    for i, count := int64(2), 0; count < 1015; i += 2 {
        if wilson(i, true) {
            count++
            if count <= 120 {
                fmt.Printf("%3d ", i)
                if count%20 == 0 {
                    fmt.Println()
                }
            } else if count >= 1000 {
                if count == 1000 {
                    fmt.Println("\nThe 1,000th to 1,015th prime numbers are:")
                }
                fmt.Printf("%4d ", i)
            }
        }
        if i == 2 {
            i--
        }
    }
    fmt.Println()
}


import qualified Data.Text as T
import Data.List

main = do
    putStrLn $ showTable True ' ' '-' ' ' $ ["p","isPrime"]:map (\p -> [show p, show $ isPrime p]) numbers
    putStrLn $ "The first 120 prime numbers are:"
    putStrLn $ see 20 $ take 120 primes
    putStrLn "The 1,000th to 1,015th prime numbers are:"
    putStrLn $ see 16.take 16 $ drop 999 primes

numbers = [2,3,9,15,29,37,47,57,67,77,87,97,237,409,659]

primes = [p | p <- 2:[3,5..], isPrime p]

isPrime :: Integer -> Bool
isPrime p = if p < 2 then False else 0 == mod (succ $ product [1..pred p]) p

bagOf :: Int -> [a] -> [[a]]
bagOf _ [] = []
bagOf n xs = let (us,vs) = splitAt n xs in us : bagOf n vs

see :: Show a => Int -> [a] -> String
see n = unlines.map unwords.bagOf n.map (T.unpack.T.justifyRight 3 ' '.T.pack.show)

showTable::Bool -> Char -> Char -> Char -> [[String]] -> String
showTable _ _ _ _ [] = []
showTable header ver hor sep contents = unlines $ hr:(if header then z:hr:zs else intersperse hr zss) ++ [hr]
   where
   vss = map (map length) $ contents
   ms = map maximum $ transpose vss ::[Int]
   hr = concatMap (\ n -> sep : replicate n hor) ms ++ [sep]
   top = replicate (length hr) hor
   bss = map (\ps -> map (flip replicate ' ') $ zipWith (-) ms ps) $ vss
   zss@(z:zs) = zipWith (\us bs -> (concat $ zipWith (\x y -> (ver:x) ++ y) us bs) ++ [ver]) contents bss


import java.math.BigInteger;

public class PrimaltyByWilsonsTheorem {

    public static void main(String[] args) {
        System.out.printf("Primes less than 100 testing by Wilson's Theorem%n");
        for ( int i = 0 ; i <= 100 ; i++ ) {
            if ( isPrime(i) ) {
                System.out.printf("%d ", i);
            }
        }
    }

    private static boolean isPrime(long p) {
        if ( p <= 1) {
            return false;
        }
        return fact(p-1).add(BigInteger.ONE).mod(BigInteger.valueOf(p)).compareTo(BigInteger.ZERO) == 0;
    }

    private static BigInteger fact(long n) {
        BigInteger fact = BigInteger.ONE;
        for ( int i = 2 ; i <= n ; i++ ) {
            fact = fact.multiply(BigInteger.valueOf(i));
        }
        return fact;
    }

}


## Compute (n - 1)! mod m.
def facmod($n; $m):
  reduce range(2; $n+1) as $k (1; (. * $k) % $m);

def isPrime: .>1 and (facmod(. - 1; .) + 1) % . == 0;

"Prime numbers between 2 and 100:",
[range(2;101) | select (isPrime)],

# Notice that `infinite` can be used as the second argument of `range`:
"First 10 primes after 7900:",
[limit(10; range(7900; infinite) | select(isPrime))]


iswilsonprime(p) = (p < 2 || (p > 2 && iseven(p))) ? false : foldr((x, y) -> (x * y) % p, 1:p - 1) == p - 1

wilsonprimesbetween(n, m) = [i for i in n:m if iswilsonprime(i)]

println("First 120 Wilson primes: ", wilsonprimesbetween(1, 1000)[1:120])
println("\nThe first 40 Wilson primes above 7900 are: ", wilsonprimesbetween(7900, 9000)[1:40])


-- primality by Wilson's theorem

function isWilsonPrime( n )
    local fmodp = 1
    for i = 2, n - 1 do
        fmodp = fmodp * i
        fmodp = fmodp % n
    end
    return fmodp == n - 1
end

for n = -1, 100 do
    if isWilsonPrime( n ) then
       io.write( " " .. n )
    end
end


ClearAll[WilsonPrimeQ]
WilsonPrimeQ[1] = False;
WilsonPrimeQ[p_Integer] := Divisible[(p - 1)! + 1, p]
Select[Range[100], WilsonPrimeQ]


import strutils, sugar

proc facmod(n, m: int): int =
  ## Compute (n - 1)! mod m.
  result = 1
  for k in 2..n:
    result = (result * k) mod m

func isPrime(n: int): bool = (facmod(n - 1, n) + 1) mod n == 0

let primes = collect(newSeq):
               for n in 2..100:
                 if n.isPrime: n

echo "Prime numbers between 2 and 100:"
echo primes.join(" ")


program PrimesByWilson;
uses SysUtils;

(* Function to return whether 32-bit unsigned n is prime.
   Applies Wilson's theorem with full calculation of (n - 1)! modulo n. *)
function WilsonFullCalc( n : longword) : boolean;
var
  f, m : longword;
begin
  if n < 2 then begin
    result := false;  exit;
  end;
  f := 1;
  for m := 2 to n - 1 do begin
    f := (uint64(f) * uint64(m)) mod n; // typecast is needed
  end;
  result := (f = n - 1);
end;

(* Function to return whether 32-bit unsigned n is prime.
   Applies Wilson's theorem with a short cut. *)
function WilsonShortCut( n : longword) : boolean;
var
  f, g, h, m, m2inc, r : longword;
begin
  if n < 2 then begin
    result := false;  exit;
  end;
  (* Part 1: Factorial (modulo n) of floor(sqrt(n)) *)
  f := 1;
  m := 1;
  m2inc := 3; // (m + 1)^2 - m^2
  // Want to loop while m^2 <= n, but if n is close to 2^32 - 1 then least
  //   m^2 > n overflows 32 bits. Work round this by looking at r = n - m^2.
  r := n - 1;
  while r >= m2inc do begin
    inc(m);
    f := (uint64(f) * uint64(m)) mod n;
    dec( r, m2inc);
    inc( m2inc, 2);
  end;
 (* Part 2: Euclid's algorithm: at the end, h = HCF( f, n) *)
  h := n;
  while f <> 0 do begin
    g := h mod f;
    h := f;
    f := g;
  end;
  result := (h = 1);
end;

type TPrimalityTest = function( n : longword) : boolean;
procedure ShowPrimes( isPrime : TPrimalityTest;
                      minValue, maxValue : longword);
var
  n : longword;
begin
  WriteLn( 'Primes in ', minValue, '..', maxValue);
  for n := minValue to maxValue do
    if isPrime(n) then Write(' ', n);
  WriteLn;
end;

(* Main routine *)
begin
  WriteLn( 'By full calculation:');
  ShowPrimes( @WilsonFullCalc, 1, 100);
  ShowPrimes( @WilsonFullCalc, 1000, 1100);
  WriteLn; WriteLn( 'Using the short cut:');
  ShowPrimes( @WilsonShortCut, 1, 100);
  ShowPrimes( @WilsonShortCut, 1000, 1100);
  ShowPrimes( @WilsonShortCut, 4294967195, 4294967295 {= 2^32 - 1});
end.


use strict;
use warnings;
use feature 'say';
use ntheory qw(factorial);

my($ends_in_7, $ends_in_3);

sub is_wilson_prime {
    my($n) = @_;
    $n > 1 or return 0;
    (factorial($n-1) % $n) == ($n-1) ? 1 : 0;
}

for (0..50) {
    my $m = 3 + 10 * $_;
    $ends_in_3 .= "$m " if is_wilson_prime($m);
    my $n = 7 + 10 * $_;
    $ends_in_7 .= "$n " if is_wilson_prime($n);
}

say $ends_in_3;
say $ends_in_7;


function wilson(integer n)
    integer facmod = 1
    for i=2 to n-1 do
        facmod = remainder(facmod*i,n)
    end for
    return facmod+1=n
end function

atom t0 = time()
sequence primes = {}
integer p = 2
while length(primes)<1015 do
    if wilson(p) then
        primes &= p
    end if
    p += 1
end while
printf(1,"The first 25 primes: %V\n",{primes[1..25]})
printf(1,"          builtin: %V\n",{get_primes(-25)})
printf(1,"primes[1000..1015]: %V\n",{primes[1000..1015]})
printf(1,"         builtin: %V\n",{get_primes(-1015)[1000..1015]})
?elapsed(time()-t0)


To run:
Start up.
Show some primes (via Wilson's theorem).
Wait for the escape key.
Shut down.

The maximum representable factorial is a number equal to 12.   \32-bit signed

To show some primes (via Wilson's theorem):
If a counter is past the maximum representable factorial, exit.
If the counter is prime (via Wilson's theorem), write "" then the counter then " " on the console without advancing.
Repeat.

A prime is a number.

A factorial is a number.

To find a factorial of a number:
Put 1 into the factorial.
Loop.
If a counter is past the number, exit.
Multiply the factorial by the counter.
Repeat.

To decide if a number is prime (via Wilson's theorem):
If the number is less than 1, say no.
Find a factorial of the number minus 1. Bump the factorial.
If the factorial is evenly divisible by the number, say yes.
Say no.


/* primality by Wilson's theorem */
wilson: procedure options( main );
   declare n binary(15)fixed;

   isWilsonPrime: procedure( n )returns( bit(1) );
      declare n            binary(15)fixed;
      declare ( fmodp, i ) binary(15)fixed;
      fmodp = 1;
      do i = 2 to n - 1;
         fmodp = mod( fmodp * i, n );
      end;
      return ( fmodp = n - 1 );
   end isWilsonPrime ;

   do n = 1 to 100;
      if isWilsonPrime( n ) then do;
         put edit( n ) ( f(3) );
      end;
   end;
end wilson ;


100H: /* FIND PRIMES USING WILSON'S THEOREM:                                */
      /*      P IS PRIME IF ( ( P - 1 )! + 1 ) MOD P = 0                    */

   DECLARE FALSE LITERALLY '0';

   BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
      DECLARE FN BYTE, ARG ADDRESS;
      GOTO 5;
   END BDOS;
   PRINT$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C ); END;
   PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
   PRINT$NUMBER: PROCEDURE( N );
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
      V = N;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PRINT$STRING( .N$STR( W ) );
   END PRINT$NUMBER;

   /* RETURNS TRUE IF P IS PRIME BY WILSON'S THEOREM, FALSE OTHERWISE       */
   /*         COMPUTES THE FACTORIAL MOD P AT EACH STAGE, SO AS TO ALLOW    */
   /*         FOR NUMBERS WHOSE FACTORIAL WON'T FIT IN 16 BITS              */
   IS$WILSON$PRIME: PROCEDURE( P )BYTE;
      DECLARE P ADDRESS;
      IF P < 2 THEN RETURN FALSE;
      ELSE DO;
         DECLARE ( I, FACTORIAL$MOD$P ) ADDRESS;
         FACTORIAL$MOD$P = 1;
         DO I = 2 TO P - 1;
            FACTORIAL$MOD$P = ( FACTORIAL$MOD$P * I ) MOD P;
         END;
         RETURN FACTORIAL$MOD$P = P - 1;
      END;
   END IS$WILSON$PRIME;

   DECLARE I ADDRESS;
   DO I = 1 TO 100;
      IF IS$WILSON$PRIME( I ) THEN DO;
         CALL PRINT$CHAR( ' ' );
         CALL PRINT$NUMBER( I );
      END;
   END;

EOF


/* PRIMALITY BY WILSON'S THEOREM */
wilson_100H: procedure options                                                  (main);

/* PL/I DEFINITIONS                                                             */
%include 'pg.inc';
/* PL/M DEFINITIONS: CP/M BDOS SYSTEM CALL AND CONSOLE I/O ROUTINES, ETC. */    /*
   DECLARE BINARY LITERALLY 'ADDRESS', CHARACTER LITERALLY 'BYTE';
   DECLARE SADDR  LITERALLY '.',       BIT       LITERALLY 'BYTE';
   BDOSF: PROCEDURE( FN, ARG )BYTE;
                               DECLARE FN BYTE, ARG ADDRESS; GOTO 5;   END;
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5;   END;
   PRCHAR:   PROCEDURE( C );   DECLARE C CHARACTER; CALL BDOS( 2, C ); END;
   PRNL:     PROCEDURE;        CALL PRCHAR( 0DH ); CALL PRCHAR( 0AH ); END;
   PRNUMBER: PROCEDURE( N );
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
      N$STR( W := LAST( N$STR ) ) = '$';
      N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL BDOS( 9, .N$STR( W ) );
   END PRNUMBER;
   MODF: PROCEDURE( A, B )ADDRESS;
      DECLARE ( A, B )ADDRESS;
      RETURN( A MOD B );
   END MODF;
/* END LANGUAGE DEFINITIONS */

   /* TASK */
   DECLARE N BINARY;

   ISWILSONPRIME: PROCEDURE( N )returns                                         (
                                BIT                                             )
                                ;
      DECLARE N            BINARY;
      DECLARE ( FMODP, I ) BINARY;
      FMODP = 1;
      DO I = 2 TO N - 1;
         FMODP = MODF( FMODP * I, N );
      END;
      RETURN ( FMODP = N - 1 );
   END ISWILSONPRIME ;

   DO N = 1 TO 100;
      IF ISWILSONPRIME( N ) THEN DO;
         CALL PRCHAR( ' ' );
         CALL PRNUMBER( N );
      END;
   END;

EOF: end wilson_100H ;


from math import factorial

def is_wprime(n):
    return n == 2 or (
        n > 1
        and n % 2 != 0
        and (factorial(n - 1) + 1) % n == 0
    )

if __name__ == '__main__':
    c = int(input('Enter upper limit: '))
    print(f'Primes under {c}:')
    print([n for n in range(c) if is_wprime(n)])


 [ 1 swap times [ i 1+ * ] ] is !     ( n --> n )

 [ dup 2 < iff
     [ drop false ] done
   dup 1 - ! 1+
   swap mod 0 = ]            is prime ( n --> b )

 say "Primes less than 500: "
 500 times
   [ i^ prime if
       [ i^ echo sp ] ]


sub postfix:<!> (Int $n) { (constant f = 1, |[\*] 1..*)[$n] }

sub is-wilson-prime (Int $p where * > 1) { (($p - 1)! + 1) %% $p }

# Pre initialize factorial routine (not thread safe)
9000!;

# Testing
put '   p  prime?';
printf("%4d  %s\n", $_, .&is-wilson-prime) for 2, 3, 9, 15, 29, 37, 47, 57, 67, 77, 87, 97, 237, 409, 659;

my $wilsons = (2,3,*+2…*).hyper.grep: &is-wilson-prime;

put "\nFirst 120 primes:";
put $wilsons[^120].rotor(20)».fmt('%3d').join: "\n";

put "\n1000th through 1015th primes:";
put $wilsons[999..1014];


/*REXX pgm tests for primality via Wilson's theorem: a # is prime if p divides (p-1)! +1*/
parse arg LO zz                                  /*obtain optional arguments from the CL*/
if LO=='' | LO==","  then LO= 120                /*Not specified?  Then use the default.*/
if zz ='' | zz =","  then zz=2 3 9 15 29 37 47 57 67 77 87 97 237 409 659 /*use default?*/
sw= linesize() - 1;  if sw<1  then sw= 79        /*obtain the terminal's screen width.  */
digs = digits()                                  /*the current number of decimal digits.*/
#= 0                                             /*number of  (LO)  primes found so far.*/
!.= 1                                            /*placeholder for factorial memoization*/
$=                                               /*     "      to hold a list of primes.*/
    do p=1  until #=LO;         oDigs= digs      /*remember the number of decimal digits*/
    ?= isPrimeW(p)                               /*test primality using Wilson's theorem*/
    if digs>Odigs  then numeric digits digs      /*use larger number for decimal digits?*/
    if \?  then iterate                          /*if not prime, then ignore this number*/
    #= # + 1;                   $= $ p           /*bump prime counter; add prime to list*/
    end   /*p*/

call show 'The first '    LO    " prime numbers are:"
w= max( length(LO), length(word(reverse(zz),1))) /*used to align the number being tested*/
@is.0= "            isn't";     @is.1= 'is'      /*2 literals used for display: is/ain't*/
say
    do z=1  for words(zz);      oDigs= digs      /*remember the number of decimal digits*/
    p= word(zz, z)                               /*get a number from user─supplied list.*/
    ?= isPrimeW(p)                               /*test primality using Wilson's theorem*/
    if digs>Odigs  then numeric digits digs      /*use larger number for decimal digits?*/
    say right(p, max(w,length(p) ) )       @is.?      "prime."
    end   /*z*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPrimeW: procedure expose !. digs;  parse arg x '' -1 last;        != 1;       xm= x - 1
          if x<2                   then return 0 /*is the number too small to be prime? */
          if x==2 | x==5           then return 1 /*is the number a two or a five?       */
          if last//2==0 | last==5  then return 0 /*is the last decimal digit even or 5? */
          if !.xm\==1  then != !.xm              /*has the factorial been pre─computed? */
                       else do;  if xm>!.0  then do; base= !.0+1; _= !.0;  != !._; end
                                            else     base= 2        /* [↑] use shortcut.*/
                                      do j=!.0+1  to xm;  != ! * j  /*compute factorial.*/
                                      if pos(., !)\==0  then do;  parse var !  'E'  expon
                                                                  numeric digits expon +99
                                                                  digs = digits()
                                                             end    /* [↑] has exponent,*/
                                      end   /*j*/                   /*bump numeric digs.*/
                            if xm<999  then do; !.xm=!; !.0=xm; end /*assign factorial. */
                            end                                     /*only save small #s*/
          if (!+1)//x==0  then return 1                             /*X  is     a prime.*/
                               return 0                             /*"  isn't  "   "   */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: parse arg header,oo;     say header        /*display header for the first N primes*/
      w= length( word($, LO) )                   /*used to align prime numbers in $ list*/
        do k=1  for LO; _= right( word($, k), w) /*build list for displaying the primes.*/
        if length(oo _)>sw  then do;  say substr(oo,2);  oo=;  end  /*a line overflowed?*/
        oo= oo _                                                    /*display a line.   */
        end   /*k*/                                                 /*does pretty print.*/
      if oo\=''  then say substr(oo, 2);  return /*display residual (if any overflowed).*/


load "stdlib.ring"

decimals(0)
limit = 19

for n = 2 to limit
    fact = factorial(n-1) + 1
    see "Is " + n + " prime: "
    if fact % n = 0
       see "1" + nl
    else
       see "0" + nl
    ok
next


def w_prime?(i)
  return false if i < 2
  ((1..i-1).inject(&:*) + 1) % i == 0
end

p (1..100).select{|n| w_prime?(n) }


func is_wilson_prime_slow(n) {
    n > 1 || return false
    (n-1)! % n == n-1
}

func is_wilson_prime_fast(n) {
    n > 1 || return false
    factorialmod(n-1, n) == n-1
}

say 25.by(is_wilson_prime_slow)     #=> [2, 3, 5, ..., 83, 89, 97]
say 25.by(is_wilson_prime_fast)     #=> [2, 3, 5, ..., 83, 89, 97]

say is_wilson_prime_fast(2**43 - 1)   #=> false
say is_wilson_prime_fast(2**61 - 1)   #=> true


import BigInt

func factorial<T: BinaryInteger>(_ n: T) -> T {
  guard n != 0 else {
    return 1
  }

  return stride(from: n, to: 0, by: -1).reduce(1, *)
}

func isWilsonPrime<T: BinaryInteger>(_ n: T) -> Bool {
  guard n >= 2 else {
    return false
  }

  return (factorial(n - 1) + 1) % n == 0
}

print((1...100).map({ BigInt($0) }).filter(isWilsonPrime))


    PRINT "Number to test"
    INPUT N
    IF N < 0 THEN LET N = -N
    IF N = 2 THEN GOTO 30
    IF N < 2 THEN GOTO 40
    LET F = 1
    LET J = 1
10  LET J = J + 1
    REM exploits the fact that (F mod N)*J = (F*J mod N)
    REM to do the factorial without overflowing
    LET F = F * J
    GOSUB 20
    IF J  < N - 1 THEN GOTO 10
    IF F  = N - 1 THEN PRINT "It is prime"
    IF F <> N - 1 THEN PRINT "It is not prime"
    END
20  REM modulo by repeated subtraction
    IF F < N THEN RETURN
    LET F = F - N
    GOTO 20
30  REM special case N=2
    PRINT "It is prime"
    END
40  REM zero and one are nonprimes by definition
    PRINT "It is not prime"
    END


import "/math" for Int
import "/fmt" for Fmt

var wilson = Fn.new { |p|
    if (p < 2) return false
    return (Int.factorial(p-1) + 1) % p == 0
}

for (p in 1..19) {
    Fmt.print("$2d -> $s", p, wilson.call(p) ? "prime" : "not prime")
}


var [const] BI=Import("zklBigNum");  // libGMP
fcn isWilsonPrime(p){
   if(p<=1 or (p%2==0 and p!=2)) return(False);
   BI(p-1).factorial().add(1).mod(p) == 0
}
fcn wPrimesW{ [2..].tweak(fcn(n){ isWilsonPrime(n) and n or Void.Skip }) }


V items = [(3, ‘Clear drains’), (4, ‘Feed cat’), (5, ‘Make tea’), (1, ‘Solve RC tasks’), (2, ‘Tax return’)]
minheap:heapify(&items)
L !items.empty
   print(minheap:pop(&items))


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program priorQueue64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ  NBMAXIELEMENTS,    100

/*******************************************/
/* Structures                               */
/********************************************/
/* example structure  item  */
    .struct  0
item_priority:                     // priority
    .struct  item_priority + 8
item_address:                      // string address
    .struct  item_address + 8
item_fin:
/* example structure heap  */
    .struct  0
heap_size:                         // heap size
    .struct  heap_size + 8
heap_items:                        // structure of items
    .struct  heap_items + (item_fin * NBMAXIELEMENTS)
heap_fin:

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessEmpty:       .asciz "Empty queue. \n"
szMessNotEmpty:    .asciz "Not empty queue. \n"
szMessError:       .asciz "Error detected !!!!. \n"
szMessResult:      .asciz "Priority : @ : @ \n"          // message result

szString1:         .asciz "Clear drains"
szString2:         .asciz "Feed cat"
szString3:         .asciz "Make tea"
szString4:         .asciz "Solve RC tasks"
szString5:         .asciz "Tax return"
szCarriageReturn:  .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:             .skip 24
Queue1:                .skip heap_fin      // queue memory place
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                       // entry of program
    ldr x0,qAdrQueue1                       // queue structure address
    bl isEmpty
    cbz x0,1f
    ldr x0,qAdrszMessEmpty
    bl affichageMess                        // display message empty
    b 2f
1:
    ldr x0,qAdrszMessNotEmpty
    bl affichageMess                        // display message not empty
2:
    // init item 1
    ldr x0,qAdrQueue1                       // queue structure address
    mov x1,#3                               // priority
    ldr x2,qAdrszString1
    bl pushQueue                            // add item in queue
    cmp x0,#-1                              // error ?
    beq 99f

    ldr x0,qAdrQueue1                       // queue structure address
    bl isEmpty
    cbz x0,3f                               // not empty
    ldr x0,qAdrszMessEmpty
    bl affichageMess                        // display message empty
    b 4f
3:
    ldr x0,qAdrszMessNotEmpty
    bl affichageMess                        // display message not empty

4:
    // init item 2
    ldr x0,qAdrQueue1                       // queue structure address
    mov x1,#4                               // priority
    ldr x2,qAdrszString2
    bl pushQueue                            // add item in queue
    cmp x0,#-1                              // error ?
    beq 99f
    // init item 3
    ldr x0,qAdrQueue1                       // queue structure address
    mov x1,#5                               // priority
    ldr x2,qAdrszString3
    bl pushQueue                            // add item in queue
    cmp x0,#-1                              // error ?
    beq 99f
    // init item 4
    ldr x0,qAdrQueue1                       // queue structure address
    mov x1,#1                               // priority
    ldr x2,qAdrszString4
    bl pushQueue                            // add item in queue
    cmp x0,#-1                              // error ?
    beq 99f
    // init item 5
    ldr x0,qAdrQueue1                       // queue structure address
    mov x1,#2                               // priority
    ldr x2,qAdrszString5
    bl pushQueue                            // add item in queue
    cmp x0,#-1                              // error ?
    beq 99f
5:
    ldr x0,qAdrQueue1                       // queue structure address
    bl popQueue                             // return item
    cmp x0,#-1                              // end ?
    beq 100f
    mov x2,x1                               // save string address
    ldr x1,qAdrsZoneConv                    // conversion priority
    bl conversion10                         // decimal conversion
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc
    mov x1,x2                               // string address
    bl strInsertAtCharInc
    bl affichageMess                        // display message

    b 5b                                    // loop
99:                                         // error
    ldr x0,qAdrszMessError
    bl affichageMess
100:                                        // standard end of the program
    mov x0, #0                              // return code
    mov x8, #EXIT                           // request to exit program
    svc #0                                  // perform the system call

qAdrQueue1:               .quad Queue1
qAdrszString1:            .quad szString1
qAdrszString2:            .quad szString2
qAdrszString3:            .quad szString3
qAdrszString4:            .quad szString4
qAdrszString5:            .quad szString5
qAdrszMessError:          .quad szMessError
qAdrszMessEmpty:          .quad szMessEmpty
qAdrszMessNotEmpty:       .quad szMessNotEmpty
qAdrszMessResult:         .quad szMessResult
qAdrszCarriageReturn:     .quad szCarriageReturn
//qAdrsMessPriority:        .quad sMessPriority
qAdrsZoneConv:            .quad sZoneConv
/******************************************************************/
/*     test if queue empty                                        */
/******************************************************************/
/* x0 contains the address of queue structure */
isEmpty:
    stp x1,lr,[sp,-16]!       // save  registres
    ldr x1,[x0,#heap_size]    // heap size
    cmp x1,#0
    cset x0,eq
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
/******************************************************************/
/*     add item  in queue                                         */
/******************************************************************/
/* x0 contains the address of queue structure */
/* x1 contains the priority of item           */
/* x2 contains the string address             */
pushQueue:
    stp x1,lr,[sp,-16]!                     // save  registres
    stp x2,x3,[sp,-16]!                     // save  registres
    stp x4,x5,[sp,-16]!                     // save  registres
    stp x6,x7,[sp,-16]!                     // save  registres
    stp x8,x9,[sp,-16]!                     // save  registres
    ldr x3,[x0,#heap_size]                  // heap size
    cbnz x3,1f                              // heap empty ?
    add x4,x0,#heap_items                   // address of item structure
    str x1,[x4,#item_priority]              // store in first item
    str x2,[x4,#item_address]
    mov x3,#1                               // heap size
    str x3,[x0,#heap_size]                  // new heap size
    b 100f
1:
    mov x4,x3                               // maxi index
    lsr x5,x4,#1                            // current index = maxi / 2
    mov x8,x1                               // save priority
    mov x9,x2                               // save string address
2:                                          // insertion loop
    cmp x4,#0                               // end loop ?
    ble 3f
    mov x6,#item_fin                        // item size
    madd x6,x5,x6,x0                        // item shift
    add x6,x6,#heap_items                      // compute address item
    ldr x7,[x6,#item_priority]              // load priority
    cmp x7,x8                               // compare priority
    ble 3f                                  // <=  end loop
    mov x1,x4                               // last index
    mov x2,x5                               // current index
    bl exchange
    mov x4,x5                               // last index = current index
    lsr x5,x5,#1                               // current index / 2
    b 2b
3:                                          // store item at last index find
    mov x6,#item_fin                        // item size
    madd x6,x4,x6,x0                        // item shift
    add x6,x6,#heap_items                   // item address
    str x8,[x6,#item_priority]
    str x9,[x6,#item_address]
    add x3,x3,#1                               // increment heap size
    cmp x3,#NBMAXIELEMENTS                  // maxi ?
    bge 99f                                // yes -> error
    str x3,[x0,#heap_size]                  // store new size
    b 100f
99:
    mov x0,#-1                              // error
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     swap two elements of table                                  */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the second index */
exchange:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    add x5,x0,#heap_items        // address items begin
    mov x3,#item_fin             // item size
    madd x4,x1,x3,x5             // compute item 1 address
    madd x6,x2,x3,x5             // compute item 2 address
    ldr x5,[x4,#item_priority]   // exchange
    ldr x3,[x6,#item_priority]
    str x3,[x4,#item_priority]
    str x5,[x6,#item_priority]
    ldr x5,[x4,#item_address]
    ldr x3,[x6,#item_address]
    str x5,[x6,#item_address]
    str x3,[x4,#item_address]

100:
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     move one element of table                                  */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the origin index */
/* x2 contains the destination index */
moveItem:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    add x5,x0,#heap_items        // address items begin
    mov x3,#item_fin             // item size
    madd x4,x1,x3,x5             // compute item 1 address
    madd x6,x2,x3,x5             // compute item 2 address
    ldr x5,[x4,#item_priority]   // exchange
    str x5,[x6,#item_priority]
    ldr x5,[x4,#item_address]
    str x5,[x6,#item_address]

100:
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret

/******************************************************************/
/*     pop queue                                                  */
/******************************************************************/
/* x0 contains the address of queue structure */
/* x0 return priority        */
/* x1 return string address   */
popQueue:
    stp x10,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x1,x0                    // save address queue
    bl isEmpty                   // control if empty queue
    cmp x0,#1                    // yes -> error
    beq 99f

    mov x0,x1                   // restaur address queue
    add x4,x0,#heap_items       // address of item structure
    ldr x8,[x4,#item_priority]  // save priority first item
    ldr x9,[x4,#item_address]   // save address string first item
    ldr x3,[x0,#heap_size]      // heap size
    sub x7,x3,#1                // last item
    mov x1,x7
    mov x2,#0                   // first item
    bl moveItem                 // move last item in first item

    cmp x7,#1                   // one only item ?
    beq 10f                     // yes -> end
    mov x4,#0                   // first  index
1:
    cmp x4,x7                   // = last index
    bge 10f                     // yes -> end
    mov x5,x7                   // last index
    cmp x4,#0                   // init current index
    mov x6,#1                   // = 1
    lsl x1,x4,#1                // else = first index * 2
    csel x6,x6,x1,eq
    cmp x6,x7                   // current index > last index
    bgt 2f                      // yes
                                // no compar priority current item last item
    mov x1,#item_fin
    madd x1,x6,x1,x0
    add x1,x1,#heap_items       // address of current item structure
    ldr x1,[x1,#item_priority]
    mov x10,#item_fin
    madd x10,x5,x10,x0
    add x10,x10,#heap_items     // address of last item structure
    ldr x10,[x10,#item_priority]
    cmp x1,x10
    csel x5,x6,x5,lt
2:
    add x10,x6,#1               // increment current index
    cmp x10,x7                  // end ?
    bgt 3f                      // yes
    mov x1,#item_fin            // no compare priority
    madd x1,x10,x1,x0
    add x1,x1,#heap_items       // address of item structure
    ldr x1,[x1,#item_priority]
    mov x2,#item_fin
    madd x2,x5,x2,x0
    add x2,x2,#heap_items       // address of item structure
    ldr x2,[x2,#item_priority]
    cmp x1,x2
    csel x5,x10,x5,lt
3:
    mov x1,x5                   // move item
    mov x2,x4
    bl moveItem
    mov x4,x5
    b 1b                        // and loop
10:
    sub x3,x3,#1
    str x3,[x0,#heap_size]      // new heap size
    mov x0,x8                   // return priority
    mov x1,x9                   // return string address
    b 100f
99:
    mov x0,#-1                  // error
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x10,lr,[sp],16          // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Containers.Unbounded_Priority_Queues;
with Ada.Strings.Unbounded;

procedure Priority_Queues is
   use Ada.Containers;
   use Ada.Strings.Unbounded;
   type Queue_Element is record
      Priority : Natural;
      Content  : Unbounded_String;
   end record;
   function Get_Priority (Element : Queue_Element) return Natural is
   begin
      return Element.Priority;
   end Get_Priority;
   function Before (Left, Right : Natural) return Boolean is
   begin
      return Left > Right;
   end Before;
   package String_Queues is new Synchronized_Queue_Interfaces
     (Element_Type => Queue_Element);
   package String_Priority_Queues is new Unbounded_Priority_Queues
     (Queue_Interfaces => String_Queues,
      Queue_Priority => Natural);

   My_Queue : String_Priority_Queues.Queue;
begin
   My_Queue.Enqueue (New_Item => (Priority => 3, Content => To_Unbounded_String ("Clear drains")));
   My_Queue.Enqueue (New_Item => (Priority => 4, Content => To_Unbounded_String ("Feed cat")));
   My_Queue.Enqueue (New_Item => (Priority => 5, Content => To_Unbounded_String ("Make tea")));
   My_Queue.Enqueue (New_Item => (Priority => 1, Content => To_Unbounded_String ("Solve RC tasks")));
   My_Queue.Enqueue (New_Item => (Priority => 2, Content => To_Unbounded_String ("Tax return")));

   declare
      Element : Queue_Element;
   begin
      while My_Queue.Current_Use > 0 loop
         My_Queue.Dequeue (Element => Element);
         Ada.Text_IO.Put_Line (Natural'Image (Element.Priority) & " => " & To_String (Element.Content));
      end loop;
   end;
end Priority_Queues;


/* ARM assembly Raspberry PI  */
/*  program priorqueue.s   */

/* Constantes    */
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall

.equ  NBMAXIELEMENTS,    100

/*******************************************/
/* Structures                               */
/********************************************/
/* example structure  item  */
    .struct  0
item_priority:                     @ priority
    .struct  item_priority + 4
item_address:                      @ string address
    .struct  item_address + 4
item_fin:
/* example structure heap  */
    .struct  0
heap_size:                         @ heap size
    .struct  heap_size + 4
heap_items:                        @ structure of items
    .struct  heap_items + (item_fin * NBMAXIELEMENTS)
heap_fin:

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessEmpty:       .asciz "Empty queue. \n"
szMessNotEmpty:    .asciz "Not empty queue. \n"
szMessError:       .asciz "Error detected !!!!. \n"
szMessResult:      .ascii "Priority : "                    @ message result
sMessPriority:        .fill 11, 1, ' '
                   .asciz " : "

szString1:         .asciz "Clear drains"
szString2:         .asciz "Feed cat"
szString3:         .asciz "Make tea"
szString4:         .asciz "Solve RC tasks"
szString5:         .asciz "Tax return"
szCarriageReturn:  .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
Queue1:                .skip heap_fin      @ queue memory place
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                       @ entry of program
    ldr r0,iAdrQueue1                       @ queue structure address
    bl isEmpty
    cmp r0,#0
    beq 1f
    ldr r0,iAdrszMessEmpty
    bl affichageMess                        @ display message empty
    b 2f
1:
    ldr r0,iAdrszMessNotEmpty
    bl affichageMess                        @ display message not empty
2:
    @ init item 1
    ldr r0,iAdrQueue1                       @ queue structure address
    mov r1,#3                               @ priority
    ldr r2,iAdrszString1
    bl pushQueue                            @ add item in queue
    cmp r0,#-1                              @ error ?
    beq 99f

    ldr r0,iAdrQueue1                       @ queue structure address
    bl isEmpty
    cmp r0,#0                               @ not empty
    beq 3f
    ldr r0,iAdrszMessEmpty
    bl affichageMess                        @ display message empty
    b 4f
3:
    ldr r0,iAdrszMessNotEmpty
    bl affichageMess                        @ display message not empty

4:
    @ init item 2
    ldr r0,iAdrQueue1                       @ queue structure address
    mov r1,#4                               @ priority
    ldr r2,iAdrszString2
    bl pushQueue                            @ add item in queue
    cmp r0,#-1                              @ error ?
    beq 99f
    @ init item 3
    ldr r0,iAdrQueue1                       @ queue structure address
    mov r1,#5                               @ priority
    ldr r2,iAdrszString3
    bl pushQueue                            @ add item in queue
    cmp r0,#-1                              @ error ?
    beq 99f
    @ init item 4
    ldr r0,iAdrQueue1                       @ queue structure address
    mov r1,#1                               @ priority
    ldr r2,iAdrszString4
    bl pushQueue                            @ add item in queue
    cmp r0,#-1                              @ error ?
    beq 99f
    @ init item 5
    ldr r0,iAdrQueue1                       @ queue structure address
    mov r1,#2                               @ priority
    ldr r2,iAdrszString5
    bl pushQueue                            @ add item in queue
    cmp r0,#-1                              @ error ?
    beq 99f
5:
    ldr r0,iAdrQueue1                       @ queue structure address
    bl popQueue                             @ return item
    cmp r0,#-1                              @ end ?
    beq 100f
    mov r2,r1                               @ save string address
    ldr r1,iAdrsMessPriority                @ conversion priority
    bl conversion10                         @ decimal conversion
    ldr r0,iAdrszMessResult
    bl affichageMess                        @ display message
    mov r0,r2                               @ string address
    bl affichageMess                        @ display message
    ldr r0,iAdrszCarriageReturn
    bl affichageMess

    b 5b                                    @ loop
99:
    @ error
    ldr r0,iAdrszMessError
    bl affichageMess
100:                                        @ standard end of the program
    mov r0, #0                              @ return code
    mov r7, #EXIT                           @ request to exit program
    svc #0                                  @ perform the system call

iAdrQueue1:               .int Queue1
iAdrszString1:            .int szString1
iAdrszString2:            .int szString2
iAdrszString3:            .int szString3
iAdrszString4:            .int szString4
iAdrszString5:            .int szString5
iAdrszMessError:          .int szMessError
iAdrszMessEmpty:          .int szMessEmpty
iAdrszMessNotEmpty:       .int szMessNotEmpty
iAdrszMessResult:         .int szMessResult
iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessPriority:        .int sMessPriority

/******************************************************************/
/*     test if queue empty                                        */
/******************************************************************/
/* r0 contains the address of queue structure */
isEmpty:
    push {r1,lr}                            @ save  registres
    ldr r1,[r0,#heap_size]                  @ heap size
    cmp r1,#0
    moveq r0,#1                             @ empty queue
    movne r0,#0                             @ not empty
    pop {r1,lr}                             @ restaur registers
    bx lr                                   @ return
/******************************************************************/
/*     add item  in queue                                         */
/******************************************************************/
/* r0 contains the address of queue structure */
/* r1 contains the priority of item           */
/* r2 contains the string address             */
pushQueue:
    push {r1-r9,lr}                         @ save  registres
    ldr r3,[r0,#heap_size]                  @ heap size
    cmp r3,#0                               @ heap empty ?
    bne 1f
    add r4,r0,#heap_items                   @ address of item structure
    str r1,[r4,#item_priority]              @ store in first item
    str r2,[r4,#item_address]
    mov r3,#1                               @ heap size
    str r3,[r0,#heap_size]                  @ new heap size
    b 100f
1:
    mov r4,r3                               @ maxi index
    lsr r5,r4,#1                            @ current index = maxi / 2
    mov r8,r1                               @ save priority
    mov r9,r2                               @ save string address
2:                                          @ insertion loop
    cmp r4,#0                               @ end loop ?
    ble 3f
    mov r6,#item_fin                        @ item size
    mul r6,r5,r6                            @ item shift
    add r6,r0
    add r6,#heap_items                      @ compute address item
    ldr r7,[r6,#item_priority]              @ load priority
    cmp r7,r8                               @ compare priority
    ble 3f                                  @ <=  end loop
    mov r1,r4                               @ last index
    mov r2,r5                               @ current index
    bl exchange
    mov r4,r5                               @ last index = current index
    lsr r5,#1                               @ current index / 2
    b 2b
3:                                          @ store item at last index find
    mov r6,#item_fin                        @ item size
    mul r6,r4,r6                            @ item shift
    add r6,r0
    add r6,#heap_items                      @ item address
    str r8,[r6,#item_priority]
    str r9,[r6,#item_address]
    add r3,#1                               @ increment heap size
    cmp r3,#NBMAXIELEMENTS                  @ maxi ?
    movge r0,#-1                            @ yes -> error
    bge 100f
    str r3,[r0,#heap_size]                  @ store new size
100:
    pop {r1-r9,lr}                          @ restaur registers
    bx lr                                   @ return
/******************************************************************/
/*     swap two elements of table                                  */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the second index */
exchange:
    push {r3-r6,lr}                         @ save registers
    add r5,r0,#heap_items                   @ address items begin
    mov r3,#item_fin                        @ item size
    mul r4,r1,r3                            @ compute item 1 shift
    add r4,r5                               @ compute item 1 address
    mul r6,r2,r3                            @ compute item 2 shift
    add r6,r5                               @ compute item 2 address
    ldr r5,[r4,#item_priority]              @ exchange
    ldr r3,[r6,#item_priority]
    str r3,[r4,#item_priority]
    str r5,[r6,#item_priority]
    ldr r5,[r4,#item_address]
    ldr r3,[r6,#item_address]
    str r5,[r6,#item_address]
    str r3,[r4,#item_address]

100:
    pop {r3-r6,lr}
    bx lr                                              @ return
/******************************************************************/
/*     move one element of table                                  */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the origin index */
/* r2 contains the destination index */
moveItem:
    push {r3-r6,lr}                         @ save registers
    add r5,r0,#heap_items                   @ address items begin
    mov r3,#item_fin                        @ item size
    mul r4,r1,r3                            @ compute item 1 shift
    add r4,r5                               @ compute item 1 address
    mul r6,r2,r3                            @ compute item 2 shift
    add r6,r5                               @ compute item 2 address
    ldr r5,[r4,#item_priority]              @ exchange
    str r5,[r6,#item_priority]
    ldr r5,[r4,#item_address]
    str r5,[r6,#item_address]

100:
    pop {r3-r6,lr}
    bx lr                                   @ return

/******************************************************************/
/*     pop queue                                                  */
/******************************************************************/
/* r0 contains the address of queue structure */
/* r0 return priority        */
/* r1 return string address   */
popQueue:
    push {r2-r10,lr}                        @ save  registres
    mov r1,r0                               @ save address queue
    bl isEmpty                              @ control if empty queue
    cmp r0,#1                               @ yes -> error
    moveq r0,#-1
    beq 100f
    @ save données à retourner
    mov r0,r1                               @ restaur address queue
    add r4,r0,#heap_items                   @ address of item structure
    ldr r8,[r4,#item_priority]              @ save priority first item
    ldr r9,[r4,#item_address]               @ save address string first item
    ldr r3,[r0,#heap_size]                  @ heap size
    sub r7,r3,#1                            @ last item
    mov r1,r7
    mov r2,#0                               @ first item
    bl moveItem                             @ move last item in first item

    cmp r7,#1                               @ one only item ?
    beq 10f                                 @ yes -> end
    mov r4,#0                               @ first  index
1:
    cmp r4,r7                               @ = last index
    bge 10f                                 @ yes -> end
    mov r5,r7                               @ last index
    cmp r4,#0                               @ init current index
    moveq r6,#1                             @ = 1
    lslne r6,r4,#1                          @ else = first index * 2
    cmp r6,r7                               @ current index > last index
    bgt 2f                                  @ yes
                                            @ no compar priority current item last item
    mov r1,#item_fin
    mul r1,r6,r1
    add r1,r0
    add r1,#heap_items                      @ address of current item structure
    ldr r1,[r1,#item_priority]
    mov r10,#item_fin
    mul r10,r5,r10
    add r10,r0
    add r10,#heap_items                     @ address of last item structure
    ldr r10,[r10,#item_priority]
    cmp r1,r10
    movlt r5,r6
2:
    add r10,r6,#1                           @ increment current index
    cmp r10,r7                              @ end ?
    bgt 3f                                  @ yes
    mov r1,#item_fin                        @ no compare priority
    mul r1,r10,r1
    add r1,r0
    add r1,#heap_items                     @ address of item structure
    ldr r1,[r1,#item_priority]
    mov r2,#item_fin
    mul r2,r5,r2
    add r2,r0
    add r2,#heap_items                     @ address of item structure
    ldr r2,[r2,#item_priority]
    cmp r1,r2
    movlt r5,r10
3:
    mov r1,r5                              @ move item
    mov r2,r4
    bl moveItem
    mov r4,r5
    b 1b                                   @ and loop
10:
    sub r3,#1
    str r3,[r0,#heap_size]                 @ new heap size
    mov r0,r8                              @ return priority
    mov r1,r9                              @ return string address
100:
    pop {r2-r10,lr}                        @ restaur registers
    bx lr                                  @ return
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                   @ save  registres
    mov r2,#0                               @ counter length
1:                                          @ loop length calculation
    ldrb r1,[r0,r2]                         @ read octet start position + index
    cmp r1,#0                               @ if 0 its over
    addne r2,r2,#1                          @ else add 1 in the length
    bne 1b                                  @ and loop
                                            @ so here r2 contains the length of the message
    mov r1,r0                               @ address message in r1
    mov r0,#STDOUT                          @ code to write to the standard output Linux
    mov r7, #WRITE                          @ code call system "write"
    svc #0                                  @ call systeme
    pop {r0,r1,r2,r7,lr}                    @ restaur registers */
    bx lr                                   @ return
/******************************************************************/
/*     Converting a register to a decimal                                 */
/******************************************************************/
/* r0 contains value and r1 address area   */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                         @ save registers
    mov r3,r1
    mov r2,#LGZONECAL
1:                                          @ start loop
    bl divisionpar10                        @ r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                              @ digit
    strb r1,[r3,r2]                         @ store digit on area
    cmp r0,#0                               @ stop if quotient = 0
    subne r2,#1                               @ previous position
    bne 1b                                  @ else loop
                                            @ end replaces digit in front of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]                         @ store in area begin
    add r4,#1
    add r2,#1                               @ previous position
    cmp r2,#LGZONECAL                       @ end
    ble 2b                                  @ loop
    mov r1,#' '
3:
    strb r1,[r3,r4]
    add r4,#1
    cmp r4,#LGZONECAL                       @ end
    ble 3b
100:
    pop {r1-r4,lr}                          @ restaur registres
    bx lr                                   @return
/***************************************************/
/*   division par 10   signé                       */
/* Thanks to http://thinkingeek.com/arm-assembler-raspberry-pi/*
/* and   http://www.hackersdelight.org/            */
/***************************************************/
/* r0 dividende   */
/* r0 quotient */
/* r1 remainder  */
divisionpar10:
  /* r0 contains the argument to be divided by 10 */
    push {r2-r4}                           @ save registers  */
    mov r4,r0
    mov r3,#0x6667                         @ r3 <- magic_number  lower
    movt r3,#0x6666                        @ r3 <- magic_number  upper
    smull r1, r2, r3, r0                   @ r1 <- Lower32Bits(r1*r0). r2 <- Upper32Bits(r1*r0)
    mov r2, r2, ASR #2                     @ r2 <- r2 >> 2
    mov r1, r0, LSR #31                    @ r1 <- r0 >> 31
    add r0, r2, r1                         @ r0 <- r2 + r1
    add r2,r0,r0, lsl #2                   @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                   @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2-r4}
    bx lr                                  @ return


;-----------------------------------
PQ_TopItem(Queue,Task:=""){					; remove and return top priority item
	TopPriority := PQ_TopPriority(Queue)
	for T, P in Queue
		if (P = TopPriority) && ((T=Task)||!Task)
			return T , Queue.Remove(T)
	return 0
}
;-----------------------------------
PQ_AddTask(Queue,Task,Priority){				; insert and return new task
	for T, P in Queue
		if (T=Task) || !(Priority && Task)
			return 0
	return Task,	Queue[Task] := Priority
}
;-----------------------------------
PQ_DelTask(Queue, Task){					; delete and return task
	for T, P in Queue
		if (T = Task)
			return Task,	Queue.Remove(Task)
}
;-----------------------------------
PQ_Peek(Queue){							; peek and return top priority task(s)
	TopPriority := PQ_TopPriority(Queue)
	for T, P in Queue
		if (P = TopPriority)
			PeekList .= (PeekList?"`n":"") "`t" T
	return PeekList
}
;-----------------------------------
PQ_Check(Queue,Task){						; check task and return its priority
	for T, P in Queue
		if (T = Task)
			return P
	return 0
}
;-----------------------------------
PQ_Edit(Queue,Task,Priority){					; Update task priority and return its new priority
	for T, P in Queue
		if (T = Task)
			return Priority,	Queue[T]:=Priority
	return 0
}
;-----------------------------------
PQ_View(Queue){							; view current Queue
	for T, P in Queue
		Res .= P " : " T "`n"
	Sort, Res, FMySort
	return "Priority Queue=`n" Res
}
MySort(a,b){
	RegExMatch(a,"(\d+) : (.*)", x), RegExMatch(b,"(\d+) : (.*)", y)
	return x1>y1?1:x1<y1?-1: x2>y2?1:x2<y2?-1: 0
}
;-----------------------------------
PQ_TopPriority(Queue){						; return queue's top priority
	for T, P in Queue
		TopPriority := TopPriority?TopPriority:P	, TopPriority := TopPriority<P?TopPriority:P
	return, TopPriority
}


)abbrev Domain ORDKE OrderedKeyEntry
OrderedKeyEntry(Key:OrderedSet,Entry:SetCategory): Exports == Implementation where
  Exports == OrderedSet with
    construct: (Key,Entry) -> %
    elt: (%,"key") -> Key
    elt: (%,"entry") -> Entry
  Implementation == add
    Rep := Record(k:Key,e:Entry)
    x,y: %
    construct(a,b) == construct(a,b)$Rep @ %
    elt(x,"key"):Key == ([email protected]).k
    elt(x,"entry"):Entry == ([email protected]).e
    x < y == x.key < y.key
    x = y == x.key = y.key
    hash x == hash(x.key)
    if Entry has CoercibleTo OutputForm then
      coerce(x):OutputForm == bracket [(x.key)::OutputForm,(x.entry)::OutputForm]
)abbrev Domain PRIORITY PriorityQueue
S ==> OrderedKeyEntry(Key,Entry)
PriorityQueue(Key:OrderedSet,Entry:SetCategory): Exports == Implementation where
  Exports == PriorityQueueAggregate S with
    heap : List S  -> %
    setelt: (%,Key,Entry) -> Entry
  Implementation == Heap(S) add
    setelt(x:%,key:Key,entry:Entry) ==
      insert!(construct(key,entry)$S,x)
      entry


@echo off
setlocal enabledelayedexpansion

call :push 10  "item ten"
call :push 2   "item two"
call :push 100 "item one hundred"
call :push 5   "item five"

call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!
call :pop & echo !order! !item!

goto:eof

:push
set temp=000%1
set queu%temp:~-3%=%2
goto:eof

:pop
set queu >nul 2>nul
if %errorlevel% equ 1 (set order=-1&set item=no more items & goto:eof)
for /f "tokens=1,2 delims==" %%a in ('set queu') do set %%a=& set order=%%a& set item=%%~b& goto:next
:next
set order= %order:~-3%
goto:eof


#include <stdio.h>
#include <stdlib.h>

typedef struct {
    int priority;
    char *data;
} node_t;

typedef struct {
    node_t *nodes;
    int len;
    int size;
} heap_t;

void push (heap_t *h, int priority, char *data) {
    if (h->len + 1 >= h->size) {
        h->size = h->size ? h->size * 2 : 4;
        h->nodes = (node_t *)realloc(h->nodes, h->size * sizeof (node_t));
    }
    int i = h->len + 1;
    int j = i / 2;
    while (i > 1 && h->nodes[j].priority > priority) {
        h->nodes[i] = h->nodes[j];
        i = j;
        j = j / 2;
    }
    h->nodes[i].priority = priority;
    h->nodes[i].data = data;
    h->len++;
}

char *pop (heap_t *h) {
    int i, j, k;
    if (!h->len) {
        return NULL;
    }
    char *data = h->nodes[1].data;

    h->nodes[1] = h->nodes[h->len];

    h->len--;

    i = 1;
    while (i!=h->len+1) {
        k = h->len+1;
        j = 2 * i;
        if (j <= h->len && h->nodes[j].priority < h->nodes[k].priority) {
            k = j;
        }
        if (j + 1 <= h->len && h->nodes[j + 1].priority < h->nodes[k].priority) {
            k = j + 1;
        }
        h->nodes[i] = h->nodes[k];
        i = k;
    }
    return data;
}

int main () {
    heap_t *h = (heap_t *)calloc(1, sizeof (heap_t));
    push(h, 3, "Clear drains");
    push(h, 4, "Feed cat");
    push(h, 5, "Make tea");
    push(h, 1, "Solve RC tasks");
    push(h, 2, "Tax return");
    int i;
    for (i = 0; i < 5; i++) {
        printf("%s\n", pop(h));
    }
    return 0;
}


using System;
using System.Collections.Generic;

namespace PriorityQueueExample
{
	class Program
	{
		static void Main(string[] args)
		{
			// Starting with .NET 6.0 preview 2 (released March 11th, 2021), there's a built-in priority queue
			var p = new PriorityQueue<string, int>();
			p.Enqueue("Clear drains", 3);
			p.Enqueue("Feed cat", 4);
			p.Enqueue("Make tea", 5);
			p.Enqueue("Solve RC tasks", 1);
			p.Enqueue("Tax return", 2);
			while (p.TryDequeue(out string task, out int priority))
			{
				Console.WriteLine($"{priority}\t{task}");
			}
		}
	}
}

/* Output:

1       Solve RC tasks
2       Tax return
3       Clear drains
4       Feed cat
5       Make tea

 */


#include <iostream>
#include <string>
#include <queue>
#include <utility>

int main() {
  std::priority_queue<std::pair<int, std::string> > pq;
  pq.push(std::make_pair(3, "Clear drains"));
  pq.push(std::make_pair(4, "Feed cat"));
  pq.push(std::make_pair(5, "Make tea"));
  pq.push(std::make_pair(1, "Solve RC tasks"));
  pq.push(std::make_pair(2, "Tax return"));

  while (!pq.empty()) {
    std::cout << pq.top().first << ", " << pq.top().second << std::endl;
    pq.pop();
  }

  return 0;
}


user=> (use 'clojure.data.priority-map)

; priority-map can be used as a priority queue
user=> (def p (priority-map "Clear drains" 3, "Feed cat" 4, "Make tea" 5, "Solve RC tasks" 1))
#'user/p
user=> p
{"Solve RC tasks" 1, "Clear drains" 3, "Feed cat" 4, "Make tea" 5}

; You can use assoc or conj to add items
user=> (assoc p "Tax return" 2)
{"Solve RC tasks" 1, "Tax return" 2, "Clear drains" 3, "Feed cat" 4, "Make tea" 5}

; peek to get first item, pop to give you back the priority-map with the first item removed
user=> (peek p)
["Solve RC tasks" 1]

; Merge priority-maps together
user=> (into p [["Wax Car" 4]["Paint Fence" 1]["Sand Floor" 3]])
{"Solve RC tasks" 1, "Paint Fence" 1, "Clear drains" 3, "Sand Floor" 3, "Wax Car" 4, "Feed cat" 4, "Make tea" 5}


prio_queue = cluster [P, T: type] is new, empty, push, pop
             where P has lt: proctype (P,P) returns (bool)

    item = struct[prio: P, val: T]
    rep = array[item]

    new = proc () returns (cvt)
        return (rep$create(0))
    end new

    empty = proc (pq: cvt) returns (bool)
        return (rep$empty(pq))
    end empty

    parent = proc (k: int) returns (int)
        return ((k-1)/2)
    end parent

    left = proc (k: int) returns (int)
        return (2*k + 1)
    end left

    right = proc (k: int) returns (int)
        return (2*k + 2)
    end right

    swap = proc (pq: rep, a: int, b: int)
        temp: item := pq[a]
        pq[a] := pq[b]
        pq[b] := temp
    end swap

    min_heapify = proc (pq: rep, k: int)
        l: int := left(k)
        r: int := right(k)

        smallest: int := k
        if l < rep$size(pq) cand pq[l].prio < pq[smallest].prio then
            smallest := l
        end
        if r < rep$size(pq) cand pq[r].prio < pq[smallest].prio then
            smallest := r
        end
        if smallest ~= k then
            swap(pq, k, smallest)
            min_heapify(pq, smallest)
        end
    end min_heapify

    push = proc (pq: cvt, prio: P, val: T)
        rep$addh(pq, item${prio: prio, val: val})

        i: int := rep$high(pq)
        while i ~= 0 cand pq[i].prio < pq[parent(i)].prio do
            swap(pq, i, parent(i))
            i := parent(i)
        end
    end push

    pop = proc (pq: cvt) returns (P, T) signals (empty)
        if empty(up(pq)) then signal empty end
        if rep$size(pq) = 1 then
            i: item := rep$remh(pq)
            return (i.prio, i.val)
        end

        root: item := pq[0]
        pq[0] := rep$remh(pq)
        min_heapify(pq, 0)
        return (root.prio, root.val)
    end pop
end prio_queue

start_up = proc ()
    % use ints for priority and strings for data
    prioq = prio_queue[int,string]

    % make the priority queue
    pq: prioq := prioq$new()

    % add some tasks
    prioq$push(pq, 3, "Clear drains")
    prioq$push(pq, 4, "Feed cat")
    prioq$push(pq, 5, "Make tea")
    prioq$push(pq, 1, "Solve RC tasks")
    prioq$push(pq, 2, "Tax return")

    % print them all out in order
    po: stream := stream$primary_output()
    while ~prioq$empty(pq) do
        prio: int task: string
        prio, task := prioq$pop(pq)
        stream$putl(po, int$unparse(prio) || ": " || task)
    end
end start_up


PriorityQueue = ->
  # Use closure style for object creation (so no "new" required).
  # Private variables are toward top.
  h = []

  better = (a, b) ->
    h[a].priority < h[b].priority

  swap = (a, b) ->
    [h[a], h[b]] = [h[b], h[a]]

  sift_down = ->
    max = h.length
    n = 0
    while n < max
      c1 = 2*n + 1
      c2 = c1 + 1
      best = n
      best = c1 if c1 < max and better(c1, best)
      best = c2 if c2 < max and better(c2, best)
      return if best == n
      swap n, best
      n = best

  sift_up = ->
    n = h.length - 1
    while n > 0
      parent = Math.floor((n-1) / 2)
      return if better parent, n
      swap n, parent
      n = parent

  # now return the public interface, which is an object that only
  # has functions on it
  self =
    size: ->
      h.length

    push: (priority, value) ->
      elem =
        priority: priority
        value: value
      h.push elem
      sift_up()

    pop: ->
      throw Error("cannot pop from empty queue") if h.length == 0
      value = h[0].value
      last = h.pop()
      if h.length > 0
        h[0] = last
        sift_down()
      value

# test
do ->
  pq = PriorityQueue()
  pq.push 3, "Clear drains"
  pq.push 4, "Feed cat"
  pq.push 5, "Make tea"
  pq.push 1, "Solve RC tasks"
  pq.push 2, "Tax return"

  while pq.size() > 0
    console.log pq.pop()

  # test high performance
  for n in [1..100000]
    priority = Math.random()
    pq.push priority, priority

  v = pq.pop()
  console.log "First random element was #{v}"
  while pq.size() > 0
    new_v = pq.pop()
    throw Error "Queue broken" if new_v < v
    v = new_v
  console.log "Final random element was #{v}"