/*********************************************
 Subject: Comparing five methods for
 computing Euler's constant 0.5772...
 // https://rosettacode.org/wiki/Euler%27s_constant_0.5772...
 --------------------------------------------*/
double a, b, h, n2, r, u, v;
float floatA, floatB, floatN2;
int k, k2, m, n;
double eps = 1e-6;

void setup() {
  size(100, 100);
  noLoop();
}

void draw() {
  println("From the definition, err. 3e-10\n");

  n = 400;

  h = 1;

  for (int k = 2; k <= n; k++) {
    h += 1.0 / k;
  }
  //faster convergence: Negoi, 1997
  a = log(n +.5 + 1.0 / (24*n));

  println("Hn    ", h);
  println("gamma ", h - a);
  println("k = ", n);
  println("");

  println("Sweeney, 1963, err. idem");
  n = 21;

  double s[] = {0, n};
  r = n;
  k = 1;
  while (r > eps) {
    k ++;
    r *= (double) n / k;
    s[k & 1] = s[k & 1] + r / k;
  }

  // println("gamma %.16f\nk = %d\n\n", s[1] - s[0] - log(n), k);

  println("Hn    ", h);
  println("gamma ", s[1] - s[0] - log(n));
  println("k = ", k);
  println("");

  println("Bailey, 1988");
  n = 5;
  floatA = 1;
  h = 1;
  floatN2 = pow(2, n);
  r = 1;
  k = 1;
  while (abs(floatB - floatA) > eps) {
    k += 1;
    r *= floatN2 / k;
    h += 1.0 / k;
    floatB = floatA;
    floatA += r * h;
  }
  floatA *= floatN2 / exp(floatN2);

  println("gamma ", floatA - n * log(2));
  println("k = ", k);
  println("");

  println("Brent-McMillan, 1980");

  n = 13;

  floatA = -log(n);
  floatB = 1;
  u = a;
  v = b;
  n2 = n * n;
  k2 = 0;
  k = 0;

  while (abs(floatA) > eps) {
    k2 += 2*k + 1;
    k += 1;
    floatA *= n2 / k;
    floatB *= n2 / k2;
    floatA = (floatA + floatB) / k;
    u += floatA;
    v += floatB;
  }
  println("gamma  ", u / v);
  println("k      ", k);

  println("How Euler did it in 1735\n");
  //Bernoulli numbers with even indices

  double[] B2 = new double[11];

  B2[1] = 1.0;
  B2[2] = 1.0/6;
  B2[3] = -1.0/30;
  B2[4] = 1.0/42;
  B2[5] = -1.0/30;
  B2[6] = 5.0/66;
  B2[7] = -691.0/2730;
  B2[8] = 7.0/6;
  B2[9] = -3617.0/510;
  B2[10]= 43867.0/798;

  m = 7;
  n = 10;

  //n-th harmonic number
  h = 1;
  for (k = 2; k <= n; k++) {
    h += 1.0 / k;
  }
  println("Hn    ", h);

  h -= log(n);
  println("  -ln ", h);

  //expansion C = -digamma(1)
  a = -1.0 / (2*n);
  n2 = n * n;
  r = 1;
  for (k = 1; k <= m; k++) {
    r *= n2;
    a += B2[k] / (2*k * r);
  }

  println("");
  println("err  ", a);
  println("gamma ", h + a );
  println("k = ", n + m);
  println("");
  println("C  =  0.57721566490153286...\n");
}


def factorial_iterative(n:int)
    2.upto(n-1) do |i|
        n *= i
    end
    n
end

puts factorial_iterative 10


//A functional implementation of Evolutionary algorithm
//Nigel Galloway February 7th., 2018
let G=System.Random 23
let fitness n=Array.fold2(fun a n g->if n=g then a else a+1) 0 n ("METHINKS IT IS LIKE A WEASEL".ToCharArray())
let alphabet="QWERTYUIOPASDFGHJKLZXCVBNM ".ToCharArray()
let mutate (n:char[]) g=Array.iter(fun g->n.[g]<-alphabet.[G.Next()%27]) (Array.init g (fun _->G.Next()%(Array.length n)));n
let nextParent n g=List.init 500 (fun _->mutate (Array.copy n) g)|>List.minBy fitness
let evolution n=let rec evolution n g=match fitness n with |0->(0,n)::g |l->evolution (nextParent n ((l/2)+1)) ((l,n)::g)
                evolution n []
let n = evolution (Array.init 28 (fun _->alphabet.[G.Next()%27]))


MODULE EvenOdd;
IMPORT StdLog,Args,Strings;

PROCEDURE BitwiseOdd(i: INTEGER): BOOLEAN;
BEGIN
	RETURN 0 IN BITS(i)
END BitwiseOdd;

PROCEDURE Odd(i: INTEGER): BOOLEAN;
BEGIN
	RETURN (i MOD 2) # 0
END Odd;

PROCEDURE CongruenceOdd(i: INTEGER): BOOLEAN;
BEGIN
	RETURN ((i -1) MOD 2) = 0
END CongruenceOdd;

PROCEDURE Do*;
VAR
	p: Args.Params;
	i,done,x: INTEGER;
BEGIN
	Args.Get(p);
	StdLog.String("Builtin function: ");StdLog.Ln;i := 0;
	WHILE i < p.argc DO
		Strings.StringToInt(p.args[i],x,done);
		StdLog.String(p.args[i] + " is:> ");
		IF ODD(x) THEN StdLog.String("odd") ELSE StdLog.String("even") END;
		StdLog.Ln;INC(i)
	END;
	StdLog.String("Bitwise: ");StdLog.Ln;i:= 0;
	WHILE i < p.argc DO
		Strings.StringToInt(p.args[i],x,done);
		StdLog.String(p.args[i] + " is:> ");
		IF BitwiseOdd(x) THEN StdLog.String("odd") ELSE StdLog.String("even") END;
		StdLog.Ln;INC(i)
	END;
	StdLog.String("Module: ");StdLog.Ln;i := 0;
	WHILE i < p.argc DO
		Strings.StringToInt(p.args[i],x,done);
		StdLog.String(p.args[i] + " is:> ");
		IF Odd(x) THEN StdLog.String("odd") ELSE StdLog.String("even") END;
		StdLog.Ln;INC(i)
	END;
	StdLog.String("Congruences: ");StdLog.Ln;i := 0;
	WHILE i < p.argc DO
		Strings.StringToInt(p.args[i],x,done);
		StdLog.String(p.args[i] + " is:> ");
		IF CongruenceOdd(x) THEN StdLog.String("odd") ELSE StdLog.String("even") END;
		StdLog.Ln;INC(i)
	END;
END Do;


program Binomial;

{$APPTYPE CONSOLE}

function BinomialCoff(N, K: Cardinal): Cardinal;
var
  L: Cardinal;

begin
  if N < K then
    Result:= 0      // Error
  else begin
    if K > N - K then
      K:= N - K;    // Optimization
    Result:= 1;
    L:= 0;
    while L < K do begin
      Result:= Result * (N - L);
      Inc(L);
      Result:= Result div L;
    end;
  end;
end;

begin
  Writeln('C(5,3) is ', BinomialCoff(5, 3));
  ReadLn;
end.


defmodule RC do
  def choose(n,k) when is_integer(n) and is_integer(k) and n>=0 and k>=0 and n>=k do
    if k==0, do: 1, else: choose(n,k,1,1)
  end

  def choose(n,k,k,acc), do: div(acc * (n-k+1), k)
  def choose(n,k,i,acc), do: choose(n, k, i+1, div(acc * (n-i+1), i))
end

IO.inspect RC.choose(5,3)
IO.inspect RC.choose(60,30)


BEGIN {
	bf=ARGV[1]; ARGV[1] = ""
	compile(bf)
	execute()
}

# Strips non-instructions, builds the jump table.
function compile(s,   i,j,k,f) {
	c = split(s, src, "")
	j = 0
	for(i = 1; i <= c; i++) {
		if(src[i] ~ /[\-\+\[\]\<\>,\.]/)
			code[j++] = src[i]

		if(src[i] == "[") {
			marks[j] = 1
		} else if(src[i] == "]") {
			f = 0
			for(k = j; k > 0; k--) {
				if(k in marks) {
					jump[k-1] = j - 1
					jump[j-1] = k - 1
					f = 1
					delete marks[k]
					break
				}
			}
			if(!f) {
				print "Unmatched ]"
				exit 1
			}
		}
	}
}

function execute(   pc,p,i) {
	pc = p = 0
	while(pc in code) {
		i = code[pc]

		if(i == "+")
			arena[p]++
		else if(i == "-")
			arena[p]--
		else if(i == "<")
			p--
		else if(i == ">")
			p++
		else if(i == ".")
			printf("%c", arena[p])
		else if(i == ",") {
			while(1) {
				if (goteof) break
				if (!gotline) {
					gotline = getline
					if(!gotline) goteof = 1
					if (goteof) break
					line = $0
				}
				if (line == "") {
					gotline=0
					m[p]=10
					break
				}
				if (!genord) {
					for(i=1; i<256; i++)
						ord[sprintf("%c",i)] = i
					genord=1
				}
				c = substr(line, 1, 1)
				line=substr(line, 2)
				arena[p] = ord[c]
				break
			}

		} else if((i == "[" && arena[p] == 0) ||
		          (i == "]" && arena[p] != 0))
			pc = jump[pc]
		pc++
	}
}


import java.util.*;

public class ErdosSelfridge {
    private int[] primes;
    private int[] category;

    public static void main(String[] args) {
        ErdosSelfridge es = new ErdosSelfridge(1000000);

        System.out.println("First 200 primes:");
        for (var e : es.getPrimesByCategory(200).entrySet()) {
            int category = e.getKey();
            List<Integer> primes = e.getValue();
            System.out.printf("Category %d:\n", category);
            for (int i = 0, n = primes.size(); i != n; ++i)
                System.out.printf("%4d%c", primes.get(i), (i + 1) % 15 == 0 ? '\n' : ' ');
            System.out.printf("\n\n");
        }

        System.out.println("First 1,000,000 primes:");
        for (var e : es.getPrimesByCategory(1000000).entrySet()) {
            int category = e.getKey();
            List<Integer> primes = e.getValue();
            System.out.printf("Category %2d: first = %7d  last = %8d  count = %d\n", category,
                              primes.get(0), primes.get(primes.size() - 1), primes.size());
        }
    }

    private ErdosSelfridge(int limit) {
        PrimeGenerator primeGen = new PrimeGenerator(100000, 200000);
        List<Integer> primeList = new ArrayList<>();
        for (int i = 0; i < limit; ++i)
            primeList.add(primeGen.nextPrime());
        primes = new int[primeList.size()];
        for (int i = 0; i < primes.length; ++i)
            primes[i] = primeList.get(i);
        category = new int[primes.length];
    }

    private Map<Integer, List<Integer>> getPrimesByCategory(int limit) {
        Map<Integer, List<Integer>> result = new TreeMap<>();
        for (int i = 0; i < limit; ++i) {
            var p = result.computeIfAbsent(getCategory(i), k -> new ArrayList<Integer>());
            p.add(primes[i]);
        }
        return result;
    }

    private int getCategory(int index) {
        if (category[index] != 0)
            return category[index];
        int maxCategory = 0;
        int n = primes[index] + 1;
        for (int i = 0; n > 1; ++i) {
            int p = primes[i];
            if (p * p > n)
                break;
            int count = 0;
            for (; n % p == 0; ++count)
                n /= p;
            if (count != 0) {
                int category = (p <= 3) ? 1 : 1 + getCategory(i);
                maxCategory = Math.max(maxCategory, category);
            }
        }
        if (n > 1) {
            int category = (n <= 3) ? 1 : 1 + getCategory(getIndex(n));
            maxCategory = Math.max(maxCategory, category);
        }
        category[index] = maxCategory;
        return maxCategory;
    }

    private int getIndex(int prime) {
       return Arrays.binarySearch(primes, prime);
    }
}


#lang racket/base

(require math/number-theory
         math/base)

gamma.0

;; if you want to work it out the hard way...
(define (H n)
  (for/sum ((i n)) (/ (add1 i))))

