Algorithms |
|
Mathematics |
|
Determine wether a given integer number is prime
const func boolean: isPrime (in integer: number) is func result var boolean: prime is FALSE; local var integer: upTo is 0; var integer: testNum is 3; begin if number = 2 then prime := TRUE; elsif odd(number) and number > 2 then upTo := sqrt(number); while number rem testNum <> 0 and testNum <= upTo do testNum +:= 2; end while; prime := testNum > upTo; end if; end func;
Sieve of Eratosthenes
The program below computes the number of primes between 1 and 10000000:
$ include "seed7_05.s7i"; const func set of integer: eratosthenes (in integer: n) is func result var set of integer: sieve is EMPTY_SET; local var integer: i is 0; var integer: j is 0; begin sieve := {2 .. n}; for i range 2 to sqrt(n) do if i in sieve then for j range i ** 2 to n step i do excl(sieve, j); end for; end if; end for; end func; const proc: main is func begin writeln(card(eratosthenes(10000000))); end func;
Verify Goldbach's conjecture up to 10000000
Goldbach's conjecture states that all even integers greater than 2 can be expressed as the sum of two primes. Goldbach's conjecture is one of the oldest unsolved problems. The program below checks all even numbers between 4 and 10000000:
$ include "seed7_05.s7i"; const func set of integer: eratosthenes (in integer: n) is func result var set of integer: sieve is EMPTY_SET; local var integer: i is 0; var integer: j is 0; begin sieve := {2 .. n}; for i range 2 to sqrt(n) do if i in sieve then for j range i ** 2 to n step i do excl(sieve, j); end for; end if; end for; end func; const integer: limit is 10000000; const func boolean: isGoldbachNumber (in integer: number) is func result var boolean: isGoldbachNumber is FALSE; local const set of integer: primes is eratosthenes(limit); var integer: testNum is 0; begin for testNum range primes until isGoldbachNumber do isGoldbachNumber := (number - testNum) in primes; end for; end func; const proc: main is func local var integer: number is 0; begin for number range 4 to limit step 2 do if not isGoldbachNumber(number) then writeln(number <& " is not a Goldbach number"); end if; if number rem 16384 = 0 then write("."); flush(OUT); end if; end for; writeln; end func;
Function to calculate the prime factors of a number
const func array integer: factorise (in var integer: number) is func result var array integer: factors is 0 times 0; local var integer: checker is 2; begin while checker * checker <= number do if number rem checker = 0 then factors &:= [](checker); number := number div checker; else incr(checker); end if; end while; if number <> 1 then factors &:= [](number); end if; end func;
Verify if a given Mersenne number is prime
A Mersenne number is a number that is one less than a power of two (2**p-1). The Lucas-Lehmer test allows to check if a given Mersenne number is prime: For the odd prime p, the Mersenne number 2**p-1 is prime if and only if S(p-1) rem 2**p-1 = 0 where S(1)=4 and S(n)=S(n-1)**2-2.
const func boolean: lucasLehmerTest (in integer: p) is func result var boolean: prime is TRUE; local var bigInteger: m_p is 0_; var bigInteger: s is 4_; var integer: i is 0; begin if p <> 2 then m_p := 2_ ** p - 1_; for i range 2 to pred(p) do s := (s ** 2 - 2_) rem m_p; end for; prime := s = 0_; end if; end func;
Miller-Rabin primality test
The Miller-Rabin primality test is a probabilistic algorithm, which determines whether a given number is prime or not. The number of tests is specified with the parameter k.
const func boolean: millerRabin (in bigInteger: n, in integer: k) is func result var boolean: probablyPrime is TRUE; local var bigInteger: d is 0_; var integer: r is 0; var integer: s is 0; var bigInteger: a is 0_; var bigInteger: x is 0_; var integer: tests is 0; begin if n < 2_ or (n > 2_ and not odd(n)) then probablyPrime := FALSE; elsif n > 3_ then d := pred(n); s := lowestSetBit(d); d >>:= s; while tests < k and probablyPrime do a := rand(2_, pred(n)); x := modPow(a, d, n); if x <> 1_ and x <> pred(n) then r := 1; while r < s and x <> 1_ and x <> pred(n) do x := modPow(x, 2_, n); incr(r); end while; probablyPrime := x = pred(n); end if; incr(tests); end while; end if; end func;
Determine the greatest common divisor of two positive integer numbers
const func integer: gcd (in var integer: a, in var integer: b) is func result var integer: gcd is 0; local var integer: help is 0; begin while a <> 0 do help := b rem a; b := a; a := help; end while; gcd := b; end func;
Determine the least common multiple of two positive integer numbers
const func integer: lcm (in integer: a, in integer: b) is return a div gcd(a, b) * b;
Binary greatest common divisor algorithm for two positive integer numbers
const func integer: binaryGcd (in var integer: a, in var integer: b) is func result var integer: gcd is 0; local var integer: shift is 0; var integer: diff is 0; begin if a = 0 then gcd := b; elsif b = 0 then gcd := a; else (* Let shift := log2(K), where K is the greatest power of 2 dividing both a and b. *) while not odd(a) and not odd(b) do a >>:= 1; b >>:= 1; incr(shift); end while; while not odd(a) do a >>:= 1; end while; (* From here on, a is always odd. *) repeat while not odd(b) do b >>:= 1; end while; (* Now a and b are both odd, so diff(a, b) is even. Let a := min(a, b); b := diff(a, b)/2; *) if a < b then b -:= a; else diff := a - b; a := b; b := diff; end if; b >>:= 1; until b = 0; gcd := a << shift; end if; end func;
Binary greatest common divisor algorithm for two bigInteger numbers
The library "bigint.s7i" defines the bigInteger function gcd. The function 'binaryGcd' below uses the binary greatest common divisor algorithm:
const func bigInteger: binaryGcd (in var bigInteger: a, in var bigInteger: b) is func result var bigInteger: gcd is 0_; local var integer: lowestSetBitA is 0; var integer: shift is 0; var bigInteger: diff is 0_; begin if a = 0_ then gcd := b; elsif b = 0_ then gcd := a; else if a < 0_ then a := -a; end if; if b < 0_ then b := -b; end if; lowestSetBitA := lowestSetBit(a); shift := lowestSetBit(b); if lowestSetBitA < shift then shift := lowestSetBitA; end if; a >>:= lowestSetBitA; repeat b >>:= lowestSetBit(b); if a < b then b -:= a; else diff := a - b; a := b; b := diff; end if; until b = 0_; gcd := a << shift; end if; end func;
Return the modular multiplicative inverse of a modulo b
The library "bigint.s7i" defines the bigInteger function modInverse. It returns the modular multiplicative inverse of a modulo b if a and b are coprime (gcd(a, b) = 1). If a and b are not coprime (gcd(a, b) <> 1) the exception RANGE_ERROR is raised.
const func bigInteger: modInverse (in var bigInteger: a, in var bigInteger: b) is func result var bigInteger: inverse is 0_; local var bigInteger: b_bak is 0_; var bigInteger: x is 0_; var bigInteger: y is 1_; var bigInteger: lastx is 1_; var bigInteger: lasty is 0_; var bigInteger: temp is 0_; var bigInteger: quotient is 0_; begin if b < 0_ then raise RANGE_ERROR; end if; if a < 0_ and b <> 0_ then a := a mod b; end if; b_bak := b; while b <> 0_ do temp := b; quotient := a div b; b := a rem b; a := temp; temp := x; x := lastx - quotient * x; lastx := temp; temp := y; y := lasty - quotient * y; lasty := temp; end while; if a = 1_ then inverse := lastx; if inverse < 0_ then inverse +:= b_bak; end if; else raise RANGE_ERROR; end if; end func;
Modular exponentiation with the binary method
The function modPow is part of the "bigint.s7i" library.
const func bigInteger: modPow (in var bigInteger: base, in var bigInteger: exponent, in bigInteger: modulus) is func result var bigInteger: power is 1_; begin if exponent < 0_ or modulus < 0_ then raise RANGE_ERROR; else while exponent > 0_ do if odd(exponent) then power := (power * base) mod modulus; end if; exponent >>:= 1; base := base ** 2 mod modulus; end while; end if; end func;
Compute PI with 1000 decimal digits using John Machin's formula
The function 'compute_pi_machin' approximates PI as bigRational number. To compute PI with more digits the upper bound of the for-loop needs to be adjusted, together with the right operand of the digits operator. E.g.: For 2000 digits the upper bound of the for-loop must be 1429 instead of 713.
$ include "seed7_05.s7i"; include "bigint.s7i"; include "bigrat.s7i"; # John Machin's formula from 1706: # PI = 16 * arctan(1 / 5) - 4 * arctan(1 / 239) # Taylor series for arctan: # arctan(x) = sum_n_from_0_to_inf((-1) ** n / succ(2 * n) * x ** succ(2 * n)) # Taylor series of John Machin's formula: # PI = sum_n_from_0_to_inf(16 * (-1) ** n / (succ(2 * n) * 5 ** succ(2 * n)) - # 4 * (-1) ** n / (succ(2 * n) * 239 ** succ(2 * n))) const func bigRational: compute_pi_machin is func result var bigRational: sum is 0_ / 1_; local var integer: n is 0; begin for n range 0 to 713 do sum +:= 16_ * (-1_) ** n / (bigInteger conv succ(2 * n) * 5_ ** succ(2 * n)) - 4_ * (-1_) ** n / (bigInteger conv succ(2 * n) * 239_ ** succ(2 * n)); end for; end func; const proc: main is func begin writeln(compute_pi_machin digits 1000); end func;
Compute PI with 1000 decimal digits using the Bailey/Borwein/Plouffe formula
The function 'compute_pi_bailey_borwein_plouffe' approximates PI as bigRational number. To compute PI with more digits the upper bound of the for-loop needs to be adjusted, together with the right operand of the digits operator. E.g.: For 2000 digits the upper bound of the for-loop must be 1655 instead of 825.
$ include "seed7_05.s7i"; include "bigint.s7i"; include "bigrat.s7i"; # In 1997, David H. Bailey, Peter Borwein and Simon Plouffe published a # paper (Bailey, 1997) on a new formula for PI as an infinite series: # PI = sum_n_from_0_to_inf(16 ** (-n) * # (4 / (8 * n + 1) - 2 / (8 * n + 4) - 1 / (8 * n + 5) - 1 / (8 * n + 6))) const func bigRational: compute_pi_bailey_borwein_plouffe is func result var bigRational: sum is 0_ / 1_; local var integer: n is 0; var bigInteger: k8 is 0_; begin for n range 0 to 825 do k8 := bigInteger conv (8 * n); sum +:= 1_ / 16_ ** n * (4_ / (k8 + 1_) - 2_ / (k8 + 4_) - 1_ / (k8 + 5_) - 1_ / (k8 + 6_)); end for; end func; const proc: main is func begin writeln(compute_pi_bailey_borwein_plouffe digits 1000); end func;
Write PI with 1000 decimal digits using Newtons formula
$ include "seed7_05.s7i"; # Newtons formula for PI is: # PI / 2 = sum_n_from_0_to_inf(n! / (2 * n + 1)!!) # This can be written as: # PI / 2 = 1 + 1/3 * (1 + 2/5 * (1 + 3/7 * (1 + 4/9 * (1 + ... )))) # This algorithm puts 2 * 1000 on the right side and computes everything from inside out. const integer: SCALE is 10000; const integer: MAXARR is 3500; const integer: ARRINIT is 2000; const proc: main is func local var integer: i is 0; var integer: j is 0; var integer: carry is 0; var array integer: arr is MAXARR times ARRINIT; var integer: sum is 0; begin for i range MAXARR downto 1 step 14 do sum := 0; for j range i downto 1 do sum := sum*j + SCALE*arr[j]; arr[j] := sum rem pred(j*2); sum := sum div pred(j*2); end for; write(carry + sum div SCALE lpad0 4); carry := sum rem SCALE; end for; writeln; end func;
Write the decimal digits of PI with a spigot algorithm
The program below uses the unbounded spigot algorithm published by Jeremy Gibbons. The digits of PI are calculated and written in succession. To stop the program press ctrl-C followed by * and ENTER.
$ include "seed7_05.s7i"; include "bigint.s7i"; const proc: main is func local var bigInteger: q is 1_; var bigInteger: r is 0_; var bigInteger: t is 1_; var bigInteger: k is 1_; var bigInteger: n is 3_; var bigInteger: l is 3_; var bigInteger: nn is 0_; var bigInteger: nr is 0_; var boolean: first is TRUE; begin while TRUE do if 4_ * q + r - t < n * t then write(n); if first then write("."); first := FALSE; end if; nr := 10_ * (r - n * t); n := 10_ * (3_ * q + r) div t - 10_ * n; q *:= 10_; r := nr; flush(OUT); else nr := (2_ * q + r) * l; nn := (q * (7_ * k + 2_) + r * l) div (t * l); q *:= k; t *:= l; l +:= 2_; incr(k); n := nn; r := nr; end if; end while; end func;
Determine the truncated square root of a big integer number
The library "bigint.s7i" defines the bigInteger function sqrt.
const func bigInteger: sqrt (in var bigInteger: number) is func result var bigInteger: root is 0_; local var bigInteger: res2 is 0_; begin if number > 0_ then res2 := number; repeat root := res2; res2 := (root + number div root) div 2_; until root <= res2; else raise NUMERIC_ERROR; end if; end func;
Function to compute the nth root of a positive float number
The nth root of the number 'a' can be computed with the exponentiation operator: 'a ** (1.0 / flt(n))'. An alternate function which uses Newton's method is:
const func float: nthRoot (in integer: n, in float: a) is func result var float: x1 is 0.0; local var float: x0 is 0.0; begin x0 := a; x1 := a / flt(n); while abs(x1 - x0) >= abs(x0 * 1.0E-9) do x0 := x1; x1 := (flt(pred(n)) * x0 + a / x0 ** pred(n)) / flt(n); end while; end func;
Exponentiation function for integers
The type integer defines an exponentiation operator which can be called with 'base ** exponent'. The Seed7 runtime library contains the function 'intPow' which implements the ** operator. This function uses the exponentiation by squaring algorithm. The Seed7 version of 'intPow' is:
const func integer: intPow (in var integer: base, in var integer: exponent) is func result var integer: power is 0; begin if exponent < 0 then raise(NUMERIC_ERROR); else if odd(exponent) then power := base; else power := 1; end if; exponent := exponent div 2; while exponent <> 0 do base *:= base; if odd(exponent) then power *:= base; end if; exponent := exponent div 2; end while; end if; end func;
Exponentiation function for float base and integer exponent
The type float defines an exponentiation operator which can be called with 'base ** exponent'. The Seed7 runtime library contains the function 'fltIPow' which implements the ** operator. This function uses the exponentiation by squaring algorithm. The Seed7 version of 'fltIPow' is:
const func float: fltIPow (in var float: base, in var integer: exponent) is func result var float: power is 1.0; local var integer: stop is 0; begin if base = 0.0 then if exponent < 0 then power := Infinity; elsif exponent > 0 then power := 0.0; end if; else if exponent < 0 then stop := -1; end if; if odd(exponent) then power := base; end if; exponent >>:= 1; while exponent <> stop do base *:= base; if odd(exponent) then power *:= base; end if; exponent >>:= 1; end while; if stop = -1 then power := 1.0 / power; end if; end if; end func;
Multiply integers using the peasant multiplication
const func integer: peasantMult (in var integer: a, in var integer: b) is func result var integer: product is 0; begin while a <> 0 do if odd(a) then product +:= b; end if; a := a div 2; b *:= 2; end while; end func;
Binomial coefficient
The type integer defines the infix operator ! to compute the binomial coefficient. Below is the definition of the bigInteger infix operator ! from the library "bigint.s7i".
const func bigInteger: (in bigInteger: n) ! (in var bigInteger: k) is func result var bigInteger: binom is 0_; local var bigInteger: numerator is 0_; var bigInteger: denominator is 0_; begin if n >= 0_ and k > n >> 1 then k := n - k; end if; if k < 0_ then binom := 0_; elsif k = 0_ then binom := 1_; else binom := n; numerator := pred(n); denominator := 2_; while denominator <= k do binom *:= numerator; binom := binom div denominator; decr(numerator); incr(denominator); end while; end if; end func;
Gamma function
const func float: gamma (in float: X) is func result var float: gamma is 0.0; local const array float: A is [] ( 1.00000000000000000000, 0.57721566490153286061, -0.65587807152025388108, -0.04200263503409523553, 0.16653861138229148950, -0.04219773455554433675, -0.00962197152787697356, 0.00721894324666309954, -0.00116516759185906511, -0.00021524167411495097, 0.00012805028238811619, -0.00002013485478078824, -0.00000125049348214267, 0.00000113302723198170, -0.00000020563384169776, 0.00000000611609510448, 0.00000000500200764447, -0.00000000118127457049, 0.00000000010434267117, 0.00000000000778226344, -0.00000000000369680562, 0.00000000000051003703, -0.00000000000002058326, -0.00000000000000534812, 0.00000000000000122678, -0.00000000000000011813, 0.00000000000000000119, 0.00000000000000000141, -0.00000000000000000023, 0.00000000000000000002); var float: Y is 0.0; var float: Sum is A[maxIdx(A)]; var integer: N is 0; begin Y := X - 1.0; for N range pred(maxIdx(A)) downto minIdx(A) do Sum := Sum * Y + A[N]; end for; gamma := 1.0 / Sum; end func;
Matrix addition
const type: matrix is array array float; const func matrix: (in matrix: summand1) + (in matrix: summand2) is func result var matrix: sum is matrix.value; local var integer: i is 0; var integer: j is 0; begin if length(summand1) <> length(summand2) or length(summand1[1]) <> length(summand2[1]) then raise RANGE_ERROR; else sum := length(summand1) times length(summand1[1]) times 0.0; for i range 1 to length(summand1) do for j range 1 to length(summand1[i]) do sum[i][j] := summand1[i][j] + summand2[i][j]; end for; end for; end if; end func;
Matrix multiplication
const type: matrix is array array float; const func matrix: (in matrix: factor1) * (in matrix: factor2) is func result var matrix: product is matrix.value; local var integer: i is 0; var integer: j is 0; var integer: k is 0; var float: accumulator is 0.0; begin if length(factor1[1]) <> length(factor2) then raise RANGE_ERROR; else product := length(factor1) times length(factor2[1]) times 0.0; for i range 1 to length(factor1) do for j range 1 to length(factor2) do accumulator := 0.0; for k range 1 to length(factor1) do accumulator +:= factor1[i][k] * factor2[k][j]; end for; product[i][j] := accumulator; end for; end for; end if; end func;
Matrix exponentiation with integer exponent
Based on the matrix multiplication and the type matrix a matrix exponentiation with an integer exponent can be defined:
const func matrix: (in var matrix: base) ** (in var integer: exponent) is func result var matrix: power is matrix.value; local var integer: row is 0; var integer: column is 0; begin if exponent < 0 then raise NUMERIC_ERROR; else if odd(exponent) then power := base; else # Create identity matrix power := length(base) times length(base) times 0.0; for row range 1 to length(base) do for column range 1 to length(base) do if row = column then power[row][column] := 1.0; end if; end for; end for; end if; exponent := exponent div 2; while exponent > 0 do base := base * base; if odd(exponent) then power := power * base; end if; exponent := exponent div 2; end while; end if; end func;
Convert a matrix to row echelon form
A matrix is in row echelon form if
- All rows with at least one nonzero element are above any rows with all zeroes.
- The first nonzero number from the left, of a nonzero row is always strictly to the right of the first nonzero number from the left, in the row above it.
- The function below converts a matrix like
2.0 1.0 -1.0 8.0 -3.0 -1.0 2.0 -11.0 -2.0 1.0 2.0 -3.0 - into its row echelon form
2.0 1.0 -1.0 8.0 0.0 0.5 0.5 1.0 0.0 0.0 -1.0 1.0
const type: matrix is array array float; const proc: toRowEchelonForm (inout matrix: mat) is func local var integer: numRows is 0; var integer: numColumns is 0; var integer: row is 0; var integer: column is 0; var integer: pivot is 0; var float: factor is 0.0; begin numRows := length(mat); numColumns := length(mat[1]); for row range numRows downto 1 do column := 1; while column <= numColumns and mat[row][column] = 0.0 do incr(column); end while; if column > numColumns then # Empty rows are moved to the bottom mat := mat[.. pred(row)] & mat[succ(row) ..] & [] (mat[row]); decr(numRows); end if; end for; for pivot range 1 to numRows do if mat[pivot][pivot] = 0.0 then # Find a row were the pivot column is not zero row := 1; while row <= numRows and mat[row][pivot] = 0.0 do incr(row); end while; # Add row were the pivot column is not zero for column range 1 to numColumns do mat[pivot][column] +:= mat[row][column]; end for; end if; for row range succ(pivot) to numRows do if mat[row][pivot] <> 0.0 then # Make sure that the pivot column contains zero in all rows below the pivot row factor := -mat[row][pivot] / mat[pivot][pivot]; for column range pivot to numColumns do mat[row][column] +:= mat[pivot][column] * factor; end for; end if; end for; end for; end func;
Convert a matrix to reduced row echelon form
A matrix is in reduced row echelon form if
- All rows with at least one nonzero element are above any rows with all zeroes.
- The first nonzero number from the left, of a nonzero row is always strictly to the right of the first nonzero number from the left, in the row above it.
- Every leading coefficient is 1 and is the only nonzero entry in its column
- The function below converts a matrix like
2.0 1.0 -1.0 8.0 -3.0 -1.0 2.0 -11.0 -2.0 1.0 2.0 -3.0 - into its reduced row echelon form
1.0 0.0 0.0 2.0 0.0 1.0 0.0 3.0 0.0 0.0 1.0 -1.0
const type: matrix is array array float; const proc: toReducedRowEchelonForm (inout matrix: mat) is func local var integer: numRows is 0; var integer: numColumns is 0; var integer: row is 0; var integer: column is 0; var integer: pivot is 0; var float: factor is 0.0; begin numRows := length(mat); numColumns := length(mat[1]); for row range numRows downto 1 do column := 1; while column <= numColumns and mat[row][column] = 0.0 do incr(column); end while; if column > numColumns then # Empty rows are moved to the bottom mat := mat[.. pred(row)] & mat[succ(row) ..] & [] (mat[row]); decr(numRows); end if; end for; for pivot range 1 to numRows do if mat[pivot][pivot] = 0.0 then # Find a row were the pivot column is not zero row := 1; while row <= numRows and mat[row][pivot] = 0.0 do incr(row); end while; # Add row were the pivot column is not zero for column range 1 to numColumns do mat[pivot][column] +:= mat[row][column]; end for; end if; if mat[pivot][pivot] <> 1.0 then # Make sure that the pivot element is 1.0 factor := 1.0 / mat[pivot][pivot]; for column range pivot to numColumns do mat[pivot][column] := mat[pivot][column] * factor; end for; end if; for row range 1 to numRows do if row <> pivot and mat[row][pivot] <> 0.0 then # Make sure that in all other rows the pivot column contains zero factor := -mat[row][pivot]; for column range pivot to numColumns do mat[row][column] +:= mat[pivot][column] * factor; end for; end if; end for; end for; end func;
Dot product
$ include "seed7_05.s7i"; $ syntax expr: .().dot.() is -> 6; # priority of dot operator const func integer: (in array integer: a) dot (in array integer: b) is func result var integer: sum is 0; local var integer: index is 0; begin if length(a) <> length(b) then raise RANGE_ERROR; else for index range 1 to length(a) do sum +:= a[index] * b[index]; end for; end if; end func; const proc: main is func begin writeln([](1, 3, -5) dot [](4, -2, -1)); end func;
Random number generator
The function 'rand', which creates a random value between a lower and an upper bound, is predefined for many types (boolean, integer, bigInteger, float, char). The random generator below delivers random numbers between 0 and 2**32-1. To get a different pseudorandom sequence the variable 'seed' can be initialized with another value.
var bigInteger: seed is 987654321_; const func bigInteger: rand_32 is func result var integer: randomNumber is 0; begin seed := (seed * 1103515245_ + 12345_ rem 2_ ** 64; randomNumber := seed div 2_ ** 32; end func;
Recursive fibonacci function
This algorithm just uses the recursive definition of the fibonacci function. It can be used as benchmark to test the performance of recursive calls. For a solution with better scalability use the iterative fibonacci function below.
const func integer: fib (in integer: number) is func result var integer: fib is 1; begin if number > 2 then fib := fib(pred(number)) + fib(number - 2); elsif number = 0 then fib := 0; end if; end func;
Iterative fibonacci function
const func bigInteger: fib (in integer: number) is func result var bigInteger: fib is 1_; local var integer: i is 0; var bigInteger: a is 0_; var bigInteger: c is 0_; begin for i range 1 to pred(number) do c := a; a := fib; fib +:= c; end for; end func;
Display 100 numbers of the fibonacci sequence
$ include "seed7_05.s7i"; include "bigint.s7i"; const proc: main is func local var integer: i is 0; var bigInteger: a is 0_; var bigInteger: b is 1_; var bigInteger: c is 0_; begin writeln(a); for i range 1 to 100 do writeln(b); c := a; a := b; b +:= c; end for; end func;
The tak function
const func integer: tak (in integer: x, in integer: y, in integer: z) is func result var integer: tak is 0; begin if y >= x then tak := z; else tak := tak(tak(pred(x), y, z), tak(pred(y), z, x), tak(pred(z), x, y)); end if; end func;
The ackermann function
The ackermann function grows rapidly, even for small inputs:
- ackermann(4, 1) is 65533
- ackermann(4, 2) has 19729 decimal digits.
Below is a simple implementation of the ackermann function, that follows the original specification. The recursion depth of ackermann grows so fast that computing ackermann(4, 1), with the implementation below, might trigger a stack overflow. In practice the bigInteger ackermann function implementation further below should be preferred.
const func integer: ackermann (in integer: m, in integer: n) is func result var integer: ackermann is 0; begin if m = 0 then ackermann := succ(n); elsif n = 0 then ackermann := ackermann(pred(m), 1); else ackermann := ackermann(pred(m), ackermann(m, pred(n))); end if; end func;
The bigInteger ackermann function
This implementation of the ackermann function uses bigInteger instead of integer. Additionally there are optimizations for special cases, to reduce the recursion depth. Because of these improvements the ackermann implementation below can compute ackermann(4, 2) without problems.
const func bigInteger: ackermann (in bigInteger: m, in bigInteger: n) is func result var bigInteger: ackermann is 0_; begin case m of when {0_}: ackermann := succ(n); when {1_}: ackermann := n + 2_; when {2_}: ackermann := 3_ + 2_ * n; when {3_}: ackermann := 5_ + 8_ * pred(2_ ** ord(n)); otherwise: if n = 0_ then ackermann := ackermann(pred(m), 1_); else ackermann := ackermann(pred(m), ackermann(m, pred(n))); end if; end case; end func;
|
|