(define (g #:n (n 10) #:k (k 7))
  (+ (- (H n)
        (log n)
        (/ (* n 2)))
     (for/sum ((2k (in-range 2 (* 2 (add1 k)) 2)))
       (/ (bernoulli-number 2k) (* (expt n 2k) 2k)))))

(g)


# 20211124 Raku programming solution

sub gamma (\N where N > 1) { # Vacca series https://w.wiki/4ybp
                             # convert terms to FatRat for arbitrary precision
   return  (1/2 - 1/3) + [+] (2..N).race.map: -> \n {

      my ($power, $sign, $term) = 2**n, -1;

      for ($power..^2*$power) { $term += ($sign = -$sign) / $_ }

      n*$term
   }
}

say gamma 23 ;


// 20220322 Rust programming solution

fn gamma(N: u32) -> f64 { // Vacca series https://w.wiki/4ybp

    return 1f64 / 2f64 - 1f64 / 3f64
        + ((2..=N).map(|n| {
            let power: u32 = 2u32.pow(n);
            let mut sign: f64 = -1f64;
            let mut term: f64 = 0f64;

            for denominator in power..=(2 * power - 1) {
                sign *= -1f64;
                term += sign / f64::from(denominator);
            }

            return f64::from(n) * term;
        }))
        .sum::<f64>();
}

fn main() {
    println!("{}", gamma(23));
}


; Procedure to compute factorial.
(define fact
  (lambda (n)
    (if (<= n 0)
      1
      (* n (fact (1- n))))))

; Compute Euler's gamma constant as the difference of log(n) from a sum.
; See section 2.3 of <http://numbers.computation.free.fr/Constants/Gamma/gamma.html>.
(define gamma
  (lambda (n)
    (let ((sum 0))
      (do ((k 1 (1+ k)))
          ((> k (* 3.5911 n)) (- sum (log n)))
        (set! sum (+ sum (/ (* (expt -1 (1- k)) (expt n k)) (* k (fact k)))))))))

; Show Euler's gamma constant computed at log(100).
(printf "Euler's gamma constant: ~a~%" (gamma 100))


MCSKIP "WITH" NL
"" Factorial - iterative
MCSKIP MT,<>
MCINS %.
MCDEF FACTORIAL WITHS ()
AS <MCSET T1=%A1.
MCSET T2=1
MCSET T3=1
%L1.MCGO L2 IF T3 GR T1
MCSET T2=T2*T3
MCSET T3=T3+1
MCGO L1
%L2.%T2.>
fact(1) is FACTORIAL(1)
fact(2) is FACTORIAL(2)
fact(3) is FACTORIAL(3)
fact(4) is FACTORIAL(4)


MODULE Factorial;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;

PROCEDURE Factorial(n : CARDINAL) : CARDINAL;
VAR result : CARDINAL;
BEGIN
    result := 1;
    WHILE n#0 DO
        result := result * n;
        DEC(n)
    END;
    RETURN result
END Factorial;

VAR
    buf : ARRAY[0..63] OF CHAR;
    n : CARDINAL;
BEGIN
    FOR n:=0 TO 10 DO
        FormatString("%2c! = %7c\n", buf, n, Factorial(n));
        WriteString(buf)
    END;

    ReadChar
END Factorial.


USING: arrays formatting io kernel literals math prettyprint
random sequences strings ;
FROM: math.extras => ... ;
IN: rosetta-code.evolutionary-algorithm

CONSTANT: target "METHINKS IT IS LIKE A WEASEL"
CONSTANT: mutation-rate 0.1
CONSTANT: num-children 25
CONSTANT: valid-chars
    $[ CHAR: A ... CHAR: Z >array { 32 } append ]

: rand-char ( -- n )
    valid-chars random ;

: new-parent ( -- str )
    target length [ rand-char ] replicate >string ;

: fitness ( str -- n )
    target [ = ] { } 2map-as sift length ;

: mutate ( str rate -- str/str' )
    [ random-unit > [ drop rand-char ] when ] curry map ;

: next-parent ( str -- str/str' )
    dup [ mutation-rate mutate ] curry num-children 1 - swap
    replicate [ 1array ] dip append [ fitness ] supremum-by ;

: print-parent ( str -- )
    [ fitness pprint bl ] [ print ] bi ;

: main ( -- )
    0 new-parent
    [ dup target = ]
    [ next-parent dup print-parent [ 1 + ] dip ] until drop
    "Finished in %d generations." printf ;

MAIN: main


#Using bitwise shift
  def isEven_bShift(n)
    n == ((n >> 1) << 1)
  end
  def isOdd_bShift(n)
    n != ((n >> 1) << 1)
  end
#Using modulo operator
  def isEven_mod(n)
    (n % 2) == 0
  end
  def isOdd_mod(n)
    (n % 2) != 0
  end
# Using bitwise "and"
  def isEven_bAnd(n)
    (n & 1) ==  0
  end
  def isOdd_bAnd(n)
    (n & 1) != 0
  end

puts isEven_bShift(7)
puts isOdd_bShift(7)

puts isEven_mod(12)
puts isOdd_mod(12)

puts isEven_bAnd(21)
puts isOdd_bAnd(21)


void main() {
    import std.stdio, std.bigint;

    foreach (immutable i; -5 .. 6)
        writeln(i, " ", i & 1, " ", i % 2, " ", i.BigInt % 2);
}


choose(N, 0) -> 1;
choose(N, K) when is_integer(N), is_integer(K), (N >= 0), (K >= 0), (N >= K) ->
  choose(N, K, 1, 1).

choose(N, K, K, Acc) ->
  (Acc * (N-K+1)) div K;
choose(N, K, I, Acc) ->
  choose(N, K, I+1, (Acc * (N-I+1)) div I).


PROGRAM BINOMIAL

!$DOUBLE

PROCEDURE BINOMIAL(N,K->BIN)
      LOCAL R,D
      R=1 D=N-K
      IF D>K THEN K=D D=N-K  END IF
      WHILE N>K DO
        R*=N
        N-=1
        WHILE D>1 AND (R-D*INT(R/D))=0 DO
          R/=D
          D-=1
        END WHILE
      END WHILE
      BIN=R
END PROCEDURE

BEGIN
   BINOMIAL(5,3->BIN)
   PRINT("Binomial (5,3) = ";BIN)
   BINOMIAL(100,2->BIN)
   PRINT("Binomial (100,2) = ";BIN)
   BINOMIAL(33,17->BIN)
   PRINT("Binomial (33,17) = ";BIN)
END PROGRAM


let choose n k = List.fold (fun s i -> s * (n-i+1)/i ) 1 [1..k]


Lbl BF
r₁→P
r₂→I
L₁→D
Fill(D,768,0)

While {P}
 {P}→C
 If C='+'
  {D}++
 ElseIf C='-'
  {D}--
 ElseIf C='>'
  D++
 ElseIf C='<'
  D--
 ElseIf C='.'
  Disp {D}▶Char
 ElseIf C=','
  {I}→{D}
  I++
 ElseIf C='['?{D}=0
  NEXT(P)→P
 ElseIf C=']'
  PREV(P)→P
 End
 P++
End
Return

Lbl NEXT
r₁++
1→S
While S
 If {r₁}='['
  S++
 ElseIf {r₁}=']'
  S--
 End
 r₁++
End
r₁
Return

Lbl PREV
r₁--
1→S
While S
 If {r₁}=']'
  S++
 ElseIf {r₁}='['
  S--
 End
 r₁--
End
r₁
Return


using Primes

primefactors(n) = collect(keys(factor(n)))

function ErdösSelfridge(n)
    highfactors = filter(>(3), primefactors(n + 1))
    category = 1
    while !isempty(highfactors)
        highfactors = unique(reduce(vcat, [filter(>(3), primefactors(a + 1)) for a in highfactors]))
        category += 1
    end
    return category
end

function testES(numshowprimes, numtotalprimes)
    println("First $numshowprimes primes by Erdös-Selfridge categories:")
    dict = Dict{Int, Vector{Int}}(i => [] for i in 1:5)
    for p in primes(prime(numshowprimes))
        push!(dict[ErdösSelfridge(p)], p)
    end
    for cat in 1:5
        println("$cat => ", dict[cat])
    end
    dict2 = Dict{Int, Tuple{Int, Int, Int}}(i => (0, 0, 0) for i in 1:11)
    println("\nTotals for first $numtotalprimes primes by Erdös-Selfridge categories:")
    for p in primes(prime(numtotalprimes))
        cat = ErdösSelfridge(p)
        fir, tot, las = dict2[cat]
        fir == 0 && (fir = p)
        dict2[cat] = (fir, tot + 1, p)
    end
    for cat in 1:11
        first, total, last = dict2[cat]
        println("Category", lpad(cat, 3), " => first:", lpad(first, 8), ", total:", lpad(total, 7), ", last:", last)
    end
end

testES(200, 1_000_000)


use strict;
use warnings;
use feature 'say';
use List::Util 'max';
use ntheory qw/factor/;
use Primesieve qw(generate_primes);

my @primes = (0, generate_primes (1, 10**8));
my %cat = (2 => 1, 3 => 1);

sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }

sub ES {
    my ($n) = @_;
    my @factors = factor $n + 1;
    my $category = max map { defined $cat{$_} and $cat{$_} } @factors;
    unless (defined $cat{ $factors[-1] }) {
        $category = max $category, (1 + max map { $cat{$_} } factor 1 + $factors[-1]);
        $cat{ $factors[-1] } = $category;
    }
    $category
}

my %es;
my $upto = 200;
push @{$es{ES($_)}}, $_ for @primes[1..$upto];
say "First $upto primes, Erdös-Selfridge categorized:";
say "$_: " . join ' ', sort {$a <=> $b} @{$es{$_}} for sort keys %es;

%es = ();
$upto = 1_000_000;
say "\nSummary of first @{[comma $upto]} primes, Erdös-Selfridge categorized:";
push @{$es{ES($_)}}, $_ for @primes[1..$upto];
printf "Category %2d:  first: %9s  last: %10s  count: %s\n",
    map { comma $_ } $_, (sort {$a <=> $b} @{$es{$_}})[0, -1], scalar @{$es{$_}}
        for sort {$a <=> $b} keys %es;


# 100 decimals of precision
local Num!PREC = 4*100
say Num.EulerGamma


import math
const eps = 1e-6
fn main() {
    //.5772
    println("From the definition, err. 3e-10")
    mut n := 400
    mut h := 1.0
    for k in 2..n+1 {
        h += 1.0/f64(k)
    }
    //faster convergence: Negoi, 1997
    mut a := math.log(f64(n) + 0.5 + 1.0/f64(24*n))

    println("Hn    ${h:0.16f}")
    println("gamma ${h-a:0.16f}\nk = $n\n")

    println("Sweeney, 1963, err. idem")
    n = 21
    mut s := [0.0, f64(n)]
    mut r := f64(n)
    mut k := 1
    for {
        k++
        r *= f64(n) / f64(k)
        s[k & 1] += r/f64(k)
        if r <= eps {
            break
        }
    }
    println("gamma ${s[1] - s[0] - math.log(n):0.16f}\nk = $k\n")

    println("Bailey, 1988")
    n = 5
    a = 1.0
    h = 1.0
    mut n2 := math.pow(f64(2),f64(n))
    r = 1
    k = 1
    for {
        k++
        r *= n2 / f64(k)
        h += 1/f64(k)
        b := a
        a += r * h
        if math.abs(b-a) <= eps {
            break
        }
    }
    a *= n2 / math.exp(n2)
    println("gamma ${a - n * math.log(2):.16f}\nk = $k\n")

    println("Brent-McMillan, 1980")
    n = 13
    a = -math.log(n)
    mut b := 1.0
    mut u := a
    mut v := b
    n2 = n * n
    mut k2 := 0
    k = 0
    for {
        k2 += 2*k + 1
        k++
        a *= n2 / f64(k)
        b *= n2 / f64(k2)
        a = (a + b)/f64(k)
        u += a
        v += b
        if math.abs(a) <= eps {
            break
        }
    }
    println("gamma ${u/v:0.16f}\nk = $k\n")

    println("How Euler did it in 1735")
    // Bernoulli numbers with even indices
    b2 := [1.0, 1.0/6, -1.0/30, 1.0/42, -1.0/30, 5.0/66, -691.0/2730, 7.0/6, -3617.0/510, 43867.0/798]
    m := 7
    n = 10
    // n'th harmonic number
    h = 1.0
    for kz in 2..n+1 {
        h += 1.0/f64(kz)
    }
    println("Hn    ${h:0.16f}")
    h -= math.log(n)
    println("  -ln ${h:0.16f}")
    // expansion C = -digamma(1)
    a = -1.0 / (2.0*f64(n))
    n2 = f64(n * n)
    r = 1
    for kq in 1..m+1 {
        r *= n2
        a += b2[kq] / (2.0*f64(kq)*r)
    }
    println("err  ${a:0.16f}\ngamma ${h+a:0.16f}\nk = ${n+m}")
    println("\nC = 0.57721566490153286...")
}


import "./fmt" for Fmt

var eps = 1e-6

System.print("From the definition, err. 3e-10")
var n = 400
var h = 1
for (k in 2..n) h = h + 1/k
//faster convergence: Negoi, 1997
var a = (n + 0.5 + 1/(24*n)).log

Fmt.print("Hn    $0.14f", h)
Fmt.print("gamma $0.14f\nk = $d\n", h - a, n)

System.print("Sweeney, 1963, err. idem")
n = 21
var s = [0, n]
var r = n
var k = 1
while (true) {
    k = k + 1
    r = r * n / k
    s[k & 1] = s[k & 1] + r/k
    if (r <= eps) break
}
Fmt.print("gamma $0.14f\nk = $d\n", s[1] - s[0] - n.log, k)

System.print("Bailey, 1988")
n = 5
a = 1
h = 1
var n2 = 2.pow(n)
r = 1
k = 1
while (true) {
    k = k + 1
    r = r * n2 / k
    h = h + 1/k
    var b = a
    a = a + r * h
    if ((b-a).abs <= eps) break
}
a = a * n2 / n2.exp
Fmt.print("gamma $0.14f\nk = $d\n", a - n * 2.log, k)

System.print("Brent-McMillan, 1980")
n = 13
a = -n.log
var b = 1
var u = a
var v = b
n2 = n * n
var k2 = 0
k = 0
while (true) {
    k2 = k2 + 2*k + 1
    k = k + 1
    a = a * n2 / k
    b = b * n2 / k2
    a = (a + b)/k
    u = u + a
    v = v + b
    if (a.abs <= eps) break
}
Fmt.print("gamma $0.14f\nk = $d\n", u / v, k)

System.print("How Euler did it in 1735")
// Bernoulli numbers with even indices
var b2 = [1, 1/6, -1/30, 1/42, -1/30, 5/66, -691/2730, 7/6, -3617/510, 43867/798]
var m = 7
n = 10
// n'th harmonic number
h = 1
for (k in 2..n) h = h + 1/k
Fmt.print("Hn    $0.14f", h)
h = h - n.log
Fmt.print("  -ln $0.14f", h)
// expansion C = -digamma(1)
a = -1 / (2*n)
n2 = n * n
r = 1
for (k in 1..m) {
    r = r * n2
    a = a + b2[k] / (2*k*r)
}
Fmt.print("err  $0.14f\ngamma $0.14f\nk = $d", a, h + a, n + m)
System.print("\nC = 0.57721566490153286...")


PROCEDURE FactIter(n: CARDINAL): CARDINAL =
  VAR
    result := n;
    counter := n - 1;

  BEGIN
    FOR i := counter TO 1 BY -1 DO
      result := result * i;
    END;
    RETURN result;
  END FactIter;


factorial(num)	New ii,result
	If num<0 Quit "Negative number"
	If num["." Quit "Not an integer"
	Set result=1 For ii=1:1:num Set result=result*ii
	Quit result

Write $$factorial(0) ; 1
Write $$factorial(1) ; 1
Write $$factorial(2) ; 2
Write $$factorial(3) ; 6
Write $$factorial(10) ; 3628800
Write $$factorial(-6) ; Negative number
Write $$factorial(3.7) ; Not an integer


class Main
{
  static const Str target := "METHINKS IT IS LIKE A WEASEL"
  static const Int C := 100     // size of population
  static const Float p := 0.1f  // chance any char is mutated

  // compute distance of str from target
  static Int fitness (Str str)
  {
    Int sum := 0
    str.each |Int c, Int index|
    {
      if (c != target[index]) sum += 1
    }
    return sum
  }

  // mutate given parent string
  static Str mutate (Str str)
  {
    Str result := ""
    str.size.times |Int index|
    {
      result += ((Float.random < p) ? randomChar() : str[index]).toChar
    }
    return result
  }

  // return a random char
  static Int randomChar ()
  {
    "ABCDEFGHIJKLMNOPQRSTUVWXYZ "[Int.random(0..26)]
  }

  // make population by mutating parent and sorting by fitness
  static Str[] makePopulation (Str parent)
  {
    Str[] result := [,]
    C.times { result.add (mutate(parent)) }
    result.sort |Str a, Str b -> Int| { fitness(a) <=> fitness(b) }
    return result
  }

  public static Void main ()
  {
    Str parent := ""
    target.size.times { parent += randomChar().toChar }

    while (parent != target)
    {
      echo (parent)
      parent = makePopulation(parent).first
    }
    echo (parent)
  }
}


include lib/choose.4th
                                       \ target string
s" METHINKS IT IS LIKE A WEASEL" sconstant target

27 constant /charset                   \ size of characterset
29 constant /target                    \ size of target string
32 constant #copies                    \ number of offspring

/target string charset                 \ characterset
/target string this-generation         \ current generation and offspring
/target #copies [*] string new-generation

:this new-generation does> swap /target chars * + ;
                                       \ generate a mutation
: mutation charset /charset choose chars + [email protected] ;
                                       \ print the current candidate
: .candidate                           ( n1 n2 -- n1 f)
  ." Generation " over 2 .r ." : " this-generation count type cr /target -1 [+] =
;                                      \ test a candidate on
                                       \ THE NUMBER of correct genes
: test-candidate                       ( a -- a n)
  dup target 0 >r >r                   ( a1 a2)
  begin                                ( a1 a2)
    [email protected]                                 ( a1 a2 n)
  while                                ( a1 a2)
    over [email protected] over [email protected] =                  ( a1 a2 n)
    r> r> rot if 1+ then >r 1- >r      ( a1 a2)
    char+ swap char+ swap              ( a1+1 a2+1)
  repeat                               ( a1+1 a2+1)
  drop drop r> drop r>                 ( a n)
;
                                       \ find the best candidate
: get-candidate                        ( -- n)
  #copies 0 >r >r                      ( --)
  begin                                ( --)
    [email protected]                                 ( n)
  while                                ( --)
    [email protected] 1- new-generation               ( a)
    test-candidate r'@ over <          ( a n f)
    if swap count this-generation place r> 1- swap r> drop >r >r
    else drop drop r> 1- >r then       ( --)
  repeat                               ( --)
  r> drop r>                           ( n)
;
                                       \ generate a new candidate
: make-candidate                       ( a --)
  dup charset count rot place          ( a1)
  this-generation target >r            ( a1 a2 a3)
  begin                                ( a1 a2 a3)
    [email protected]                                 ( a1 a2 a3 n)
  while                                ( a1 a2 a3)
    over [email protected] over [email protected] =                  ( a1 a2 a3 f)
    swap >r >r over r>                 ( a1 a2 a1 f)
    if over [email protected] else mutation then      ( a1 a2 a1 c)
    swap c! r> r> 1- >r                ( a1 a2 a3)
    char+ rot char+ rot char+ rot      ( a1+1 a2+1 a3+1)
  repeat                               ( a1+1 a2+1 a3+1)
  drop drop drop r> drop               ( --)
;
                                       \ make a whole new generation
: make-generation #copies 0 do i new-generation make-candidate loop ;
                                       \ weasel program
: weasel
  s"  ABCDEFGHIJKLMNOPQRSTUVWXYZ " 2dup
  charset place                        \ initialize the characterset
  this-generation place 0              \ initialize the first generation
  begin                                \ start the program
    1+ make-generation                 \ make a new generation
    get-candidate .candidate           \ select the best candidate
  until drop                           \ stop when we've found perfection
;

weasel


$! in DCL, for integers, the least significant bit determines the logical value, where 1 is true and 0 is false
$
$ i = -5
$ loop1:
$  if i then $ write sys$output i, " is odd"
$  if .not. i then $ write sys$output i, " is even"
$  i = i + 1
$  if i .le. 6 then $ goto loop1


program EvenOdd;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

procedure IsOdd(aValue: Integer);
var
  Odd: Boolean;
begin
  Odd :=  aValue and 1 <> 0;
  Write(Format('%d is ', [aValue]));
  if Odd then
    Writeln('odd')
  else
    Writeln('even');
end;

var
  i: Integer;
begin
  for i := -5 to 10 do
    IsOdd(i);

  Readln;
end.


palindrome: [fn: fn-1 + fn-1: fn]
fibonacci: func [n][
	fn-1: 0
	fn: 1
	loop n palindrome
]


: fact ( n -- n-factorial )
    dup 0 = [ drop 1 ] [ dup 1 - fact * ] if ;

: choose ( n k -- n-choose-k )
    2dup - [ fact ] [email protected] * / ;

! outputs 10
5 3 choose .

! alternative using folds
USE: math.ranges

! (product [n..k+1] / product [n-k..1])
: choose-fold ( n k -- n-choose-k )
    2dup 1 + [a,b] product -rot - 1 [a,b] product / ;


: choose ( n k -- nCk ) 1 swap 0 ?do over i - i 1+ */ loop nip ;

 5  3 choose .   \ 10
33 17 choose .   \ 1166803110


program test_choose

  implicit none

  write (*, '(i0)') choose (5, 3)

contains

  function factorial (n) result (res)

    implicit none
    integer, intent (in) :: n
    integer :: res
    integer :: i

    res = product ((/(i, i = 1, n)/))

  end function factorial

  function choose (n, k) result (res)

    implicit none
    integer, intent (in) :: n
    integer, intent (in) :: k
    integer :: res

    res = factorial (n) / (factorial (k) * factorial (n - k))

  end function choose

end program test_choose


get "libhdr"

manifest
$(  bfeof = 0
$)

let reads(v) be
$(  let ch = ?
    v%0 := 0
    ch := rdch()
    until ch = '*N' do
    $(  v%0 := v%0 + 1
        v%(v%0) := ch
        ch := rdch()
    $)
$)

let contains(str, ch) = valof
$(  for i = 1 to str%0 do
        if ch = str%i then resultis true
    resultis false
$)

let readbf(file, v) = valof
$(  let i, ch = 1, ?
    let curin = input()
    v%0 := 0
    selectinput(file)
    ch := rdch()
    until ch = endstreamch do
    $(  if contains("+-<>.,[]", ch) then
        $(  v%i := ch
            i := i + 1
        $)
        ch := rdch()
    $)

    v%i := 0
    endread()
    selectinput(curin)
    resultis i + 1
$)

let bfout(ch) be wrch(ch=10 -> '*N', ch)
let bfin() = valof
$(  let ch = rdch()
    resultis ch = endstreamch -> bfeof, ch
$)

let scan(v, i, dir) = valof
$(  let d = 1
    until d = 0 do
    $(  i := i + dir
        if v%i = 0 then
        $(  writes("Unbalanced brackets*N")
            resultis 0
        $)
        if v%i = '[' then d := d + dir
        if v%i = ']' then d := d - dir
    $)
    resultis i
$)

let run(v, m) be
$(  let i = 1
    until v%i = 0 do
    $(  switchon v%i into
        $(  case '+': v%m := v%m + 1 ; endcase
            case '-': v%m := v%m - 1 ; endcase
            case '>': m := m + 1 ; endcase
            case '<': m := m - 1 ; endcase
            case '.': bfout(v%m) ; endcase
            case ',': v%m := bfin() ; endcase
            case '[':
                if v%m = 0 then i := scan(v, i, 1)
                if i = 0 then return
                endcase
            case ']':
                unless v%m = 0 do i := scan(v, i, -1)
                if i = 0 then return
                endcase
        $)
        i := i + 1
    $)
$)

let start() be
$(  let fname = vec 63
    let file = ?

    writes("Filename? ")
    reads(fname)
    file := findinput(fname)

    test file = 0 then
        writes("Cannot open file.*N")
    else
    $(  let mvec = getvec(maxvec())
        let m = readbf(file, mvec)
        run(mvec, m)
        freevec(mvec)
    $)
$)


with javascript_semantics
sequence escache = {}

function es_cat(integer p)
    if p>length(escache) and platform()!=JS then
        escache &= repeat(0,p-length(escache))
    end if
    integer category = escache[p]
    if not category then
        sequence f = filter(prime_factors(p+1,false,-1),">",3)
        category = 1
        if length(f) then
            category += max(apply(f,es_cat))
        end if
        escache[p] = category
    end if
    return category
end function

procedure categorise(integer n)
    sequence p = get_primes(n)
    printf(1,"First %,d primes:\n",n)
    atom t1 = time()
    sequence es = {}
    for i=1 to n do
        if time()>t1 then
            progress("categorising %d/%d...",{i,n})
            t1 = time()+1
        end if
        integer category = es_cat(p[i])
        while length(es)<category do
            es = append(es,{})
        end while
        es[category] &= p[i]
    end for
    progress("")
    for c=1 to length(es) do
        sequence e = es[c]
        if n=200 then
            printf(1,"Category %d: %s\n",{c,join(shorten(e,"primes",5,"%d"),",")})
        else
            printf(1,"Category %2d: %7d .. %-8d  Count: %d\n",{c,e[1],e[$],length(e)})
        end if
    end for
    printf(1,"\n")
end procedure

atom t0 = time()
categorise(200)
categorise(1e6)
?elapsed(time()-t0)


use Prime::Factor;
use Lingua::EN::Numbers;
use Math::Primesieve;
my $sieve = Math::Primesieve.new;

my %cat = 2 => 1, 3 => 1;

sub Erdös-Selfridge ($n) {
    my @factors = prime-factors $n + 1;
    my $category = max %cat{ @factors };
    unless %cat{ @factors[*-1] } {
        $category max= ( 1 + max %cat{ prime-factors 1 + @factors[*-1] } );
        %cat{ @factors[*-1] } = $category;
    }
    $category
}

my $upto = 200;

say "First { cardinal $upto } primes; Erdös-Selfridge categorized:";
.say for sort $sieve.n-primes($upto).categorize: &Erdös-Selfridge;

$upto = 1_000_000;

say "\nSummary of first { cardinal $upto } primes; Erdös-Selfridge categorized:";
printf "Category %2d: first: %9s  last: %10s  count: %s\n", ++$, |(.[0], .[*-1], .elems).map: &comma
for $sieve.n-primes($upto).categorize( &Erdös-Selfridge ).sort(+*.key)».value;


func factorial args: int a : returns: int {
    int factorial = a
    repeat int i = (a - 1) : i == 0 : i-- {
        factorial *= i
    }
    return factorial
}


def factorial(n)
        result = 1
	for i in range(1, n)
                result = result * i
        end
        return result
end


even n:
    = 0 % n 2

odd:
    not even

!. odd 0
!. even 0
!. odd 7
!. even 7


function fibonacci (n)
if n < 2
set result = n
else
set f0 = 0
set f1 = 1
set k = 2
while k <= n
set result = f0 + f1
set f0 = f1
set f1 = result
set k = k + 1
end while
end if
end function


' FB 1.05.0 Win64

Function factorial(n As Integer) As Integer
  If n < 1 Then Return 1
  Dim product As Integer = 1
  For i As Integer = 2 To n
    product *= i
  Next
  Return Product
End Function

Function binomial(n As Integer, k As Integer) As Integer
  If n < 0 OrElse k < 0 OrElse n <= k Then Return 1
  Dim product As Integer = 1
  For i As Integer = n - k + 1 To n
    Product *= i
  Next
  Return product \ factorial(k)
End Function

For n As Integer =  0 To 14
  For k As Integer = 0 To n
    Print Using "####"; binomial(n, k);
    Print" ";
  Next k
  Print
Next n

Print
Print "Press any key to quit"
Sleep


def
  choose( n, k ) | k < 0 or k > n = 0
  choose( n, 0 ) = 1
  choose( n, n ) = 1
  choose( n, k ) = product( [(n - i)/(i + 1) | i <- 0:min( k, n - k )] )

println( choose(5, 3) )
println( choose(60, 30) )


// [dependencies]
// primal = "0.3"

use std::collections::BTreeMap;

struct ErdosSelfridge {
    primes: Vec<usize>,
    category: Vec<u32>,
}

impl ErdosSelfridge {
    fn new(limit: usize) -> ErdosSelfridge {
        let mut es = ErdosSelfridge {
            primes: primal::Primes::all().take(limit).collect(),
            category: Vec::new(),
        };
        es.category.resize(es.primes.len(), 0);
        es
    }

    fn get_category(&mut self, index: usize) -> u32 {
        if self.category[index] != 0 {
            return self.category[index];
        }
        let mut max_category = 0;
        let mut n = self.primes[index] + 1;
        for i in 0.. {
            let p = self.primes[i];
            if p * p > n {
                break;
            }
            let mut count = 0;
            while n % p == 0 {
                n /= p;
                count += 1;
            }
            if count != 0 {
                let category = if p <= 3 { 1 } else { 1 + self.get_category(i) };
                max_category = std::cmp::max(max_category, category);
            }
        }
        if n > 1 {
            let i = self.get_index(n);
            let category = if n <= 3 { 1 } else { 1 + self.get_category(i) };
            max_category = std::cmp::max(max_category, category);
        }
        self.category[index] = max_category;
        max_category
    }

    fn get_index(&self, prime: usize) -> usize {
        self.primes.binary_search(&prime).unwrap()
    }

    fn get_primes_by_category(&mut self, limit: usize) -> BTreeMap<u32, Vec<usize>> {
        let mut primes_by_category: BTreeMap<u32, Vec<usize>> = BTreeMap::new();
        for i in 0..limit {
            let category = self.get_category(i);
            let prime = self.primes[i];
            if let Some(primes) = primes_by_category.get_mut(&category) {
                primes.push(prime);
            } else {
                let mut primes = Vec::new();
                primes.push(prime);
                primes_by_category.insert(category, primes);
            }
        }
        primes_by_category
    }
}

fn main() {
    let mut es = ErdosSelfridge::new(1000000);
    let primes_by_category = es.get_primes_by_category(200);
    println!("First 200 primes:");
    for (category, primes) in primes_by_category.iter() {
        println!("Category {}:", category);
        for i in 0..primes.len() {
            print!(
                "{:4}{}",
                primes[i],
                if (i + 1) % 15 == 0 { "\n" } else { " " }
            );
        }
        print!("\n\n");
    }
    println!("First 1,000,000 primes:");
    let primes_by_category = es.get_primes_by_category(1000000);
    for (category, primes) in primes_by_category.iter() {
        let first = primes[0];
        let count = primes.len();
        let last = primes[count - 1];
        println!(
            "Category {:2}: first = {:7}  last = {:8}  count = {}",
            category, first, last, count
        );
    }
}


func Erdös_Selfridge_class(n, s=1) is cached {
    var f = factor_exp(n+s)
    f.last.head > 3 || return 1
    f.map {|p| __FUNC__(p.head, s) }.max + 1
}

say "First two hundred primes; Erdös-Selfridge categorized:"
200.pn_primes.group_by(Erdös_Selfridge_class).sort_by{.to_i}.each_2d {|k,v|
    say "#{k} => #{v}"
}

say "\nSummary of first 10^6 primes; Erdös-Selfridge categorized:";
1e6.pn_primes.group_by(Erdös_Selfridge_class).sort_by{.to_i}.each_2d {|k,v|
    printf("Category %2d: first: %9s  last: %10s  count: %s\n", k, v.first, v.last, v.len)
}


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

var limit = (1e6.log * 1e6 * 1.2).floor  // should be more than enough
var primes = Int.primeSieve(limit)

var prevCats = {}

var cat // recursive
cat = Fn.new { |p|
    if (prevCats.containsKey(p)) return prevCats[p]
    var pf = Int.primeFactors(p+1)
    if (pf.all { |f| f == 2 || f == 3 }) return 1
    if (p > 2) {
        for (i in pf.count-1..1) {
            if (pf[i-1] == pf[i]) pf.removeAt(i)
        }
    }
    for (c in 2..11) {
        if (pf.all { |f| cat.call(f) < c }) {
            prevCats[p] = c
            return c
        }
    }
    return 12
}

var es = List.filled(12, null)
for (i in 0..11) es[i] = []

System.print("First 200 primes:\n ")
for (p in primes[0..199]) {
    var c = cat.call(p)
    es[c-1].add(p)
}
for (c in 1..6) {
    if (es[c-1].count > 0) {
        System.print("Category %(c):")
        System.print(es[c-1])
        System.print()
    }
}

System.print("First million primes:\n")
for (p in primes[200...1e6]) {
    var c = cat.call(p)
    es[c-1].add(p)
}
for (c in 1..12) {
    var e = es[c-1]
    if (e.count > 0) {
        Fmt.print("Category $-2d: First = $7d  Last = $8d  Count = $6d", c, e[0], e[-1], e.count)
    }
}


var factorial = function(number) {
	var i = 1;
	var result = 1;

	while(i <= number) {
		result *= i;
		i += 1;
	}

	return result;
};

$print(factorial(10));


using System;
using System.Console;

module Program
{
  Main() : void
  {
      WriteLine("Factorial of which number?");
      def number = long.Parse(ReadLine());
      WriteLine("Using Fold : Factorial of {0} is {1}", number, FactorialFold(number));
      WriteLine("Using Match: Factorial of {0} is {1}", number, FactorialMatch(number));
      WriteLine("Iterative  : Factorial of {0} is {1}", number, FactorialIter(number));
  }

  FactorialFold(number : long) : long
  {
      $[1L..number].FoldLeft(1L, _ * _ )
  }

  FactorialMatch(number : long) : long
  {
      |0L => 1L
      |n  => n * FactorialMatch(n - 1L)
  }

  FactorialIter(number : long) : long
  {
      mutable accumulator = 1L;
      for (mutable factor = 1L; factor <= number; factor++)
      {
          accumulator *= factor;
      }
      accumulator  //implicit return
  }
}


F euler(f, y0, a, b, h)
   V t = a
   V y = y0
   L t <= b
      print(‘#2.3 #2.3’.format(t, y))
      t += h
      y += h * f(t, y)

V newtoncooling = (time, temp) -> -0.07 * (temp - 20)

euler(newtoncooling, 100.0, 0.0, 100.0, 10.0)


' version 01-07-2018
' compile with: fbc -s console

Randomize Timer
Const As UInteger children = 100
Const As Double mutate_rate = 0.05

Function fitness(target As String, tmp As String) As UInteger

    Dim As UInteger x, f

    For x = 0 To Len(tmp) -1
        If tmp[x] = target[x] Then f += 1
    Next
    Return f

End Function

Sub mutate(tmp As String, chars As String, mute_rate As Double)

    If Rnd <= mute_rate Then
        tmp[Int(Rnd * Len(tmp))] = chars[Int(Rnd * Len(chars))]
    End If

End Sub

' ------=< MAIN >=------

Dim As String target = "METHINKS IT IS LIKE A WEASEL"
Dim As String chars  = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim As String parent, mutation()
Dim As UInteger x, iter, f, fit(), best_fit, parent_fit

For x = 1 To Len(target)
    parent += Chr(chars[Int(Rnd * Len(chars))])
Next

f = fitness(target, parent)
parent_fit = f
best_fit = f

Print "iteration  best fit   Parent"
Print "=========  ========   ============================"
Print Using "     ####      ####   ";iter; best_fit;
Print parent

Do
    iter += 1
    ReDim mutation(1 To children),fit(1 To children)

    For x = 1 To children
        mutation(x) = parent
        mutate(mutation(x), chars, mutate_rate)
    Next

    For x = 1 To children
        If mutation(x) <> parent Then
            f = fitness(target, mutation(x))
            If best_fit < f Then
                best_fit = f
                fit(x) = f
            Else
                fit(x) = parent_fit
            End If
        End If
    Next

    If best_fit > parent_fit Then
        For x = 1 To children
            If fit(x) = best_fit Then
                parent = mutation(x)
                Print Using "     ####      ####   ";iter; best_fit;
                Print parent
            End If
        Next
    End If

Loop Until parent = target

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


[ Even or odd
  ===========

  A program for the EDSAC

  Determines whether the number stored at
  address [email protected] is even or odd, and prints
  'E' or 'O' accordingly

  Works with Initial Orders 2 ]

       T56K   [ load point ]
       GK     [ base address ]

       [email protected]   [ print letter shift ]
       [email protected]   [ clear accumulator ]
       [email protected]   [ multiplier := n ]
       [email protected]   [ acc +:= mult AND 1 ]
       [email protected]   [ acc -:= 1 ]
       [email protected]    [ branch on negative ]
       [email protected]   [ print 'O' ]
       ZF     [ halt ]
[ 8 ]  [email protected]   [ print 'E' ]
       ZF     [ halt ]

[ 10 ] P0F    [ used to clear acc ]
[ 11 ] *F     [ letter shift character ]
[ 12 ] P0D    [ const: 1 ]
[ 13 ] EF     [ character 'E' ]
[ 14 ] OF     [ character 'O' ]
[ 15 ] P18D   [ number to test: 37 ]

       EZPF   [ branch to load point ]


--bit testing
if i.bit_and (1) = 0 then
	-- i is even
end

--built-in bit testing (uses bit_and)
if i.bit_test (0) then
	-- i is odd
end

--integer remainder (modulo)
if i \\ 2 = 0 then
	-- i is even
end


: fib ( n-m ) dup [ 0 = ] [ 1 = ] bi or if; [ 1- fib ] sip [ 2 - fib ] do + ;


package main
import "fmt"
import "math/big"

func main() {
  fmt.Println(new(big.Int).Binomial(5, 3))
  fmt.Println(new(big.Int).Binomial(60, 30))
}


;5 3 # Set up demo input
{),(;{*}*}:f; # Define a factorial function
[email protected]@/\@-f/


def factorial = { x ->
    assert x > -1
    x == 0 ? 1 : (1..x).inject(1G) { BigInteger product, BigInteger factor -> product *= factor }
}

def combinations = { n, k ->
    assert k >= 0
    assert n >= k
    factorial(n).intdiv(factorial(k)*factorial(n-k))
}


(ns brainfuck)

(def ^:dynamic *input*)

(def ^:dynamic *output*)

(defrecord Data [ptr cells])

(defn inc-ptr [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:ptr] inc))))

(defn dec-ptr [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:ptr] dec))))

(defn inc-cell [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:cells (:ptr data)] (fnil inc 0)))))

(defn dec-cell [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:cells (:ptr data)] (fnil dec 0)))))

(defn output-cell [next-cmd]
  (fn [data]
    (set! *output* (conj *output* (get (:cells data) (:ptr data) 0)))
    (next-cmd data)))

(defn input-cell [next-cmd]
  (fn [data]
    (let [[input & rest-input] *input*]
      (set! *input* rest-input)
      (next-cmd (update-in data [:cells (:ptr data)] input)))))

(defn if-loop [next-cmd loop-cmd]
  (fn [data]
    (next-cmd (loop [d data]
                (if (zero? (get (:cells d) (:ptr d) 0))
                  d
                  (recur (loop-cmd d)))))))

(defn terminate [data] data)

(defn split-cmds [cmds]
  (letfn [(split [[cmd & rest-cmds] loop-cmds]
                 (when (nil? cmd) (throw (Exception. "invalid commands: missing ]")))
                 (case cmd
                       \[ (let [[c l] (split-cmds rest-cmds)]
                            (recur c (str loop-cmds "[" l "]")))
                       \] [(apply str rest-cmds) loop-cmds]
                       (recur rest-cmds (str loop-cmds cmd))))]
    (split cmds "")))

(defn compile-cmds [[cmd & rest-cmds]]
  (if (nil? cmd)
    terminate
    (case cmd
          \> (inc-ptr (compile-cmds rest-cmds))
          \< (dec-ptr (compile-cmds rest-cmds))
          \+ (inc-cell (compile-cmds rest-cmds))
          \- (dec-cell (compile-cmds rest-cmds))
          \. (output-cell (compile-cmds rest-cmds))
          \, (input-cell (compile-cmds rest-cmds))
          \[ (let [[cmds loop-cmds] (split-cmds rest-cmds)]
               (if-loop (compile-cmds cmds) (compile-cmds loop-cmds)))
          \] (throw (Exception. "invalid commands: missing ["))
          (compile-cmds rest-cmds))))

(defn compile-and-run [cmds input]
  (binding [*input* input *output* []]
    (let [compiled-cmds (compile-cmds cmds)]
     (println (compiled-cmds (Data. 0 {}))))
    (println *output*)
    (println (apply str (map char *output*)))))


/* NetRexx */

options replace format comments java crossref savelog symbols nobinary

numeric digits 64 -- switch to exponential format when numbers become larger than 64 digits

say 'Input a number: \-'
say
do
  n_ = long ask -- Gets the number, must be an integer

  say n_'! =' factorial(n_) '(using iteration)'
  say n_'! =' factorial(n_, 'r') '(using recursion)'

  catch ex = Exception
    ex.printStackTrace
end

return

method factorial(n_ = long, fmethod = 'I') public static returns Rexx signals IllegalArgumentException

  if n_ < 0 then -
    signal IllegalArgumentException('Sorry, but' n_ 'is not a positive integer')

  select
    when fmethod.upper = 'R' then -
      fact = factorialRecursive(n_)
    otherwise -
      fact = factorialIterative(n_)
    end

  return fact

method factorialIterative(n_ = long) private static returns Rexx

  fact = 1
  loop i_ = 1 to n_
    fact = fact * i_
    end i_

  return fact

method factorialRecursive(n_ = long) private static returns Rexx

  if n_ > 1 then -
    fact = n_ * factorialRecursive(n_ - 1)
  else -
   fact = 1

  return fact


generic
   type Number is digits <>;
package Euler is
   type Waveform is array (Integer range <>) of Number;
   function Solve
            (  F      : not null access function (T, Y : Number) return Number;
               Y0     : Number;
               T0, T1 : Number;
               N      : Positive
            )  return Waveform;
end Euler;


#
Approximates y(t) in y'(t)=f(t,y) with y(a)=y0 and
t=a..b and the step size h.
#
PROC euler = (PROC(REAL,REAL)REAL f, REAL y0, a, b, h)REAL: (
    REAL y := y0,
         t := a;
    WHILE t < b DO
      printf(($g(-6,3)": "g(-7,3)l$, t, y));
      y +:= h * f(t, y);
      t +:= h
    OD;
    printf($"done"l$);
    y
);

# Example: Newton's cooling law #
PROC newton cooling law = (REAL time, t)REAL: (
    -0.07 * (t - 20)
);

main: (
   euler(newton cooling law, 100, 0, 100,  10)
)


package main

import (
    "fmt"
    "math/rand"
    "time"
)

var target = []byte("METHINKS IT IS LIKE A WEASEL")
var set = []byte("ABCDEFGHIJKLMNOPQRSTUVWXYZ ")
var parent []byte

func init() {
    rand.Seed(time.Now().UnixNano())
    parent = make([]byte, len(target))
    for i := range parent {
        parent[i] = set[rand.Intn(len(set))]
    }
}

// fitness:  0 is perfect fit.  greater numbers indicate worse fit.
func fitness(a []byte) (h int) {
    // (hamming distance)
    for i, tc := range target {
        if a[i] != tc {
            h++
        }
    }
    return
}

// set m to mutation of p, with each character of p mutated with probability r
func mutate(p, m []byte, r float64) {
    for i, ch := range p {
        if rand.Float64() < r {
            m[i] = set[rand.Intn(len(set))]
        } else {
            m[i] = ch
        }
    }
}

func main() {
    const c = 20 // number of times to copy and mutate parent

    copies := make([][]byte, c)
    for i := range copies {
        copies[i] = make([]byte, len(parent))
    }

    fmt.Println(string(parent))
    for best := fitness(parent); best > 0; {
        for _, cp := range copies {
            mutate(parent, cp, .05)
        }
        for _, cp := range copies {
            fm := fitness(cp)
            if fm < best {
                best = fm
                copy(parent, cp)
                fmt.Println(string(parent))
            }
        }
    }
}


defmodule RC do
  import Integer

  def even_or_odd(n) when is_even(n), do: "#{n} is even"
  def even_or_odd(n)                , do: "#{n} is odd"
      # In second "def", the guard clauses of "is_odd(n)" is unnecessary.

  # Another definition way
  def even_or_odd2(n) do
    if is_even(n), do: "#{n} is even", else: "#{n} is odd"
  end
end

Enum.each(-2..3, fn n -> IO.puts RC.even_or_odd(n) end)


(require 'cl-lib)

(defun even-or-odd-p (n)
  (if (cl-evenp n) 'even 'odd))

(defun even-or-odd-p (n)
 (if (zerop (% n 2)) 'even 'odd))

(message "%d is %s" 3 (even-or-oddp 3))
(message "%d is %s" 2 (even-or-oddp 2))


/*REXX program calculates the  Nth  Fibonacci number,   N   can be  zero  or  negative. */
numeric digits 210000                            /*be able to handle ginormous numbers. */
parse  arg  x y .                                /*allow a  single number  or  a range. */
if x=='' | x==","  then do;  x=-40;  y=+40;  end /*No input?  Then use range -40 ──► +40*/
if y=='' | y==","  then y=x                      /*if only one number, display   fib(X).*/
w= max(length(x),  length(y) )                   /*W:  used for making formatted output.*/
fw= 10                                           /*Minimum maximum width. Sounds ka─razy*/
      do j=x  to y;          q= fib(j)           /*process all of the Fibonacci requests*/
      L= length(q)                               /*obtain the length (decimal digs) of Q*/
      fw= max(fw, L)                             /*fib number length, or the max so far.*/
      say 'Fibonacci('right(j,w)") = "  right(q,fw)                   /*right justify Q.*/
      if L>10  then  say    'Fibonacci('right(j, w)") has a length of"     L
      end   /*j*/                                /* [↑]  list a Fib. sequence of  x──►y */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fib:  procedure; parse arg n;        an= abs(n)  /*use  │n│   (the absolute value of N).*/
      a= 0;    b= 1;   if an<2  then return an   /*handle two special cases: zero & one.*/
                                                 /* [↓]   this method is non─recursive. */
         do k=2  to an;   $= a+b;   a= b;   b= $ /*sum  the numbers  up to   │n│        */
         end   /*k*/                             /* [↑]  (only positive Fibs nums used).*/
                                                 /* [↓]  an//2   [same as]   (an//2==1).*/
      if n>0 | an//2   then  return  $           /*Positive or even?   Then return sum. */
                             return -$           /*Negative and odd? Return negative sum*/


10 REM BINOMIAL CALCULATOR
20 INPUT "N? ", N
30 INPUT "P? ", P
40 GOSUB 70
50 PRINT C
60 END
70 C = 0
80 IF N < 0 OR P<0 OR P > N THEN RETURN
90 IF P < N\2 THEN P = N - P
100 C = 1
110 FOR I = N TO P+1 STEP -1
120 C=C*I
130 NEXT I
140 FOR I = 1 TO N-P
150 C=C/I
160 NEXT I
170 RETURN


choose :: (Integral a) => a -> a -> a
choose n k = product [k+1..n] `div` product [1..n-k]


WRITE(Messagebox) BinomCoeff( 5, 3) ! displays 10

FUNCTION factorial( n )
   factorial = 1
   DO i = 1, n
      factorial = factorial * i
   ENDDO
END

FUNCTION BinomCoeff( n, k )
   BinomCoeff = factorial(n)/factorial(n-k)/factorial(k)
END


> (define (factorial n) (exp (gammaln (+ n 1))))
(lambda (n) (exp (gammaln (+ n 1))))
> (factorial 4)
24


fact is recur [ 0 =, 1 first, pass, product, -1 +]


begin % Euler's method %
    % Approximates y(t) in y'(t)=f(t,y) with y(a)=y0 and t=a..b and the step size h. %
    real procedure euler ( real procedure f; real value y0, a, b, h ) ;
    begin
        real y, t;
        y := y0;
        t := a;
        while t < b do begin
            write( r_format := "A", r_w := 8, r_d := 4, s_w := 0, t, ": ", y );
            y := y + ( h * f(t, y) );
            t := t + h
        end while_t_lt_b ;
        write( "done" );
        y
    end euler ;

    % Example: Newton's cooling law %
    real procedure newtonCoolingLaw ( real value time, t ) ; -0.07 * (t - 20);

    euler( newtonCoolingLaw, 100, 0, 100, 10 )
end.


#include <stdio.h>
#include <math.h>

typedef double (*deriv_f)(double, double);
#define FMT " %7.3f"

void ivp_euler(deriv_f f, double y, int step, int end_t)
{
	int t = 0;

	printf(" Step %2d: ", (int)step);
	do {
		if (t % 10 == 0) printf(FMT, y);
		y += step * f(t, y);
	} while ((t += step) <= end_t);
	printf("\n");
}

void analytic()
{
	double t;
	printf("    Time: ");
	for (t = 0; t <= 100; t += 10) printf(" %7g", t);
	printf("\nAnalytic: ");

	for (t = 0; t <= 100; t += 10)
		printf(FMT, 20 + 80 * exp(-0.07 * t));
	printf("\n");
}

double cooling(double t, double temp)
{
	return -0.07 * (temp - 20);
}

int main()
{
	analytic();
	ivp_euler(cooling, 100, 2, 100);
	ivp_euler(cooling, 100, 5, 100);
	ivp_euler(cooling, 100, 10, 100);

	return 0;
}


%% Implemented by Arjun Sunel
-module(even_odd).
-export([main/0]).

main()->
	test(8).

test(N) ->
	if (N rem 2)==1 ->
		io:format("odd\n");
	true ->
		io:format("even\n")
	end.


PROGRAM ODD_EVEN

! works for -2^15 <= n% < 2^15

FUNCTION ISODD%(N%)
      ISODD%=(N% AND 1)<>0
END FUNCTION

! works for -2^38 <= n# <= 2^38
FUNCTION ISODD#(N#)
      ISODD#=N#<>2*INT(N#/2)
END FUNCTION

BEGIN
  IF ISODD%(14) THEN PRINT("14 is odd") ELSE PRINT("14 is even") END IF
  IF ISODD%(15) THEN PRINT("15 is odd") ELSE PRINT("15 is even") END IF
  IF ISODD#(9876543210) THEN PRINT("9876543210 is odd") ELSE PRINT("9876543210 is even") END IF
  IF ISODD#(9876543211) THEN PRINT("9876543211 is odd") ELSE PRINT("9876543211 is even") END IF
END PROGRAM


give n
x = fib(n)
see n + " Fibonacci is : " + x

func fib nr if nr = 0 return 0 ok
            if nr = 1 return 1 ok
            if nr > 1 return fib(nr-1) + fib(nr-2) ok


link math, factors

procedure main()
write("choose(5,3)=",binocoef(5,3))
end


100 PROGRAM "Binomial.bas"
110 PRINT "Binomial (5,3) =";BINOMIAL(5,3)
120 DEF BINOMIAL(N,K)
130   LET R=1:LET D=N-K
140   IF D>K THEN LET K=D:LET D=N-K
150   DO WHILE N>K
160     LET R=R*N:LET N=N-1
170     DO WHILE D>1 AND MOD(R,D)=0
180       LET R=R/D:LET D=D-1
190     LOOP
200   LOOP
210   LET BINOMIAL=R
220 END DEF


public class Binomial {

    // precise, but may overflow and then produce completely incorrect results
    private static long binomialInt(int n, int k) {
        if (k > n - k)
            k = n - k;

        long binom = 1;
        for (int i = 1; i <= k; i++)
            binom = binom * (n + 1 - i) / i;
        return binom;
    }

    // same as above, but with overflow check
    private static Object binomialIntReliable(int n, int k) {
        if (k > n - k)
            k = n - k;

        long binom = 1;
        for (int i = 1; i <= k; i++) {
            try {
                binom = Math.multiplyExact(binom, n + 1 - i) / i;
            } catch (ArithmeticException e) {
                return "overflow";
            }
        }
        return binom;
    }

    // using floating point arithmetic, larger numbers can be calculated,
    // but with reduced precision
    private static double binomialFloat(int n, int k) {
        if (k > n - k)
            k = n - k;

        double binom = 1.0;
        for (int i = 1; i <= k; i++)
            binom = binom * (n + 1 - i) / i;
        return binom;
    }

    // slow, hard to read, but precise
    private static BigInteger binomialBigInt(int n, int k) {
        if (k > n - k)
            k = n - k;

        BigInteger binom = BigInteger.ONE;
        for (int i = 1; i <= k; i++) {
            binom = binom.multiply(BigInteger.valueOf(n + 1 - i));
            binom = binom.divide(BigInteger.valueOf(i));
        }
        return binom;
    }

    private static void demo(int n, int k) {
        List<Object> data = Arrays.asList(
                n,
                k,
                binomialInt(n, k),
                binomialIntReliable(n, k),
                binomialFloat(n, k),
                binomialBigInt(n, k));

        System.out.println(data.stream().map(Object::toString).collect(Collectors.joining("\t")));
    }

    public static void main(String[] args) {
        demo(5, 3);
        demo(1000, 300);
    }
}


(ns brainfuck)

(def ^:dynamic *input*)

(def ^:dynamic *output*)

(defrecord Data [ptr cells])

(defn inc-ptr [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:ptr] inc))))

(defn dec-ptr [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:ptr] dec))))

(defn inc-cell [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:cells (:ptr data)] (fnil inc 0)))))

(defn dec-cell [next-cmd]
  (fn [data]
    (next-cmd (update-in data [:cells (:ptr data)] (fnil dec 0)))))

(defn output-cell [next-cmd]
  (fn [data]
    (set! *output* (conj *output* (get (:cells data) (:ptr data) 0)))
    (next-cmd data)))

(defn input-cell [next-cmd]
  (fn [data]
    (let [[input & rest-input] *input*]
      (set! *input* rest-input)
      (next-cmd (update-in data [:cells (:ptr data)] input)))))

(defn if-loop [next-cmd loop-cmd]
  (fn [data]
    (next-cmd (loop [d data]
                (if (zero? (get (:cells d) (:ptr d) 0))
                  d
                  (recur (loop-cmd d)))))))

(defn terminate [data] data)

(defn split-cmds [cmds]
  (letfn [(split [[cmd & rest-cmds] loop-cmds]
                 (when (nil? cmd) (throw (Exception. "invalid commands: missing ]")))
                 (case cmd
                       \[ (let [[c l] (split-cmds rest-cmds)]
                            (recur c (str loop-cmds "[" l "]")))
                       \] [(apply str rest-cmds) loop-cmds]
                       (recur rest-cmds (str loop-cmds cmd))))]
    (split cmds "")))

(defn compile-cmds [[cmd & rest-cmds]]
  (if (nil? cmd)
    terminate
    (case cmd
          \> (inc-ptr (compile-cmds rest-cmds))
          \< (dec-ptr (compile-cmds rest-cmds))
          \+ (inc-cell (compile-cmds rest-cmds))
          \- (dec-cell (compile-cmds rest-cmds))
          \. (output-cell (compile-cmds rest-cmds))
          \, (input-cell (compile-cmds rest-cmds))
          \[ (let [[cmds loop-cmds] (split-cmds rest-cmds)]
               (if-loop (compile-cmds cmds) (compile-cmds loop-cmds)))
          \] (throw (Exception. "invalid commands: missing ["))
          (compile-cmds rest-cmds))))

(defn compile-and-run [cmds input]
  (binding [*input* input *output* []]
    (let [compiled-cmds (compile-cmds cmds)]
     (println (compiled-cmds (Data. 0 {}))))
    (println *output*)
    (println (apply str (map char *output*)))))


using System;

namespace prog
{
	class MainClass
	{
		const float T0 = 100f;
		const float TR = 20f;
		const float k = 0.07f;
		readonly static float[] delta_t = {2.0f,5.0f,10.0f};
		const int n = 100;

		public delegate float func(float t);
		static float NewtonCooling(float t)
		{
			return -k * (t-TR);
		}

		public static void Main (string[] args)
		{
			func f = new func(NewtonCooling);
			for(int i=0; i<delta_t.Length; i++)
			{
				Console.WriteLine("delta_t = " + delta_t[i]);
				Euler(f,T0,n,delta_t[i]);
			}
		}

		public static void Euler(func f, float y, int n, float h)
		{
			for(float x=0; x<=n; x+=h)
			{
				Console.WriteLine("\t" + x + "\t" + y);
				y += h * f(y);
			}
		}
	}
}


#include <iomanip>
#include <iostream>

typedef double F(double,double);

/*
Approximates y(t) in y'(t)=f(t,y) with y(a)=y0 and
t=a..b and the step size h.
*/
void euler(F f, double y0, double a, double b, double h)
{
    double y = y0;
    for (double t = a; t < b; t += h)
    {
        std::cout << std::fixed << std::setprecision(3) << t << " " << y << "\n";
        y += h * f(t, y);
    }
    std::cout << "done\n";
}

// Example: Newton's cooling law
double newtonCoolingLaw(double, double t)
{
    return -0.07 * (t - 20);
}

int main()
{
    euler(newtonCoolingLaw, 100, 0, 100,  2);
    euler(newtonCoolingLaw, 100, 0, 100,  5);
    euler(newtonCoolingLaw, 100, 0, 100, 10);
}


import System.Random
import Control.Monad
import Data.List
import Data.Ord
import Data.Array

showNum :: (Num a, Show a) => Int -> a -> String
showNum w = until ((>w-1).length) (' ':) . show

replace :: Int -> a -> [a] -> [a]
replace n c ls = take (n-1) ls ++ [c] ++ drop n ls

target = "METHINKS IT IS LIKE A WEASEL"
pfit = length target
mutateRate = 20
popsize = 100
charSet = listArray (0,26) $ ' ': ['A'..'Z'] :: Array Int Char

fitness = length . filter id . zipWith (==) target

printRes i g = putStrLn $
     "gen:" ++ showNum 4 i ++ "  "
     ++ "fitn:" ++ showNum 4  (round $ 100 * fromIntegral s / fromIntegral pfit ) ++ "%  "
     ++ show g
    where s = fitness g

mutate :: [Char] -> Int -> IO [Char]
mutate g mr = do
  let r = length g
  chances <- replicateM r $ randomRIO (1,mr)
  let pos = elemIndices 1 chances
  chrs <- replicateM (length pos) $ randomRIO (bounds charSet)
  let nchrs = map (charSet!) chrs
  return $ foldl (\ng (p,c) -> replace (p+1) c ng) g (zip pos nchrs)

evolve :: [Char] -> Int -> Int -> IO ()
evolve parent gen mr = do
  when ((gen-1) `mod` 20 == 0) $ printRes (gen-1) parent
  children <- replicateM popsize (mutate parent mr)
  let child = maximumBy (comparing fitness) (parent:children)
  if fitness child == pfit then printRes gen child
                           else evolve child (succ gen) mr

main = do
  let r = length target
  genes <- replicateM r $ randomRIO (bounds charSet)
  let parent = map (charSet!) genes
  evolve parent 1 mutateRate


include std/math.e

for i = 1 to 10 do
        ? {i, is_even(i)}
end for


Fibonacci takes Number
  FNow is 0
  FNext is 1
  While FNow is less than Number
    Say FNow
    Put FNow into Temp
    Put FNow into FNext
    Put FNext plus Temp into FNext

Say Fibonacci taking 1000 (prints out highest number in Fibonacci sequence less than 1000)


function binom(n, k) {
    var coeff = 1;
    var i;

    if (k < 0 || k > n) return 0;

    for (i = 0; i < k; i++) {
        coeff = coeff * (n - i) / (i + 1);
    }

    return coeff;
}

console.log(binom(5, 3));


# nCk assuming n >= k
def binomial(n; k):
  if k > n / 2 then binomial(n; n-k)
  else reduce range(1; k+1) as $i (1; . * (n - $i + 1) / $i)
  end;

def task:
  .[0] as $n | .[1] as $k
  | "\($n) C \($k) = \(binomial( $n; $k) )";
;

([5,3], [100,2], [ 33,17]) | task


[ dup 1 > [ dup 1 - factorial * ] when ] 'factorial ;

( test )
4 factorial . ( => 24 )
10 factorial . ( => 3628800 )


(defun factorial (n)
  (do ((x n (* x n)))
      ((= n 1) x)
    (setq n (1- n))))


import printer.formatter as pf;

euler(f, y, a, b, h) {
    while (a < b) {
        println(pf.rightAligned(2, a), " ", y);
        a += h;
        y += h * f(y);
    }
}

main() {
    for (i in [2.0, 5.0, 10.0]) {
        println("\nFor delta = ", i, ":");
        euler((temp) => -0.07 * (temp - 20), 100.0, 0.0, 100.0, i);
    }
}


(ns newton-cooling
  (:gen-class))

(defn euler [f y0 a b h]
  "Euler's Method.
  Approximates y(time) in y'(time)=f(time,y) with y(a)=y0 and t=a..b and the step size h."
  (loop [t a
         y y0
         result []]
    (if (<= t b)
        (recur (+ t h) (+ y (* (f (+ t h) y) h)) (conj result [(double t) (double y)]))
        result)))

(defn newton-coolling [t temp]
  "Newton's cooling law, f(t,T) = -0.07*(T-20)"
  (* -0.07 (- temp 20)))

; Run for case h = 10
(println "Example output")
(doseq [q (euler newton-coolling 100 0 100 10)]
  (println (apply format "%.3f %.3f" q)))


global target, chars, parent, C, M, current_fitness

procedure fitness(s)
	fit := 0
	#Increment the fitness for every position in the string s that matches the target
	every i := 1 to *target & s[i] == target[i] do fit +:= 1
	return fit
end

procedure mutate(s)
	#If a random number between 0 and 1 is inside the bounds of mutation randomly alter a character in the string
	if (?0 <= M) then ?s := ?chars
	return s
end

procedure generation()
	population := [ ]
	next_parent := ""
	next_fitness := -1

	#Create the next population
	every 1 to C do push(population, mutate(parent))
	#Find the member of the population with highest fitness, or use the last one inspected
	every x := !population & (xf := fitness(x)) > next_fitness do {
		next_parent := x
		next_fitness := xf
	}

	parent := next_parent

	return next_fitness
end

procedure main()
	target := "METHINKS IT IS LIKE A WEASEL"			#Our target string
	chars := &ucase ++ " "						#Set of usable characters
	parent := "" & every 1 to *target do parent ||:= ?chars		#The universal common ancestor!
	current_fitness := fitness(parent)				#The best fitness we have so far

	C := 50		#Population size in each generation
	M := 0.5	#Mutation rate per individual in a generation

	gen := 1
	#Until current fitness reaches a score of perfect match with the target string keep generating new populations
	until ((current_fitness := generation()) = *target) do {
                write(gen || " " || current_fitness || " " || parent)
                gen +:= 1
	}
	write("At generation " || gen || " we found a string with perfect fitness at " || current_fitness || " reading: " || parent)
end


( scratchpad ) 20 even? .
t
( scratchpad ) 35 even? .
f
( scratchpad ) 20 odd? .
f
( scratchpad ) 35 odd? .
t


def fib(n)
  if n < 2
    n
  else
    prev, fib = 0, 1
    (n-1).times do
      prev, fib = fib, fib + prev
    end
    fib
  end
end

p (0..10).map { |i| fib(i) }


// version 2.0

fun binomial(n: Int, k: Int) = when {
    n < 0 || k < 0 -> throw IllegalArgumentException("negative numbers not allowed")
    n == k         -> 1L
    else           -> {
        val kReduced = min(k, n - k)    // minimize number of steps
        var result = 1L
        var numerator = n
        var denominator = 1
        while (denominator <= kReduced)
            result = result * numerator-- / denominator++
        result
    }
}

fun main(args: Array<String>) {
    for (n in 0..14) {
        for (k in 0..n)
            print("%4d ".format(binomial(n, k)))
        println()
    }
}


tape = cluster is new, left, right, get_cell, set_cell
    ac = array[char]
    rep = record [
        cells: ac,
        index: int
    ]

    new = proc () returns (cvt)
        t: rep := rep${
            cells: ac$predict(0, 30000),
            index: 0
        }
        ac$addh(t.cells, '\000')
        return(t)
    end new

    left = proc (t: cvt)
        t.index := t.index - 1
        if t.index < ac$low(t.cells) then ac$addl(t.cells, '\000') end
    end left

    right = proc (t: cvt)
        t.index := t.index + 1
        if t.index > ac$high(t.cells) then ac$addh(t.cells, '\000') end
    end right

    get_cell = proc (t: cvt) returns (int)
        return (char$c2i(t.cells[t.index]) // 256)
    end get_cell

    set_cell = proc (t: cvt, i: int)
        t.cells[t.index] := char$i2c(i // 256)
    end set_cell
end tape

program = cluster is parse, fetch, jump
    loop_jump = struct[from, to: int]
    alj = array[loop_jump]
    slj = sequence[loop_jump]

    rep = struct [
        loops: slj,
        code: string
    ]

    parse = proc (s: string) returns (cvt) signals (bad_loops)
        ac = array[char]

        prog: ac := ac$predict(1, string$size(s))
        loops: alj := alj$[]
        loop_stack: array[int] := array[int]$[]

        for c: char in string$chars(s) do
            if string$indexc(c, "+-<>,.[]") = 0 then continue end
            ac$addh(prog, c)
            if c = '[' then
                array[int]$addh(loop_stack, ac$high(prog))
            elseif c = ']' then
                here: int := ac$high(prog)
                there: int := array[int]$remh(loop_stack)
                    except when bounds: signal bad_loops end
                alj$addh(loops, loop_jump${from: here, to: there})
                alj$addh(loops, loop_jump${from: there, to: here})
            end
        end

        if ~array[int]$empty(loop_stack) then signal bad_loops end
        return (rep${loops: slj$a2s(loops), code: string$ac2s(prog)})
    end parse

    fetch = proc (p: cvt, i: int) returns (char) signals (bounds)
        return (p.code[i]) resignal bounds
    end fetch

    jump = proc (p: cvt, i: int) returns (int) signals (not_found)
        for j: loop_jump in slj$elements(p.loops) do
            if j.from = i then return (j.to) end
        end
        signal not_found
    end jump
end program

brainf = cluster is make, run
    rep = struct [
        prog: program,
        mem: tape,
        inp, out: stream
    ]

    make = proc (p: program, i, o: stream) returns (cvt)
        return (rep${
            prog: p,
            inp: i,
            out: o,
            mem: tape$new()
        })
    end make

    read = proc (p: rep) returns (int)
        return (char$c2i(stream$getc(p.inp)))
        except when end_of_file:
            return (0)
        end
    end read

    write = proc (p: rep, c: int)
        stream$putc(p.out, char$i2c(c))
    end write

    run = proc (p: cvt)
        ip: int := 1
        while true do
            op: char := p.prog[ip] except when bounds: break end
            if     op = '+' then p.mem.cell := p.mem.cell + 1
            elseif op = '-' then p.mem.cell := p.mem.cell - 1
            elseif op = '>' then tape$right(p.mem)
            elseif op = '<' then tape$left(p.mem)
            elseif op = ',' then p.mem.cell := read(p)
            elseif op = '.' then write(p, p.mem.cell)
            elseif op = '[' cand p.mem.cell = 0 then
                ip := program$jump(p.prog, ip)
            elseif op = ']' cand p.mem.cell ~= 0 then
                ip := program$jump(p.prog, ip)
            end
            ip := ip + 1
        end
    end run
end brainf

read_whole_stream = proc (s: stream) returns (string)
    chars: array[char] := array[char]$predict(1, 4096)
    while true do
        array[char]$addh(chars, stream$getc(s))
        except when end_of_file: break end
    end
    return (string$ac2s(chars))
end read_whole_stream

start_up = proc ()
    pi: stream := stream$primary_input()
    po: stream := stream$primary_output()

    stream$puts(po, "Filename? ")
    fname: file_name := file_name$parse(stream$getl(pi))
    file: stream := stream$open(fname, "read")
    code: string := read_whole_stream(file)
    stream$close(file)

    prog: program := program$parse(code)
    interp: brainf := brainf$make(prog, pi, po)
    brainf$run(interp)
end start_up


pointer_alpha = 1/0
pointer_numeric = 1/0
tape_behind = ''
tape_ahead = 1/0
tape_pos = 0 # only for debugging
array_behind = 1/0
array_ahead = ''
set_tape_ahead = array_ahead
array_ahead = 1/0
#
shift
  comefrom if array_ahead is array_ahead
  cdr = 1/0
  cdr = array_ahead
  shift_tail = cdr
  new_cell
    comefrom shift if shift_tail is ''
    itoa = 0
    shift_tail = itoa
  car = 1/0
  car = array_ahead
  array_behind = car array_behind
  done = shift_tail
  array_ahead = shift_tail
  comefrom shift if array_ahead is done

set_pointer_alpha = 1/0
set_pointer_alpha
  comefrom if set_pointer_alpha
  atoi = set_pointer_alpha
  cdr = tape_ahead
  set_tape_ahead = set_pointer_alpha cdr
  set_pointer_alpha = 1/0

set_tape_ahead = 1/0
set_pointer_vals
  comefrom if set_tape_ahead
  tape_ahead = set_tape_ahead
  car = tape_ahead
  pointer_alpha = car
  atoi = pointer_alpha
  pointer_numeric = atoi
  set_tape_ahead = 1/0

pointer_change = 1/0
change_pointer_val
  comefrom if pointer_change
  car = tape_ahead
  cdr = tape_ahead
  itoa = pointer_numeric + pointer_change
  set_tape_ahead = itoa cdr
  pointer_change = 1/0

file = 0 # initialize to something other than undefined so jump from file works when read fails
read_path = argv
error_reading_program
  comefrom file if file + 0 is 0
  'Error: cannot read Brainfuck program at "' read_path '"'
  ''

program_loaded
  comefrom file if file is file
  program_behind = ''
  program_ahead = file

  run
    comefrom program_loaded
    opcode = 1/0
    opcode_numeric = 1/0
    in_buffer = '' # cf0x10 stdin is line-buffered
    jumping = 0
    moving = 1
    comefrom run

    comefrom execute if opcode_numeric is 0
    ''
    execute
      comefrom run if moving
      # can be useful for debugging:
      #program_ahead moving ':' jumping '@' tape_pos ':' pointer_numeric
      car = program_ahead
      atoi = car
      opcode_numeric = atoi
      opcode = car
      opcode = 1/0

      #

    program_forward
      comefrom execute if moving > 0
      array_behind = program_behind
      array_ahead = 1/0
      array_ahead = program_ahead
      program_behind = array_behind
      program_ahead = array_ahead

      forward_jump
        comefrom execute if opcode is '['

        jump
          comefrom forward_jump if pointer_numeric is 0
          jumping = jumping + 1
          moving = 1
        match_brace
          comefrom forward_jump if jumping < 0
          jumping = jumping + 1
          stop_jump
            comefrom match_brace if jumping is 0
            moving = 1

    program_backward
      comefrom execute if moving < 0
      array_behind = program_ahead
      array_ahead = 1/0
      array_ahead = program_behind
      program_behind = array_ahead
      program_ahead = array_behind

      backward_jump
        comefrom execute if opcode is ']'

        jump
          comefrom backward_jump if pointer_numeric > 0
          jumping = jumping - 1
          moving = -1
        match_brace
          comefrom backward_jump if jumping > 0
          jumping = jumping - 1
          stop_jump
            comefrom match_brace if jumping is 0
            moving = 1

    op
      comefrom execute if opcode

      moving = 1
      do_op = opcode
      comefrom op if jumping
      #
      forward
        comefrom op if do_op is '>'
        tape_pos = tape_pos + 1
        array_ahead = 1/0
        array_behind = tape_behind
        array_ahead = tape_ahead
        tape_behind = array_behind
        set_tape_ahead = array_ahead
      backward
        comefrom op if do_op is '<'
        tape_pos = tape_pos - 1
        array_ahead = 1/0
        array_behind = tape_ahead
        array_ahead = tape_behind
        tape_behind = array_ahead
        set_tape_ahead = array_behind

      increment
        comefrom op if do_op is '+'
        pointer_change = 1
      decrement
        comefrom op if do_op is '-'
        pointer_change = -1

      print
        comefrom op if do_op is '.'
        pointer_alpha...
      read
        comefrom op if do_op is ','
        #
        cdr = 1/0
        cdr = in_buffer
        car = in_buffer
        set_pointer_alpha = car
        cdr = in_buffer
        in_buffer = cdr
        comefrom stdin if stdin + 0 is 0
        #
        block_for_input
          comefrom read if cdr is ''
          stdin = ''
          in_buffer = stdin
          cdr = in_buffer
          comefrom stdin if stdin + 0 is 0


MODULE Factorial;
IMPORT
  Out;

VAR
  i: INTEGER;

  PROCEDURE Iterative(n: LONGINT): LONGINT;
  VAR
    i, r: LONGINT;
  BEGIN
    ASSERT(n >= 0);
    r := 1;
    FOR i := n TO 2 BY -1 DO
      r := r * i
    END;
    RETURN r
  END Iterative;

  PROCEDURE Recursive(n: LONGINT): LONGINT;
  VAR
    r: LONGINT;
  BEGIN
    ASSERT(n >= 0);
    r := 1;
    IF n > 1 THEN
      r := n * Recursive(n - 1)
    END;
    RETURN r
  END Recursive;

BEGIN
  FOR i := 0 TO 9 DO
    Out.String("Iterative ");Out.Int(i,0);Out.String('! =');Out.Int(Iterative(i),0);Out.Ln;
  END;
  Out.Ln;
  FOR i := 0 TO 9 DO
    Out.String("Recursive ");Out.Int(i,0);Out.String('! =');Out.Int(Recursive(i),0);Out.Ln;
  END
END Factorial.


       DELEGATE-ID func.
       PROCEDURE DIVISION USING VALUE t AS FLOAT-LONG
           RETURNING ret AS FLOAT-LONG.
       END DELEGATE.

       CLASS-ID. MainClass.

       78  T0                     VALUE 100.0.
       78  TR                     VALUE 20.0.
       78  k                      VALUE 0.07.

       01  delta-t                INITIALIZE ONLY STATIC
                                  FLOAT-LONG OCCURS 3 VALUES 2.0, 5.0, 10.0.

       78  n                      VALUE 100.

       METHOD-ID NewtonCooling STATIC.
       PROCEDURE DIVISION USING VALUE t AS FLOAT-LONG
               RETURNING ret AS FLOAT-LONG.
           COMPUTE ret = - k * (t - TR)
       END METHOD.

       METHOD-ID Main STATIC.
           DECLARE f AS TYPE func
           SET f TO METHOD self::NewtonCooling

           DECLARE delta-t-len AS BINARY-LONG
           MOVE delta-t::Length TO delta-t-len
           PERFORM VARYING i AS BINARY-LONG FROM 1 BY 1
                   UNTIL i > delta-t-len
               DECLARE elt AS FLOAT-LONG = delta-t (i)
               INVOKE TYPE Console::WriteLine("delta-t = {0:F4}", elt)
               INVOKE self::Euler(f, T0, n, elt)
           END-PERFORM
       END METHOD.

       METHOD-ID Euler STATIC.
       PROCEDURE DIVISION USING VALUE f AS TYPE func, y AS FLOAT-LONG,
               n AS BINARY-LONG, h AS FLOAT-LONG.
           PERFORM VARYING x AS BINARY-LONG FROM 0 BY h UNTIL x >= n
               INVOKE TYPE Console::WriteLine("x = {0:F4}, y = {1:F4}", x, y)
               COMPUTE y = y + h * RUN f(y)
           END-PERFORM
       END METHOD.
       END CLASS.


;; 't' usually means "true" in CL, but we need 't' here for time/temperature.
(defconstant true 'cl:t)
(shadow 't)

;; Approximates y(t) in y'(t)=f(t,y) with y(a)=y0 and t=a..b and the step size h.
(defun euler (f y0 a b h)

  ;; Set the initial values and increments of the iteration variables.
  (do ((t a  (+ t h))
       (y y0 (+ y (* h (funcall f t y)))))

      ;; End the iteration when t reaches the end b of the time interval.
      ((>= t b) 'DONE)

      ;; Print t and y(t) at every step of the do loop.
      (format true "~6,3F  ~6,3F~%" t y)))

;; Example: Newton's cooling law, f(t,T) = -0.07*(T-20)
(defun newton-cooling (time T) (* -0.07 (- T 20)))

;; Generate the data for all three step sizes (2,5 and 10).
(euler #'newton-cooling 100 0 100  2)
(euler #'newton-cooling 100 0 100  5)
(euler #'newton-cooling 100 0 100 10)


CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
NPROG=:   100                            NB. number of progeny (C)
MRATE=:   0.05                           NB. mutation rate

create  =: ([email protected]$&$ { ])&CHARSET           NB. creates random list from charset of same shape as y
fitness =: +/@:~:"1
copy    =: # ,:
mutate  =: &(>: $ [email protected]$ 0:)(`(,: create))} NB. adverb
select  =: ] {~ (i. <./)@:fitness        NB. select fittest member of population

nextgen =: select ] , [: MRATE mutate NPROG copy ]
while   =: conjunction def '(] , (u {:))^:(v {:)^:_ ,:'

evolve=: nextgen while (0 < fitness) create


<v"Please enter a number:"a
 >l0)?!vo     v          <                        v    o<
^      >i:a=?v>i:a=?v$a*+^>"The number is even."ar>l0=?!^>
             >      >2%0=?^"The number is odd."ar ^


for i = 0 to 10
 print i;" ";fibR(i);" ";fibI(i)
next i
end

 function fibR(n)
 if n < 2 then fibR = n else fibR = fibR(n-1) + fibR(n-2)
 end function

 function fibI(n)
   b = 1
   for i = 1 to n
       t = a + b
       a = b
       b = t
   next i
fibI = a
end function


define binomial(n::integer,k::integer) => {
	#k == 0 ? return 1
	local(result = 1)
	loop(#k) => {
		#result = #result * (#n - loop_count + 1) / loop_count
	}
	return #result
}
// Tests
binomial(5, 3)
binomial(5, 4)
binomial(60, 30)


    '   [RC] Binomial Coefficients

    print "Binomial Coefficient of "; 5; " and "; 3; " is ",BinomialCoefficient( 5, 3)
    n =1 +int( 10 *rnd( 1))
    k =1 +int( n *rnd( 1))
    print "Binomial Coefficient of "; n; " and "; k; " is ",BinomialCoefficient( n, k)

    end

    function BinomialCoefficient( n, k)
        BinomialCoefficient =factorial( n) /factorial( n -k) /factorial( k)
    end function

    function factorial( n)
        if n <2 then
            f =1
        else
            f =n *factorial( n -1)
        end if
    factorial =f
    end function


to choose :n :k
  if :k = 0 [output 1]
  output (choose :n :k-1) * (:n - :k + 1) / :k
end

show choose 5 3   ; 10
show choose 60 30 ; 1.18264581564861e+17


function Binomial( n, k )
    if k > n then return nil end
    if k > n/2 then k = n - k end       --   (n k) = (n n-k)

    numer, denom = 1, 1
    for i = 1, k do
        numer = numer * ( n - i + 1 )
        denom = denom * i
    end
    return numer / denom
end


program Execute_Brain;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

const
  DataSize = 1024;                           // Size of Data segment
  MaxNest = 1000;                           // Maximum nesting depth of []

function Readkey: Char;
var
  InputRec: TInputRecord;
  NumRead: Cardinal;
  KeyMode: DWORD;
  StdIn: THandle;
begin
  StdIn := GetStdHandle(STD_INPUT_HANDLE);
  GetConsoleMode(StdIn, KeyMode);
  SetConsoleMode(StdIn, 0);

  repeat
    ReadConsoleInput(StdIn, InputRec, 1, NumRead);
    if (InputRec.EventType and KEY_EVENT <> 0) and InputRec.Event.KeyEvent.bKeyDown then
    begin
      if InputRec.Event.KeyEvent.AsciiChar <> #0 then
      begin
        Result := InputRec.Event.KeyEvent.UnicodeChar;
        Break;
      end;
    end;
  until FALSE;

  SetConsoleMode(StdIn, KeyMode);
end;

procedure ExecuteBF(Source: string);
var
  Dp: pByte;                          // Used as the Data Pointer
  DataSeg: Pointer;                        // Start of the DataSegment (Cell 0)
  Ip: pChar;                          // Used as instruction Pointer
  LastIp: Pointer;                        // Last adr of code.
  JmpStack: array[0..MaxNest - 1] of pChar;   // Stack to Keep track of active "[" locations
  JmpPnt: Integer;                        // Stack pointer ^^
  JmpCnt: Word;                           // Used to count brackets when skipping forward.

begin

  // Set up then data segment
  getmem(DataSeg, dataSize);
  Dp := DataSeg;
//  fillbyte(dp^,dataSize,0);
  FillChar(Dp^, DataSize, 0);

  // Set up the JmpStack
  JmpPnt := -1;

  // Set up Instruction Pointer
  Ip := @Source[1];
  LastIp := @Source[length(Source)];
  if Ip = nil then
    exit;

  // Main Execution loop
  repeat { until Ip > LastIp }
    case Ip^ of
      '<':
        dec(Dp);
      '>':
        inc(Dp);
      '+':
        inc(Dp^);
      '-':
        dec(Dp^);
      '.':
        write(chr(Dp^));
      ',':
        Dp^ := ord(ReadKey);
      '[':
        if Dp^ = 0 then
        begin
             // skip forward until matching bracket;
          JmpCnt := 1;
          while (JmpCnt > 0) and (Ip <= LastIp) do
          begin
            inc(Ip);
            case Ip^ of
              '[':
                inc(JmpCnt);
              ']':
                dec(JmpCnt);
              #0:
                begin
                  Writeln('Error brackets don''t match');
                  halt;
                end;
            end;
          end;
        end
        else
        begin
             // Add location to Jump stack
          inc(JmpPnt);
          JmpStack[JmpPnt] := Ip;
        end;
      ']':
        if Dp^ > 0 then
             // Jump Back to matching [
          Ip := JmpStack[JmpPnt]
        else             // Remove Jump from stack
          dec(JmpPnt);
    end;
    inc(Ip);
  until Ip > LastIp;
  freemem(DataSeg, dataSize);
end;

const
  HelloWorldWiki = '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>' +
    '---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.';
  pressESCtoCont = '>[-]+++++++[<++++++++++>-]<->>[-]+++++++[<+++++++++++' +
    '+>-]<->>[-]++++[<++++++++>-]+>[-]++++++++++[<++++++++' +
    '++>-]>[-]++++++++[<++++++++++++++>-]<.++.+<.>..<<.<<.' +
    '-->.<.>>.>>+.-----.<<.[<<+>>-]<<.>>>>.-.++++++.<++++.' +
    '+++++.>+.<<<<++.>+[>+<--]>++++...';
  waitForEsc = '[-]>[-]++++[<+++++++>-]<->[-]>+[[-]<<[>+>+<<-]' + '>>[<' +
    '<+>>-],<[->-<]>]';

begin
  // Execute "Hello World" example from Wikipedia
  ExecuteBF(HelloWorldWiki);

  // Print text "press ESC to continue....." and wait for ESC to be pressed
  ExecuteBF(pressESCtoCont + waitForEsc);
end.


bundle Default {
  class Fact {
    function : Main(args : String[]) ~ Nil {
      5->Factorial()->PrintLine();
    }
  }
}


let rec factorial n =
  if n <= 0 then 1
  else n * factorial (n-1)


import std.stdio, std.range, std.traits;

/// Approximates y(t) in y'(t)=f(t,y) with y(a)=y0 and t=a..b and the step size h.
void euler(F)(in F f, in double y0, in double a, in double b, in double h) @safe
if (isCallable!F && __traits(compiles, { real r = f(0.0, 0.0); })) {
    double y = y0;
    foreach (immutable t; iota(a, b, h)) {
        writefln("%.3f  %.3f", t, y);
        y += h * f(t, y);
    }
    "done".writeln;
}

void main() {
    /// Example: Newton's cooling law.
    enum newtonCoolingLaw = (in double time, in double t)
        pure nothrow @safe @nogc => -0.07 * (t - 20);

    euler(newtonCoolingLaw, 100, 0, 100,  2);
    euler(newtonCoolingLaw, 100, 0, 100,  5);
    euler(newtonCoolingLaw, 100, 0, 100, 10);
}


defmodule Euler do
  def method(_, _, t, b, _) when t>b, do: :ok
  def method(f, y, t, b, h) do
    :io.format "~7.3f ~7.3f~n", [t,y]
    method(f, y + h * f.(t,y), t + h, b, h)
  end
end

f = fn _time, temp -> -0.07 * (temp - 20) end
Enum.each([10, 5, 2], fn step ->
  IO.puts "\nStep = #{step}"
  Euler.method(f, 100.0, 0.0, 100.0, step)
end)


import java.util.Random;

public class EvoAlgo {
  static final String target = "METHINKS IT IS LIKE A WEASEL";
  static final char[] possibilities = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray();
  static int C = 100; //number of spawn per generation
  static double minMutateRate = 0.09;
  static int perfectFitness = target.length();
  private static String parent;
  static Random rand = new Random();

  private static int fitness(String trial){
    int retVal = 0;
    for(int i = 0;i < trial.length(); i++){
      if (trial.charAt(i) == target.charAt(i)) retVal++;
    }
    return retVal;
  }

  private static double newMutateRate(){
    return (((double)perfectFitness - fitness(parent)) / perfectFitness * (1 - minMutateRate));
  }

  private static String mutate(String parent, double rate){
    String retVal = "";
    for(int i = 0;i < parent.length(); i++){
      retVal += (rand.nextDouble() <= rate) ?
        possibilities[rand.nextInt(possibilities.length)]:
        parent.charAt(i);
    }
    return retVal;
  }

  public static void main(String[] args){
    parent = mutate(target, 1);
    int iter = 0;
    while(!target.equals(parent)){
      double rate = newMutateRate();
      iter++;
      if(iter % 100 == 0){
        System.out.println(iter +": "+parent+ ", fitness: "+fitness(parent)+", rate: "+rate);
      }
      String bestSpawn = null;
      int bestFit = 0;
      for(int i = 0; i < C; i++){
        String spawn = mutate(parent, rate);
        int fitness = fitness(spawn);
        if(fitness > bestFit){
          bestSpawn = spawn;
          bestFit = fitness;
        }
      }
      parent = bestFit > fitness(parent) ? bestSpawn : parent;
    }
    System.out.println(parent+", "+iter);
  }

}


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Tue May 21 20:22:56
!
!a=./f && make $a && OMP_NUM_THREADS=2 $a < unixdict.txt
!gfortran -std=f2008 -Wall -ffree-form -fall-intrinsics f.f08 -o f
! n     odd    even
!-6    F    T
!-5    T    F
!-4    F    T
!-3    T    F
!-2    F    T
!-1    T    F
! 0    F    T
! 1    T    F
! 2    F    T
! 3    T    F
! 4    F    T
! 5    T    F
! 6    F    T
! -6 -5 -4 -3 -2 -1  0  1  2  3  4  5  6       n
!  F  T  F  T  F  T  F  T  F  T  F  T  F     odd
!  T  F  T  F  T  F  T  F  T  F  T  F  T    even
!
!Compilation finished at Tue May 21 20:22:56

module bit0parity

  interface odd
    module procedure odd_scalar, odd_list
  end interface

  interface even
    module procedure even_scalar, even_list
  end interface

contains

  logical function odd_scalar(a)
    implicit none
    integer, intent(in) :: a
    odd_scalar = btest(a, 0)
  end function odd_scalar

  logical function even_scalar(a)
    implicit none
    integer, intent(in) :: a
    even_scalar = .not. odd_scalar(a)
  end function even_scalar

  function odd_list(a) result(rv)
    implicit none
    integer, dimension(:), intent(in) :: a
    logical, dimension(size(a)) :: rv
    rv = btest(a, 0)
  end function odd_list

  function even_list(a) result(rv)
    implicit none
    integer, dimension(:), intent(in) :: a
    logical, dimension(size(a)) :: rv
    rv = .not. odd_list(a)
  end function even_list

end module bit0parity

program oe
  use bit0parity
  implicit none
  integer :: i
  integer, dimension(13) :: j
  write(6,'(a2,2a8)') 'n', 'odd', 'even'
  write(6, '(i2,2l5)') (i, odd_scalar(i), even_scalar(i), i=-6,6)
  do i=-6, 6
    j(i+7) = i
  end do
  write(6, '((13i3),a8/(13l3),a8/(13l3),a8)') j, 'n', odd(j), 'odd', even(j), 'even'
end program oe


fn main() {
    let mut prev = 0;
    // Rust needs this type hint for the checked_add method
    let mut curr = 1usize;

    while let Some(n) = curr.checked_add(prev) {
        prev = curr;
        curr = n;
        println!("{}", n);
    }
}


(Local) In[1]:= Binomial[5,3]
(Local) Out[1]= 10


((dup 0 ==) 'succ (dup pred) '* linrec) :fact
('dup dip dup ((fact) () (- fact) (fact * div)) spread) :binomial

5 3 binomial puts!


% built in factorial
printf("%d\n", factorial(50));

% let's define our recursive...
function fact = my_fact(n)
  if ( n <= 1 )
    fact = 1;
  else
    fact = n * my_fact(n-1);
  endif
endfunction

printf("%d\n", my_fact(50));

% let's define our iterative
function fact = iter_fact(n)
  fact = 1;
  for i = 2:n
    fact = fact * i;
  endfor
endfunction

printf("%d\n", iter_fact(50));


-module(euler).
-export([main/0, euler/5]).

cooling(_Time, Temperature) ->
	(-0.07)*(Temperature-20).

euler(_, Y, T, _, End) when End == T ->
	io:fwrite("\n"),
	Y;

euler(Func, Y, T, Step, End) ->
	if
		T rem 10 == 0 ->
			io:fwrite("~.3f  ",[float(Y)]);
		true ->
			ok
	end,
	euler(Func, Y + Step * Func(T, Y), T + Step, Step, End).

analytic(T, End) when T == End ->
	io:fwrite("\n"),
	T;

analytic(T, End) ->
	Y = (20 + 80 * math:exp(-0.07 * T)),
	io:fwrite("~.3f  ", [Y]),
	analytic(T+10, End).

main() ->
	io:fwrite("Analytic:\n"),
	analytic(0, 100),
	io:fwrite("Step 2:\n"),
	euler(fun cooling/2, 100, 0, 2, 100),
	io:fwrite("Step 5:\n"),
	euler(fun cooling/2, 100, 0, 5, 100),
	io:fwrite("Step 10:\n"),
	euler(fun cooling/2, 100, 0, 10, 100),
	ok.


// ------------------------------------- Cross-browser Compatibility -------------------------------------

/* Compatibility code to reduce an array
 * Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Reduce
 */
if (!Array.prototype.reduce) {
    Array.prototype.reduce = function (fun /*, initialValue */ ) {
        "use strict";

        if (this === void 0 || this === null) throw new TypeError();

        var t = Object(this);
        var len = t.length >>> 0;
        if (typeof fun !== "function") throw new TypeError();

        // no value to return if no initial value and an empty array
        if (len == 0 && arguments.length == 1) throw new TypeError();

        var k = 0;
        var accumulator;
        if (arguments.length >= 2) {
            accumulator = arguments[1];
        } else {
            do {
                if (k in t) {
                    accumulator = t[k++];
                    break;
                }

                // if array contains no values, no initial value to return
                if (++k >= len) throw new TypeError();
            }
            while (true);
        }

        while (k < len) {
            if (k in t) accumulator = fun.call(undefined, accumulator, t[k], k, t);
            k++;
        }

        return accumulator;
    };
}

/* Compatibility code to map an array
 * Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Map
 */
if (!Array.prototype.map) {
    Array.prototype.map = function (fun /*, thisp */ ) {
        "use strict";

        if (this === void 0 || this === null) throw new TypeError();

        var t = Object(this);
        var len = t.length >>> 0;
        if (typeof fun !== "function") throw new TypeError();

        var res = new Array(len);
        var thisp = arguments[1];
        for (var i = 0; i < len; i++) {
            if (i in t) res[i] = fun.call(thisp, t[i], i, t);
        }

        return res;
    };
}

/* ------------------------------------- Generator -------------------------------------
 * Generates a fixed length gene sequence via a gene strategy object.
 * The gene strategy object must have two functions:
 *	- "create": returns create a new gene
 *	- "mutate(existingGene)": returns mutation of an existing gene
 */
function Generator(length, mutationRate, geneStrategy) {
    this.size = length;
    this.mutationRate = mutationRate;
    this.geneStrategy = geneStrategy;
}

Generator.prototype.spawn = function () {
    var genes = [],
        x;
    for (x = 0; x < this.size; x += 1) {
        genes.push(this.geneStrategy.create());
    }
    return genes;
};

Generator.prototype.mutate = function (parent) {
    return parent.map(function (char) {
        if (Math.random() > this.mutationRate) {
            return char;
        }
        return this.geneStrategy.mutate(char);
    }, this);
};

/* ------------------------------------- Population -------------------------------------
 * Helper class that holds and spawns a new population.
 */
function Population(size, generator) {
    this.size = size;
    this.generator = generator;

    this.population = [];
    // Build initial popuation;
    for (var x = 0; x < this.size; x += 1) {
        this.population.push(this.generator.spawn());
    }
}

Population.prototype.spawn = function (parent) {
    this.population = [];
    for (var x = 0; x < this.size; x += 1) {
        this.population.push(this.generator.mutate(parent));
    }
};

/* ------------------------------------- Evolver -------------------------------------
 * Attempts to converge a population based a fitness strategy object.
 * The fitness strategy object must have three function
 *	- "score(individual)": returns a score for an individual.
 *	- "compare(scoreA, scoreB)": return true if scoreA is better (ie more fit) then scoreB
 *	- "done( score )": return true if score is acceptable (ie we have successfully converged).
 */
function Evolver(size, generator, fitness) {
    this.done = false;
    this.fitness = fitness;
    this.population = new Population(size, generator);
}

Evolver.prototype.getFittest = function () {
    return this.population.population.reduce(function (best, individual) {
        var currentScore = this.fitness.score(individual);
        if (best === null || this.fitness.compare(currentScore, best.score)) {
            return {
                score: currentScore,
                individual: individual
            };
        } else {
            return best;
        }
    }, null);
};

Evolver.prototype.doGeneration = function () {
    this.fittest = this.getFittest();
    this.done = this.fitness.done(this.fittest.score);
    if (!this.done) {
        this.population.spawn(this.fittest.individual);
    }
};

Evolver.prototype.run = function (onCheckpoint, checkPointFrequency) {
    checkPointFrequency = checkPointFrequency || 10; // Default to Checkpoints every 10 generations
    var generation = 0;
    while (!this.done) {
        this.doGeneration();
        if (generation % checkPointFrequency === 0) {
            onCheckpoint(generation, this.fittest);
        }
        generation += 1;
    }
    onCheckpoint(generation, this.fittest);
    return this.fittest;
};

// ------------------------------------- Exports -------------------------------------
window.Generator = Generator;
window.Evolver = Evolver;

// helper utitlity to combine elements of two arrays.
Array.prototype.zip = function (b, func) {
    var result = [],
        max = Math.max(this.length, b.length),
        x;
    for (x = 0; x < max; x += 1) {
        result.push(func(this[x], b[x]));
    }
    return result;
};

var target = "METHINKS IT IS LIKE A WEASEL", geneStrategy, fitness, target, generator, evolver, result;

geneStrategy = {
    // The allowed character set (as an array)
    characterSet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".split(""),

    /*
        Pick a random character from the characterSet
    */
    create: function getRandomGene() {
        var randomNumber = Math.floor(Math.random() * this.characterSet.length);
        return this.characterSet[randomNumber];
    }
};
geneStrategy.mutate = geneStrategy.create; // Our mutation stragtegy is to simply get a random gene
fitness = {
    // The target (as an array of characters)
    target: target.split(""),
    equal: function (geneA, geneB) {
        return (geneA === geneB ? 0 : 1);
    },
    sum: function (runningTotal, value) {
        return runningTotal + value;
    },

    /*
        We give one point to for each corect letter
    */
    score: function (genes) {
        var diff = genes.zip(this.target, this.equal); // create an array of ones and zeros
        return diff.reduce(this.sum, 0); // Sum the array values together.
    },
    compare: function (scoreA, scoreB) {
        return scoreA <= scoreB; // Lower scores are better
    },
    done: function (score) {
        return score === 0; // We have matched the target string.
    }
};

generator = new Generator(target.length, 0.05, geneStrategy);
evolver = new Evolver(100, generator, fitness);

function showProgress(generation, fittest) {
    document.write("Generation: " + generation + ", Best: " + fittest.individual.join("") + ", fitness:" + fittest.score + "<br>");
}
result = evolver.run(showProgress);


' FB 1.05.0 Win64

Dim n As Integer

Do
  Print "Enter an integer or 0 to finish : ";
  Input "", n
  If n = 0 Then
    Exit Do
  ElseIf n Mod 2 = 0 Then
    Print "Your number is even"
    Print
  Else
    Print "Your number is odd"
    Print
  End if
Loop

End


isEven[x is isInteger] := getBit[x,0] == 0
isOdd[x is isInteger] := getBit[x,0] == 1