#define PI 3.141592653589793238462643383279502884197169399375105821
#define MAXITER 12

'---------------------------------------
'   complex numbers and their arithmetic
'---------------------------------------

type complex
    r as double
    i as double
end type

function conj( a as complex ) as complex
    dim as complex c
    c.r =  a.r
    c.i = -a.i
    return c
end function

operator + ( a as complex, b as complex ) as complex
    dim as complex c
    c.r = a.r + b.r
    c.i = a.i + b.i
    return c
end operator

operator - ( a as complex, b as complex ) as complex
    dim as complex c
    c.r = a.r - b.r
    c.i = a.i - b.i
    return c
end operator

operator * ( a as complex, b as complex ) as complex
    dim as complex c
    c.r = a.r*b.r - a.i*b.i
    c.i = a.i*b.r + a.r*b.i
    return c
end operator

operator / ( a as complex, b as complex ) as complex
    dim as double bcb = (b*conj(b)).r
    dim as complex acb = a*conj(b), c
    c.r = acb.r/bcb
    c.i = acb.i/bcb
    return c
end operator

sub printc( a as complex )
    if a.i>=0 then
        print using "############.############### + ############.############### i"; a.r; a.i
    else
        print using "############.############### - ############.############### i"; a.r; -a.i
    end if
end sub

function intc( n as integer ) as complex
    dim as complex c
    c.r = n
    c.i = 0.0
    return c
end function

function absc( a as complex ) as double
    return sqr( (a*conj(a)).r )
end function

'-----------------------
' the algorithm
' Uses a rapidly converging continued
' fraction expansion for e^z and recursive
' expressions for its convergents
'-----------------------

dim as complex pii, pii2, curr, A2, A1, A0, B2, B1, B0
dim as complex ONE, TWO
dim as integer i, k = 2
pii.r = 0.0
pii.i = PI
pii2 = pii*pii

B0 = intc(2)
A0 = intc(2)
B1 = (intc(2) - pii)
A1 = B0*B1 + intc(2)*pii
printc( A0/B0)
print "     Absolute error = ", absc(A0/B0)
printc( A1/B1)
print "     Absolute error = ", absc(A1/B1)

for i = 1 to MAXITER
    k = k + 4
    A2 = intc(k)*A1 + pii2*A0
    B2 = intc(k)*B1 + pii2*B0
    curr = A2/B2
    A0 = A1
    A1 = A2
    B0 = B1
    B1 = B2
    printc( curr  )
    print "     Absolute error = ", absc(curr)
next i


10 s$="METHINKS IT IS LIKE A WEASEL"
20 cc=100
30 prop=0.05
40 sl=len(s$)
50 dim c(cc,sl)
60 dim o(sl)
70 dim v(cc)
80 cp = 1
90 start=time
100 for i=1 to sl
110 o(i)=asc(mid$(s$,i,1))
120 if o(i)=32 then o(i)=64
130 next
140 for j=1 to sl:c(1,j)=int(64+27*rnd(1)):next
150 for i=2 to cc
160 for j=1 to sl:c(i,j)=c(cp,j):next
170 next
180 for i=1 to cc
190 for j=1 to sl
200 if rnd(1)>prop then goto 220
210 c(i,j)=int(64+27*rnd(1))
220 next j: next i
230 sc=0:bsi=1
240 for i=1 to cc
250 v(i)=0
260 for j=1 to sl
270 if c(i,j)=o(j) then v(i)=v(i)+1
280 next j
290 if v(i)>sc then sc=v(i):bsi=i
300 next i
310 print sc"@"bsi;:if bsi<10 then print " ";
320 for i=1 to sl:?chr$(c(bsi, i)+(c(bsi, i)=64)*32);:next:?
330 if sc=sl then print "We have a weasel!":? "Time: "(time-start)/300:end
340 cp=bsi
350 goto 150


-- utility method to escape punctuation
function normalize(str)
    local result = str:gsub("(%p)", "%%%1")
    -- print(result)
    return result
end

-- utility method to split string into lines
function get_lines(str)
    local t = {}
    for line in str:gmatch("([^\n\r]*)[\n\r]*") do
        table.insert(t, line)
    end
    return t
end

local markov = {}
local MARKOV_RULE_PATTERN = "(.+)%s%-%>%s(%.?)(.*)"

function markov.rule(pattern,replacement,terminating)
    return {
        pattern = pattern,
        replacement = replacement,
        terminating = (terminating == ".")
    }, normalize(pattern)
end

function markov.make_rules(sample)
    local lines = get_lines(sample)
    local rules = {}
    local finders = {}
    for i,line in ipairs(lines) do
        if not line:find("^#") then
        s,e,pat,term,rep = line:find(MARKOV_RULE_PATTERN)
        if s then
            r, p = markov.rule(pat,rep,term)
            rules[p] = r
            table.insert(finders, p)
        end
        end
    end
    return {
        rules = rules,
        finders = finders
    }
end

function markov.execute(state, sample_input)

local rules, finders = state.rules, state.finders
local found = false -- did we find any rule?
local terminate = false

repeat
found = false

for i,v in ipairs(finders) do
    local found_now = false -- did we find this rule?
    if sample_input:find(v) then
        found = true
        found_now = true
    end
    sample_input = sample_input:gsub(v, rules[v].replacement, 1)
    -- handle terminating rules
    if found_now then
        if rules[v].terminating then terminate = true end
        break
    end
end

until not found or terminate

return sample_input
end
------------------------------------------
------------------------------------------

local grammar1 = [[
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule
]]

local grammar2 = [[
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
]]

local grammar3 = [[
# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
]]

local grammar4 = [[
### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
1@1 -> x,@y
1@_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
]]

local grammar5 = [[
# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
]]

local text1 = "I bought a B of As from T S."
local text2 = "I bought a B of As W my Bgage from T S."
local text3 = '_1111*11111_'
local text4 = '000000A000000'

------------------------------------------
------------------------------------------

function do_markov(rules, input, output)
    local m = markov.make_rules(rules)
    input = markov.execute(m, input)
    assert(input == output)
    print(input)
end

do_markov(grammar1, text1, 'I bought a bag of apples from my brother.')
do_markov(grammar2, text1, 'I bought a bag of apples from T shop.')
-- stretch goals
do_markov(grammar3, text2, 'I bought a bag of apples with my money from T shop.')
do_markov(grammar4, text3, '11111111111111111111')
do_markov(grammar5, text4, '00011H1111000')


: odd? \ n -- boolean
    dup 1 n:band 1 n:= ;
: even? \ n -- boolean
    odd? not ;


/* ARM assembly AARCH64 Raspberry PI 3B and android arm 64 bits*/
/*  program oddEven64.s   */

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

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResultOdd:        .asciz " @ is odd (impair) \n"
sMessResultEven:       .asciz " @ is even (pair)  \n"
szCarriageReturn:      .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 //entry of program

    mov x0,#5
    bl testOddEven
    mov x0,#12
    bl testOddEven
    mov x0,#2021
    bl testOddEven
100:                                  //standard end of the program
    mov x0, #0                        //return code
    mov x8, #EXIT                     //request to exit program
    svc #0                            //perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResultOdd:       .quad sMessResultOdd
qAdrsMessResultEven:      .quad sMessResultEven
qAdrsZoneConv:            .quad sZoneConv
/***************************************************/
/*     test if number is odd or even               */
/***************************************************/
// x0 contains à number
testOddEven:
    stp x1,lr,[sp,-16]!       // save  registres
    tst x0,#1                   //test bit 0 to one
    beq 1f                      //if result are all zéro, go to even
    ldr x1,qAdrsZoneConv        //else display odd message
    bl conversion10             //call decimal conversion
    ldr x0,qAdrsMessResultOdd
    ldr x1,qAdrsZoneConv        //insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    b 100f
1:
    ldr x1,qAdrsZoneConv
    bl conversion10             //call decimal conversion
    ldr x0,qAdrsMessResultEven
    ldr x1,qAdrsZoneConv        //insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
100:
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


CREATE OR REPLACE FUNCTION fnu_fibonacci(p_num INTEGER) RETURN INTEGER IS
  f INTEGER;
  p INTEGER;
  q INTEGER;
BEGIN
  CASE WHEN p_num < 0 OR p_num != TRUNC(p_num)
                            THEN raise_application_error(-20001, 'Invalid input: ' || p_num, TRUE);
       WHEN p_num IN (0, 1) THEN f := p_num;
       ELSE
            p := 0;
            q := 1;
            FOR i IN 2 .. p_num LOOP
              f := p + q;
              p := q;
              q := f;
            END LOOP;
  END CASE;
  RETURN(f);
END fnu_fibonacci;
/


function factorial(Number n):Number {
  Var:Number ret;
  if (n >= 0) {
    ret = 1;
    Var:Number i = 1;
    for (i = 1; i <= n; i++) {
      ret = ret * i;
    }
  } else {
    ret = 0;
  }
  return ret;
}


fun facti(n: Int) = when {
    n < 0 -> throw IllegalArgumentException("negative numbers not allowed")
    else  -> {
        var ans = 1L
        for (i in 2..n) ans *= i
        ans
    }
}

fun factr(n: Int): Long = when {
    n < 0 -> throw IllegalArgumentException("negative numbers not allowed")
    n < 2 -> 1L
    else  -> n * factr(n - 1)
}

fun main(args: Array<String>) {
    val n = 20
    println("$n! = " + facti(n))
    println("$n! = " + factr(n))
}


package main

import (
    "fmt"
    "math"
    "math/cmplx"
)

func main() {
    fmt.Println(cmplx.Exp(math.Pi * 1i) + 1.0)
}


import static Complex.*

Number.metaClass.mixin ComplexCategory

def π = Math.PI
def e = Math.E

println "e ** (π * i) + 1 = " + (e ** (π * i) + 1)

println "| e ** (π * i) + 1 | = " + (e ** (π * i) + 1).ρ


import Data.Complex

eulerIdentityZeroIsh :: Complex Double
eulerIdentityZeroIsh =
  exp (0 :+ pi) + 1

main :: IO ()
main = print eulerIdentityZeroIsh


   NB. Euler's number is the default base for power
   NB. using j's expressive numeric notation:
   1 + ^ 0j1p1
0j1.22465e_16

   NB. Customize the comparison tolerance to 10 ^ (-15)
   NB. to show that
   _1 (=!.1e_15) ^ 0j1p1
1

   TAU =: 2p1

   NB. tauday.com  pi is wrong
   NB. with TAU as 2 pi,
   NB. Euler's identity should have read

   1 (=!.1e_15) ^ j. TAU
1


public class EulerIdentity {

    public static void main(String[] args) {
        System.out.println("e ^ (i*Pi) + 1 = " + (new Complex(0, Math.PI).exp()).add(new Complex(1, 0)));
    }

    public static class Complex {

        private double x, y;

        public Complex(double re, double im) {
            x = re;
            y = im;
        }

        public Complex exp() {
            double exp = Math.exp(x);
            return new Complex(exp * Math.cos(y), exp * Math.sin(y));
        }

        public Complex add(Complex a) {
            return new Complex(x + a.x, y + a.y);
        }

        @Override
        public String toString() {
            return x + " + " + y + "i";
        }
    }
}


 evolve←{
    ⍺←0.1
    target←'METHINKS IT IS LIKE A WEASEL'
    charset←27↑⎕A
    fitness←{target+.=⍵}
    mutate←⍺∘{
       (⍺>?(⍴target)/0){
          ⍺:(?⍴charset)⊃charset
          ⍵
       }¨⍵
    }
    ⍵{
       target≡⎕←⍵:⍵
       next←mutate¨⍺/⊂⍵
       ⍺∇(⊃⍒fitness¨next)⊃next
    }charset[?(⍴target)/⍴charset]
 }


output := ""
target := "METHINKS IT IS LIKE A WEASEL"
targetLen := StrLen(target)
Loop, 26
	possibilities_%A_Index% := Chr(A_Index+64) ; A-Z
possibilities_27  := " "
C := 100

parent := ""
Loop, %targetLen%
{
	Random, randomNum, 1, 27
  parent .= possibilities_%randomNum%
}

Loop,
{
	If (target = parent)
		Break
	If (Mod(A_Index,10) = 0)
		output .= A_Index ": " parent ", fitness: " fitness(parent, target) "`n"
	bestFit := 0
	Loop, %C%
	  If ((fitness := fitness(spawn := mutate(parent), target)) > bestFit)
		  bestSpawn := spawn , bestFit := fitness
	parent := bestFit > fitness(parent, target) ? bestSpawn : parent
	iter := A_Index
}
output .= parent ", " iter
MsgBox, % output
ExitApp

mutate(parent) {
	local	output, replaceChar, newChar
	output := ""
	Loop, %targetLen%
	{
		Random, replaceChar, 0, 9
		If (replaceChar != 0)
			output .= SubStr(parent, A_Index, 1)
		else
		{
			Random, newChar, 1, 27
			output .= possibilities_%newChar%
		}
	}
	Return output
}

fitness(string, target) {
	totalFit := 0
	Loop, % StrLen(string)
		If (SubStr(string, A_Index, 1) = SubStr(target, A_Index, 1))
			totalFit++
	Return totalFit
}


markov[ruleset_, text_] :=
  Module[{terminating = False, output = text,
    rules = StringCases[
      ruleset, {StartOfLine ~~ pattern : Except["\n"] .. ~~
         " " | "\t" .. ~~ "->" ~~ " " | "\t" .. ~~ dot : "" | "." ~~
         replacement : Except["\n"] .. ~~ EndOfLine :> {pattern,
         replacement, dot == "."}}]},
   While[! terminating, terminating = True;
    Do[If[! StringFreeQ[output, rule[[1]]],
      output = StringReplace[output, rule[[1]] -> rule[[2]]];
      If[! rule[[3]], terminating = False]; Break[]], {rule, rules}]];
    output];


cl_demo_output=>display(
  VALUE string_table(
    FOR i = -5 WHILE i < 6 (
      COND string(
        LET r = i MOD 2 IN
        WHEN r = 0 THEN |{ i } is even|
        ELSE |{ i } is odd|
      )
    )
  )
).


PROC OddByAnd(INT v)
  IF (v&1)=0 THEN
    Print(" even")
  ELSE
    Print(" odd ")
  FI
RETURN

PROC OddByMod(INT v)
  ;MOD doesn't work properly for negative numbers in Action!
  IF v<0 THEN
    v=-v
  FI
  IF v MOD 2=0 THEN
    Print(" even")
  ELSE
    Print(" odd ")
  FI
RETURN

PROC OddByDiv(INT v)
  INT d
  d=(v/2)*2
  IF v=d THEN
    Print(" even")
  ELSE
    Print(" odd ")
  FI
RETURN

PROC Main()
  INT i

  FOR i=-4 TO 4
  DO
    PrintF("%I is",i)
    OddByAnd(i)
    OddByMod(i)
    OddByDiv(i)
    PutE()
  OD
RETURN


To find a fibonacci number given a count:
Put 0 into a number.
Put 1 into another number.
Loop.
If a counter is past the count, put the number into the fibonacci number; exit.
Add the number to the other number.
Swap the number with the other number.
Repeat.


  : fact iota 1 + '* reduce ;
  5 fact
120


def multiply(x; y):
    if (x|type) == "number" then
       if  (y|type) == "number" then [ x*y, 0 ]
       else [x * y[0], x * y[1]]
       end
    elif (y|type) == "number" then multiply(y;x)
    else [ x[0] * y[0] - x[1] * y[1],  x[0] * y[1] + x[1] * y[0]]
    end;

def plus(x; y):
    if (x|type) == "number" then
       if  (y|type) == "number" then [ x+y, 0 ]
       else [ x + y[0], y[1]]
       end
    elif (y|type) == "number" then plus(y;x)
    else [ x[0] + y[0], x[1] + y[1] ]
    end;

def exp(z):
  def expi(x): [ (x|cos), (x|sin) ];
  if (z|type) == "number" then z|exp
  elif z[0] == 0 then expi(z[1])  # for efficiency
  else multiply( (z[0]|exp); expi(z[1]) )
  end ;

def pi: 4 * (1|atan);


@show ℯ^(π * im) + 1
@assert ℯ^(π * im) ≈ -1


// Version 1.2.40

import kotlin.math.sqrt
import kotlin.math.PI

const val EPSILON = 1.0e-16
const val SMALL_PI = '\u03c0'
const val APPROX_EQUALS = '\u2245'

class Complex(val real: Double, val imag: Double) {
    operator fun plus(other: Complex) =
        Complex(real + other.real, imag + other.imag)

    operator fun times(other: Complex) = Complex(
        real * other.real - imag * other.imag,
        real * other.imag + imag * other.real
    )

    fun inv(): Complex {
        val denom = real * real + imag * imag
        return Complex(real / denom, -imag / denom)
    }

    operator fun unaryMinus() = Complex(-real, -imag)

    operator fun minus(other: Complex) = this + (-other)

    operator fun div(other: Complex) = this * other.inv()

    val modulus: Double get() = sqrt(real * real + imag * imag)

    override fun toString() =
        if (imag >= 0.0) "$real + ${imag}i"
        else "$real - ${-imag}i"
}

fun main(args: Array<String>) {
    var fact = 1.0
    val x = Complex(0.0, PI)
    var e = Complex(1.0, PI)
    var n = 2
    var pow = x
    do {
        val e0 = e
        fact *= n++
        pow *= x
        e += pow / Complex(fact, 0.0)
    }
    while ((e - e0).modulus >= EPSILON)
    e += Complex(1.0, 0.0)
    println("e^${SMALL_PI}i + 1 = $e $APPROX_EQUALS 0")
}


#!/bin/awk -f
function randchar(){
return substr(charset,randint(length(charset)+1),1)
}
function mutate(gene,rate    ,l,newgene){
newgene = ""
for (l=1; l < 1+length(gene); l++){
if (rand() < rate)
   newgene = newgene randchar()
else
   newgene = newgene substr(gene,l,1)
}
return newgene
}
function fitness(gene,target  ,k,fit){
fit = 0
for (k=1;k<1+length(gene);k++){
if (substr(gene,k,1) == substr(target,k,1)) fit = fit + 1
}
return fit
}
function randint(n){
return int(n * rand())
}
function evolve(){
     maxfit = fitness(parent,target)
     oldfit = maxfit
     maxj = 0
     for (j=1; j < D; j++){
         child[j] = mutate(parent,mutrate)
         fit[j] = fitness(child[j],target)
         if (fit[j] > maxfit) {
            maxfit = fit[j]
            maxj = j
            }
          }
     if (maxfit > oldfit) parent = child[maxj]
     }

BEGIN{
target = "METHINKS IT IS LIKE A WEASEL"
charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
mutrate = 0.10
if (ARGC > 1) mutrate = ARGV[1]
lenset = length(charset)
C = 100
D = C + 1
parent = ""
for (j=1; j < length(target)+1; j++) {
     parent = parent randchar()
     }
print "target: " target
print "fitness of target: " fitness(target,target)
print "initial parent: " parent
gens = 0
while (parent != target){
      evolve()
      gens = gens + 1
      if (gens % 10 == 0) print "after " gens " generations,","new parent: " parent," with fitness: " fitness(parent,target)
      }
print "after " gens " generations,"," evolved parent: " parent
}


import strutils, strscans

type Rule = object
  pattern: string       # Input pattern.
  replacement: string   # Replacement string (may be empty).
  terminating: bool     # "true" if terminating rule.

#---------------------------------------------------------------------------------------------------

func parse(rules: string): seq[Rule] =
  ## Parse a rule set to build a sequence of rules.

  var linecount = 0
  for line in rules.splitLines():

    inc linecount
    if line.startsWith('#'): continue
    if line.strip.len == 0: continue

    # Scan the line.
    var pat, rep: string
    var terminating = false
    if not line.scanf("$+ -> $*", pat, rep):
      raise newException(ValueError, "Invalid rule at line " & $linecount)

    if rep.startsWith('.'):
      # Terminating rule.
      rep = rep[1..^1]
      terminating = true

    result.add(Rule(pattern: pat, replacement: rep, terminating: terminating))

#---------------------------------------------------------------------------------------------------

func apply(text: string; rules: seq[Rule]): string =
  ## Apply a set of rules to a text and return the result.

  result = text
  var changed = true

  while changed:
    changed = false
    # Try to apply the rules in sequence.
    for rule in rules:
      if result.find(rule.pattern) >= 0:
        # Found a rule to apply.
        result = result.replace(rule.pattern, rule.replacement)
        if rule.terminating: return
        changed = true
        break

#———————————————————————————————————————————————————————————————————————————————————————————————————

const SampleTexts = ["I bought a B of As from T S.",
                     "I bought a B of As from T S.",
                     "I bought a B of As W my Bgage from T S.",
                     "_1111*11111_",
                     "000000A000000"]

const Rulesets = [

#................................................

"""# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule""",

#................................................

"""# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule""",

#................................................

"""# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule""",

#................................................

"""### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ -> """,

#................................................

"""# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11"""

]

for n, ruleset in RuleSets:
  let rules = ruleset.parse()
  echo SampleTexts[n].apply(rules)


(* Useful for resource cleanup (such as filehandles) *)
let try_finally x f g =
  try let res = f x in g x; res
  with e -> g x; raise e

(* Substitute string 'b' for first occurance of regexp 'a' in 's';
 * Raise Not_found if there was no occurance of 'a'. *)
let subst a b s =
  ignore (Str.search_forward a s 0); (* to generate Not_found *)
  Str.replace_first a b s

let parse_rules cin =
  let open Str in
  let rule = regexp "\\(.+\\)[ \t]+->[ \t]+\\(.*\\)" in
  let leader s c = String.length s > 0 && s.[0] = c in
  let parse_b s = if leader s '.' then (string_after s 1,true) else (s,false) in
  let rec parse_line rules =
    try
      let s = input_line cin in
      if leader s '#' then parse_line rules
      else if string_match rule s 0 then
        let a = regexp_string (matched_group 1 s) in
        let b,terminate = parse_b (matched_group 2 s) in
        parse_line ((a,b,terminate)::rules)
      else failwith ("parse error: "^s)
    with End_of_file -> rules
  in List.rev (parse_line [])

let rec run rules text =
  let rec apply s = function
    | [] -> s
    | (a,b,term)::next ->
        try
          let s' = subst a b s in
          if term then s' else run rules s'
        with Not_found -> apply s next
  in apply text rules

let _ =
  if Array.length Sys.argv <> 2 then
    print_endline "Expecting one argument: a filename where rules can be found."
  else
    let rules = try_finally (open_in Sys.argv.(1)) parse_rules close_in in
    (* Translate lines read from stdin, until EOF *)
    let rec translate () =
      print_endline (run rules (input_line stdin));
      translate ()
    in try translate () with End_of_file -> ()


-- Ada has bitwise operators in package Interfaces,
-- but they work with Interfaces.Unsigned_*** types only.
-- Use rem or mod for Integer types, and let the compiler
-- optimize it.
declare
   N : Integer := 5;
begin
   if N rem 2 = 0 then
      Put_Line ("Even number");
   elseif N rem 2 /= 0 then
      Put_Line ("Odd number");
   else
      Put_Line ("Something went really wrong!");
   end if;
end;


even : ℕ → Bool
odd  : ℕ → Bool

even zero    = true
even (suc n) = odd n

odd zero    = false
odd (suc n) = even n


define fib(x);
lvars a , b;
    1 -> a;
    1 -> b;
    repeat x - 1 times
         (a + b, b) -> (b, a);
    endrepeat;
    a;
enddefine;


val .factorial = f fold(f .x x .y, pseries .n)
writeln .factorial(7)


define factorial(n) => {
  local(x = 1)
  with i in generateSeries(2, #n)
  do {
    #x *= #i
  }
  return #x
}


local c = {
  new = function(s,r,i) s.__index=s return setmetatable({r=r, i=i}, s) end,
  add = function(s,o) return s:new(s.r+o.r, s.i+o.i) end,
  exp = function(s) local e=math.exp(s.r) return s:new(e*math.cos(s.i), e*math.sin(s.i)) end,
  mul = function(s,o) return s:new(s.r*o.r+s.i*o.i, s.r*o.i+s.i*o.r) end
}
local i = c:new(0, 1)
local pi = c:new(math.pi, 0)
local one = c:new(1, 0)
local zero = i:mul(pi):exp():add(one)
print(string.format("e^(i*pi)+1 is approximately zero:  %.18g%+.18gi", zero.r, zero.i))


import math, complex

echo "exp(iπ) + 1 = ", exp(complex(0.0, PI)) + 1, " ~= 0"


@echo off
setlocal enabledelayedexpansion

set target=M E T H I N K S @ I T @ I S @ L I K E @ A @ W E A S E L
set chars=A B C D E F G H I J K L M N O P Q R S T U V W X Y Z @

set tempcount=0
for %%i in (%target%) do (
  set /a tempcount+=1
  set target!tempcount!=%%i
)
call:parent

echo  %target%
echo  --------------------------------------------------------

:loop
call:fitness parent
set currentfit=%errorlevel%
if %currentfit%==28 goto end
echo %parent% - %currentfit% [%attempts%]
set attempts=0

:innerloop
set /a attempts+=1
title Attemps - %attempts%
call:mutate %parent%
call:fitness tempparent
set newfit=%errorlevel%
if %newfit% gtr %currentfit% (
  set tempcount=0
  set "parent="
  for %%i in (%tempparent%) do (
    set /a tempcount+=1
    set parent!tempcount!=%%i
    set parent=!parent! %%i
  )
  goto loop
)
goto innerloop

:end
echo %parent% - %currentfit% [%attempts%]
echo Done.
exit /b

:parent
set "parent="
for /l %%i in (1,1,28) do (
  set /a charchosen=!random! %% 27 + 1
  set tempcount=0
  for %%j in (%chars%) do (
    set /a tempcount+=1
    if !charchosen!==!tempcount! (
      set parent%%i=%%j
      set parent=!parent! %%j
    )
  )
)
exit /b

:fitness
set fitness=0
set array=%1
for /l %%i in (1,1,28) do if !%array%%%i!==!target%%i! set /a fitness+=1
exit /b %fitness%

:mutate
set tempcount=0
set returnarray=tempparent
set "%returnarray%="
for %%i in (%*) do (
  set /a tempcount+=1
  set %returnarray%!tempcount!=%%i
  set %returnarray%=!%returnarray%! %%i
)
set /a tomutate=%random% %% 28 + 1
set /a mutateto=%random% %% 27 + 1
set tempcount=0
for %%i in (%chars%) do (
  set /a tempcount+=1
  if %mutateto%==!tempcount! (
    set %returnarray%!tomutate!=%%i
  )
)
set "%returnarray%="
for /l %%i in (1,1,28) do set %returnarray%=!%returnarray%! !%returnarray%%%i!
exit /b


@ARGV == 1 or die "Please provide exactly one source file as an argument.\n";
open my $source, '<', $ARGV[0] or die "I couldn't open \"$ARGV[0]\" for reading. ($!.)\n";
my @rules;
while (<$source>)
   {/\A#/ and next;
    my @a = /(.*?)\s+->\s+(\.?)(.*)/ or die "Syntax error: $_";
    push @rules, \@a;}
close $source;

my $input = do {local $/; <STDIN>;};

OUTER:
   {foreach (@rules)
       {my ($from, $terminating, $to) = @$_;
        $input =~ s/\Q$from\E/$to/
            and ($terminating ? last OUTER : redo OUTER);}}

print $input;


if (x & 1) {
    # x is odd
} else {
    # x is even
}


# Algol 68 has a standard operator: ODD which returns TRUE if its integer  #
# operand is odd and FALSE if it is even                                   #
# E.g.:                                                                    #

INT n;
print( ( "Enter an integer: " ) );
read( ( n ) );
print( ( whole( n, 0 ), " is ", IF ODD n THEN "odd" ELSE "even" FI, newline ) )


%!PS

% We want the 'n'th fibonacci number
/n 13 def

% Prepare output canvas:
/Helvetica findfont 20 scalefont setfont
100 100 moveto

%define the function recursively:
/fib { dup
       3 lt
         { pop 1 }
         { dup 1 sub fib exch 2 sub fib add }
       ifelse
    } def

    (Fib\() show n (....) cvs show (\)=) show n fib (.....) cvs show

showpage


factorial := {
  1 upto ($1 + 1) product.
}.


(defun factorial (n)
  (cond
    ((== n 0) 1)
    ((> n 0) (* n (factorial (- n 1))))))


use Math::Complex;
print exp(pi * i) + 1, "\n";


with javascript_semantics
include builtins\complex.e
complex i = complex_new(0,1),
        res = complex_add(complex_exp(complex_mul(PI,i)),1)
?complex_sprint(res,both:=true)
?complex_sprint(complex_round(res,1e16),true)
?complex_sprint(complex_round(res,1e15),true)


% reduce() prints the intermediate results so that one can see Prolog "thinking."
%
reduce(A, C) :-
    simplify(A, B),
    (B = A -> C = A; io:format("= ~w~n", [B]), reduce(B, C)).

simplify(exp(i*X), cos(X) + i*sin(X)) :- !.

simplify(0 + A, A) :- !.
simplify(A + 0, A) :- !.
simplify(A + B, C) :-
    integer(A),
    integer(B), !,
    C is A + B.
simplify(A + B, C + D) :- !,
    simplify(A, C),
    simplify(B, D).

simplify(0 * _, 0) :- !.
simplify(_ * 0, 0) :- !.
simplify(1 * A, A) :- !.
simplify(A * 1, A) :- !.
simplify(A * B, C) :-
    integer(A),
    integer(B), !,
    C is A * B.
simplify(A * B, C * D) :- !,
    simplify(A, C),
    simplify(B, D).

simplify(cos(0),  1)  :- !.
simplify(sin(0),  0)  :- !.
simplify(cos(pi), -1) :- !.
simplify(sin(pi), 0)  :- !.

simplify(X, X).


      target$ = "METHINKS IT IS LIKE A WEASEL"
      parent$ = "IU RFSGJABGOLYWF XSMFXNIABKT"
      mutation_rate = 0.5
      children% = 10

      DIM child$(children%)

      REPEAT
        bestfitness = 0
        bestindex% = 0
        FOR index% = 1 TO children%
          child$(index%) = FNmutate(parent$, mutation_rate)
          fitness = FNfitness(target$, child$(index%))
          IF fitness > bestfitness THEN
            bestfitness = fitness
            bestindex% = index%
          ENDIF
        NEXT index%

        parent$ = child$(bestindex%)
        PRINT parent$
      UNTIL parent$ = target$
      END

      DEF FNfitness(text$, ref$)
      LOCAL I%, F%
      FOR I% = 1 TO LEN(text$)
        IF MID$(text$, I%, 1) = MID$(ref$, I%, 1) THEN F% += 1
      NEXT
      = F% / LEN(text$)

      DEF FNmutate(text$, rate)
      LOCAL C%
      IF rate > RND(1) THEN
        C% = 63+RND(27)
        IF C% = 64 C% = 32
        MID$(text$, RND(LEN(text$)), 1) = CHR$(C%)
      ENDIF
      = text$


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

const char target[] = "METHINKS IT IS LIKE A WEASEL";
const char tbl[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";

#define CHOICE (sizeof(tbl) - 1)
#define MUTATE 15
#define COPIES 30

/* returns random integer from 0 to n - 1 */
int irand(int n)
{
	int r, rand_max = RAND_MAX - (RAND_MAX % n);
	while((r = rand()) >= rand_max);
	return r / (rand_max / n);
}

/* number of different chars between a and b */
int unfitness(const char *a, const char *b)
{
	int i, sum = 0;
	for (i = 0; a[i]; i++)
		sum += (a[i] != b[i]);
	return sum;
}

/* each char of b has 1/MUTATE chance of differing from a */
void mutate(const char *a, char *b)
{
	int i;
	for (i = 0; a[i]; i++)
		b[i] = irand(MUTATE) ? a[i] : tbl[irand(CHOICE)];

	b[i] = '\0';
}

int main()
{
	int i, best_i, unfit, best, iters = 0;
	char specimen[COPIES][sizeof(target) / sizeof(char)];

	/* init rand string */
	for (i = 0; target[i]; i++)
		specimen[0][i] = tbl[irand(CHOICE)];
	specimen[0][i] = 0;

	do {
		for (i = 1; i < COPIES; i++)
			mutate(specimen[0], specimen[i]);

		/* find best fitting string */
		for (best_i = i = 0; i < COPIES; i++) {
			unfit = unfitness(target, specimen[i]);
			if(unfit < best || !i) {
				best = unfit;
				best_i = i;
			}
		}

		if (best_i) strcpy(specimen[0], specimen[best_i]);
		printf("iter %d, score %d: %s\n", iters++, best, specimen[0]);
	} while (best);

	return 0;
}


procedure markov(string rules, input, expected)
    sequence subs = {}, reps = {}
    sequence lines = split(substitute(rules,'\t',' '),'\n')
    for i=1 to length(lines) do
        string li = lines[i]
        if length(li) and li[1]!='#' then
            integer k = match(" -> ",li)
            if k then
                subs = append(subs,trim(li[1..k-1]))
                reps = append(reps,trim(li[k+4..$]))
            end if
        end if
    end for
    string res = input
    bool term = false
    while 1 do
        bool found = false
        for i=1 to length(subs) do
            string sub = subs[i]
            integer k = match(sub,res)
            if k then
                found = true
                string rep = reps[i]
                if length(rep) and rep[1]='.' then
                    rep = rep[2..$]
                    term = true
                end if
                res[k..k+length(sub)-1] = rep
                exit
            end if
            if term then exit end if
        end for
        if term or not found then exit end if
    end while
    ?{input,res,iff(res=expected?"ok":"**ERROR**")}
end procedure

constant ruleset1 = """
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule"""
markov(ruleset1,"I bought a B of As from T S.","I bought a bag of apples from my brother.")

constant ruleset2 = """
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule"""
markov(ruleset2,"I bought a B of As from T S.","I bought a bag of apples from T shop.")

constant ruleset3 = """
# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule"""
markov(ruleset3,"I bought a B of As W my Bgage from T S.","I bought a bag of apples with my money from T shop.")

constant ruleset4 = """
### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
"""
markov(ruleset4,"_1111*11111_","11111111111111111111")

constant ruleset5 = """
# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
"""
markov(ruleset5,"000000A000000","00011H1111000")


BEGIN

% RETURN 1 IF EVEN, OTHERWISE 0 %
INTEGER FUNCTION EVEN(I);
INTEGER I;
BEGIN
  EVEN := 1 - (I - 2 * (I / 2));
END;

% TEST THE ROUTINE %
INTEGER K;
FOR K := 1 STEP 3 UNTIL 10 DO
  WRITE(K," IS ", IF EVEN(K) = 1 THEN "EVEN" ELSE "ODD");

END


begin
    % the Algol W standard procedure odd returns true if its integer  %
    % parameter is odd, false if it is even                           %
    for i := 1, 1702, 23, -26
    do begin
        write( i, " is ", if odd( i ) then "odd" else "even" )
    end for_i
end.


recursive = (n):
  if (n <= 1): 1. else: recursive (n - 1) + recursive (n - 2)..

n = 40
("fib(", n, ")= ", recursive (n), "\n") join print


    for i =0 to 40
        print " FactorialI( "; using( "####", i); ") = "; factorialI( i)
        print " FactorialR( "; using( "####", i); ") = "; factorialR( i)
    next i

    wait

    function factorialI( n)
        if n >1 then
            f =1
            For i = 2 To n
                f = f * i
            Next i
        else
            f =1
        end if
    factorialI =f
    end function

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

    end


sub infix:<> is tighter(&infix:<**>) { $^a * $^b };

say 'e**iπ + 1 ≅ 0 : ', e**iπ + 1 ≅ 0;
say 'Error: ', e**iπ + 1;


/*REXX program proves  Euler's  identity by showing that:      e^(i pi) + 1  ≡     0    */
numeric digits length( pi() )  -  length(.)      /*define pi;  set # dec. digs precision*/
        cosPI= fmt( cos(pi) )                    /*calculate the value of   cos(pi).    */
        sinPI= fmt( sin(pi) )                    /*    "      "    "    "   sin(pi).    */
say  '         cos(pi) = '  cosPI                /*display    "    "    "   cos(Pi).    */
say  '         sin(pi) = '  sinPI                /*   "       "    "    "   sin(Pi).    */
say                                              /*separate the wheat from the chaff.   */
     $= cosPI  +  mult( sqrt(-1), sinPI )  +  1  /*calc. product of sin(x) and sqrt(-1).*/
say  '    e^(i pi) + 1 = '  fmt($)    '    ' word("unproven proven",  ($=0)  +  1)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fmt:   procedure; parse arg x; x= format(x, , digits() %2, 0);   return left('', x>=0)x /1
mult:  procedure; parse arg a,b;       if a=0  | b=0  then return 0;            return a*b
pi:    pi= 3.1415926535897932384626433832795028841971693993751058209749445923;  return pi
cos:   procedure; parse arg x;  z= 1;  _= 1;   q= x*x;  i= -1;            return .sinCos()
sin:   procedure; parse arg x 1 z 1 _;         q= x*x;  i=  1;            return .sinCos()
.sinCos:   do k=2  by 2  until p=z;  p=z;  _= -_ * q/(k*(k+i));  z= z+_;  end;    return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt:  procedure; parse arg x;  if x=0  then return 0;  d=digits(); i=;             h= d+6
       numeric digits;  numeric form;   if x<0  then  do;  x= -x;   i= 'i';  end;   m.= 9
       parse value format(x, 2, 1, , 0)  'E0'   with   g  'E'  _  .;     g= g * .5'e'_ % 2
         do j=0  while h>9;      m.j= h;              h= h % 2   + 1;  end
         do k=j+5  to 0  by -1;  numeric digits m.k;  g= (g+x/g) *.5;  end;  return g || i


using System;
using System.Collections.Generic;
using System.Linq;

static class Program {
    static Random Rng = new Random((int)DateTime.Now.Ticks);

    static char NextCharacter(this Random self) {
        const string AllowedChars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
        return AllowedChars[self.Next() % AllowedChars.Length];
    }

    static string NextString(this Random self, int length) {
        return String.Join("", Enumerable.Repeat(' ', length)
            .Select(c => Rng.NextCharacter()));
    }

    static int Fitness(string target, string current) {
        return target.Zip(current, (a, b) => a == b ? 1 : 0).Sum();
    }

    static string Mutate(string current, double rate) {
        return String.Join("", from c in current
               select Rng.NextDouble() <= rate ? Rng.NextCharacter() : c);
    }

    static void Main(string[] args) {
        const string target = "METHINKS IT IS LIKE A WEASEL";
        const int C = 100;
        const double P = 0.05;

        // Start with a random string the same length as the target.
        string parent = Rng.NextString(target.Length);

        Console.WriteLine("START:       {0,20} fitness: {1}",
            parent, Fitness(target, parent));
        int i = 0;

        while (parent != target) {
            // Create C mutated strings + the current parent.
            var candidates = Enumerable.Range(0, C + 1)
                .Select(n => n > 0 ? Mutate(parent, P) : parent);

            // select the fittest
            parent = candidates.OrderByDescending(c => Fitness(target, c)).First();

            ++i;
            Console.WriteLine("     #{0,6} {1,20} fitness: {2}",
                i, parent, Fitness(target, parent));
        }

        Console.WriteLine("END: #{0,6} {1,20}", i, parent);
    }
}


<?php

function markov($text, $ruleset) {
    $lines = explode(PHP_EOL, $ruleset);
    $rules = array();
    foreach ($lines AS $line) {
        $spc = "[\t ]+";
        if (empty($line) OR preg_match('/^#/', $line)) {
            continue;
        } elseif (preg_match('/^(.+)' . $spc . '->' . $spc . '(\.?)(.*)$/', $line, $matches)) {
            list($dummy, $pattern, $terminating, $replacement) = $matches;
            $rules[] = array(
                'pattern'     => trim($pattern),
                'terminating' => ($terminating === '.'),
                'replacement' => trim($replacement),
            );
        }
    }
    do {
        $found = false;
        foreach ($rules AS $rule) {
            if (strpos($text, $rule['pattern']) !== FALSE) {
                $text = str_replace($rule['pattern'], $rule['replacement'], $text);
                if ($rule['terminating']) {
                    return $text;
                }
                $found = true;
                break;
            }
        }
    } while($found);
    return $text;
}

$conf = array(
    1 => array(
        'text' => 'I bought a B of As from T S.',
        'rule' => '
            # This rules file is extracted from Wikipedia:
            # http://en.wikipedia.org/wiki/Markov_Algorithm
            A -> apple
            B -> bag
            S -> shop
            T -> the
            the shop -> my brother
            a never used -> .terminating rule
        ',
    ),
    2 => array(
        'text' => 'I bought a B of As from T S.',
        'rule' => '
            # Slightly modified from the rules on Wikipedia
            A -> apple
            B -> bag
            S -> .shop
            T -> the
            the shop -> my brother
            a never used -> .terminating rule
        ',
    ),
    3 => array(
        'text' => 'I bought a B of As W my Bgage from T S.',
        'rule' => '
            # BNF Syntax testing rules
            A -> apple
            WWWW -> with
            Bgage -> ->.*
            B -> bag
            ->.* -> money
            W -> WW
            S -> .shop
            T -> the
            the shop -> my brother
            a never used -> .terminating rule
        ',
    ),
    4 => array(
        'text' => '_1111*11111_',
        'rule' => '
            ### Unary Multiplication Engine, for testing Markov Algorithm implementations
            ### By Donal Fellows.
            # Unary addition engine
            _+1 -> _1+
            1+1 -> 11+
            # Pass for converting from the splitting of multiplication into ordinary
            # addition
            1! -> !1
            ,! -> !+
            _! -> _
            # Unary multiplication by duplicating left side, right side times
            1*1 -> x,@y
            1x -> xX
            X, -> 1,1
            X1 -> 1X
            _x -> _X
            ,x -> ,X
            y1 -> 1y
            y_ -> _
            # Next phase of applying
            [email protected] -> x,@y
            [email protected]_ -> @_
            ,@_ -> !_
            ++ -> +
            # Termination cleanup for addition
            _1 -> 1
            1+_ -> 1
            _+_ ->
        ',
    ),
    5 => array(
        'text' => '000000A000000',
        'rule' => '
            # Turing machine: three-state busy beaver
            #
            # state A, symbol 0 => write 1, move right, new state B
            A0 -> 1B
            # state A, symbol 1 => write 1, move left, new state C
            0A1 -> C01
            1A1 -> C11
            # state B, symbol 0 => write 1, move left, new state A
            0B0 -> A01
            1B0 -> A11
            # state B, symbol 1 => write 1, move right, new state B
            B1 -> 1B
            # state C, symbol 0 => write 1, move left, new state B
            0C0 -> B01
            1C0 -> B11
            # state C, symbol 1 => write 1, move left, halt
            0C1 -> H01
            1C1 -> H11
        ',
    ),
    6 => array(
        'text' => '101',
        'rule' => '
            # Another example extracted from Wikipedia:
            # http://en.wikipedia.org/wiki/Markov_Algorithm
            1  -> 0|
            |0 -> 0||
            0  ->
        ',
    ),
);

foreach ($conf AS $id => $rule) {
    echo 'Ruleset ', $id, ' : ', markov($rule['text'], $rule['rule']), PHP_EOL;
}


set L to {3, 2, 1, 0, -1, -2, -3}

set evens to {}
set odds to {}

repeat with x in L
    if (x mod 2 = 0) then
        set the end of evens to x's contents
    else
        set the end of odds to x's contents
    end if
end repeat

return {even:evens, odd:odds}


on fact (n)
  if n<=1 then return 1
  return n * fact(n-1)
end


- factorial x : INTEGER : INTEGER <- (
  + result : INTEGER;
  (x <= 1).if {
    result := 1;
  } else {
    result := x * factorial(x - 1);
  };
  result
);


use std::f64::consts::PI;

extern crate num_complex;
use num_complex::Complex;

fn main() {
    println!("{:e}", Complex::new(0.0, PI).exp() + 1.0);
}


import spire.math.{Complex, Real}

object Scratch extends App{
  //Declare values with friendly names to clean up the final expression
  val e = Complex[Real](Real.e, 0)
  val pi = Complex[Real](Real.pi, 0)
  val i = Complex[Real](0, 1)
  val one = Complex.one[Real]

  println(e.pow(pi*i) + one)
}


#include <string>
#include <cstdlib>
#include <iostream>
#include <cassert>
#include <algorithm>
#include <vector>
#include <ctime>

std::string allowed_chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";

// class selection contains the fitness function, encapsulates the
// target string and allows access to it's length. The class is only
// there for access control, therefore everything is static. The
// string target isn't defined in the function because that way the
// length couldn't be accessed outside.
class selection
{
public:
  // this function returns 0 for the destination string, and a
  // negative fitness for a non-matching string. The fitness is
  // calculated as the negated sum of the circular distances of the
  // string letters with the destination letters.
  static int fitness(std::string candidate)
  {
    assert(target.length() == candidate.length());

    int fitness_so_far = 0;

    for (int i = 0; i < target.length(); ++i)
    {
      int target_pos = allowed_chars.find(target[i]);
      int candidate_pos = allowed_chars.find(candidate[i]);
      int diff = std::abs(target_pos - candidate_pos);
      fitness_so_far -= std::min(diff, int(allowed_chars.length()) - diff);
    }

    return fitness_so_far;
  }

  // get the target string length
  static int target_length() { return target.length(); }
private:
  static std::string target;
};

std::string selection::target = "METHINKS IT IS LIKE A WEASEL";

// helper function: cyclically move a character through allowed_chars
void move_char(char& c, int distance)
{
  while (distance < 0)
    distance += allowed_chars.length();
  int char_pos = allowed_chars.find(c);
  c = allowed_chars[(char_pos + distance) % allowed_chars.length()];
}

// mutate the string by moving the characters by a small random
// distance with the given probability
std::string mutate(std::string parent, double mutation_rate)
{
  for (int i = 0; i < parent.length(); ++i)
    if (std::rand()/(RAND_MAX + 1.0) < mutation_rate)
    {
      int distance = std::rand() % 3 + 1;
      if(std::rand()%2 == 0)
        move_char(parent[i], distance);
      else
        move_char(parent[i], -distance);
    }
  return parent;
}

// helper function: tell if the first argument is less fit than the
// second
bool less_fit(std::string const& s1, std::string const& s2)
{
  return selection::fitness(s1) < selection::fitness(s2);
}

int main()
{
  int const C = 100;

  std::srand(time(0));

  std::string parent;
  for (int i = 0; i < selection::target_length(); ++i)
  {
    parent += allowed_chars[std::rand() % allowed_chars.length()];
  }

  int const initial_fitness = selection::fitness(parent);

  for(int fitness = initial_fitness;
      fitness < 0;
      fitness = selection::fitness(parent))
  {
    std::cout << parent << ": " << fitness << "\n";
    double const mutation_rate = 0.02 + (0.9*fitness)/initial_fitness;
    std::vector<std::string> childs;
    childs.reserve(C+1);

    childs.push_back(parent);
    for (int i = 0; i < C; ++i)
      childs.push_back(mutate(parent, mutation_rate));

    parent = *std::max_element(childs.begin(), childs.end(), less_fit);
  }
  std::cout << "final string: " << parent << "\n";
}


(de markov (File Text)
   (use (@A @Z R)
      (let Rules
         (make
            (in File
               (while (skip "#")
                  (when (match '(@A " " "-" ">" " " @Z) (replace (line) "@" "#"))
                     (link (cons (clip @A) (clip @Z))) ) ) ) )
         (setq Text (chop Text))
         (pack
            (loop
               (NIL
                  (find
                     '((R) (match (append '(@A) (car R) '(@Z)) Text))
                     Rules )
                  Text )
               (T (= "." (cadr (setq R @)))
                  (append @A (cddr R) @Z) )
               (setq Text (append @A (cdr R) @Z)) ) ) ) ) )


:- module('markov.pl', [markov/3, apply_markov/3]).

:- use_module(library(lambda)).

apply_markov(Rules, Sentence, Replacement) :-
    maplist(\X^Y^(atom_chars(X, Ch), phrase(markov(Y), Ch, [])), Rules, TmpRules),
    % comments produce empty rules
    exclude(=([]), TmpRules, LstRules),

    atom_chars(Sentence, L),
    apply_rules(L, LstRules, R),
    atom_chars(Replacement, R).

apply_rules(In, Rules, Out ) :-
    apply_one_rule(In, Rules, Out1, Keep_On),
    (   Keep_On = false
    ->  Out = Out1
    ;   apply_rules(Out1, Rules, Out)).

apply_one_rule(In, [Rule | Rules], Out, Keep_On) :-
    extract(Rule, In, Out1, KeepOn),
    (   KeepOn = false
    ->  Out = Out1, Keep_On = KeepOn
    ;   (KeepOn = stop
        ->  Out = Out1,
        Keep_On = true
        ;   apply_one_rule(Out1, Rules, Out, Keep_On))).

apply_one_rule(In, [], In, false) .

extract([Pattern, Replace], In, Out, Keep_On) :-
    (   Replace = [.|Rest]
    ->  R = Rest
    ;   R = Replace),
    (   (append(Pattern, End, T), append(Deb, T, In))
    ->  extract([Pattern, Replace], End, NewEnd, _Keep_On),
        append_3(Deb, R, NewEnd, Out),
        Keep_On = stop
    ;   Out = In,
        (   R = Replace
        ->  Keep_On = true
        ;   Keep_On = false)).

append_3(A, B, C, D) :-
           append(A, B, T),
           append(T, C, D).

% creation of the rules
markov(A) --> line(A).

line(A) --> text(A), newline.

newline --> ['\n'], newline.
newline --> [].

text([]) --> comment([]).
text(A) --> rule(A).

comment([]) --> ['#'], anything.

anything --> [X], {X \= '\n'}, anything.
anything --> ['\n'].
anything --> [].

rule([A,B]) -->
    pattern(A), whitespaces, ['-', '>'], whitespaces, end_rule(B).

pattern([X | R]) --> [X], {X \= '\n'}, pattern(R).
pattern([]) --> [].

whitespaces --> ['\t'], whitespace.
whitespaces --> [' '], whitespace.

whitespace --> whitespaces.
whitespace --> [].

end_rule([.| A]) --> [.], rest_of_rule(A).
end_rule(A) --> rest_of_rule(A).
end_rule([]) --> [].

rest_of_rule(A) --> replacement(A).

replacement([X | R]) --> [X], {X \= '\n'}, replacement(R).
replacement([]) --> [].


( input , "Please enter a number: " )

{ @input % 2 = 0 ,

	"| @input | is even!"
,
	"| @input | is odd!"
}


/* ARM assembly Raspberry PI  or android 32 bits */
/*  program oddEven.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResultOdd:        .asciz " @  is odd (impair) \n"
sMessResultEven:       .asciz " @  is even (pair)  \n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 @ entry of program

    mov r0,#5
    bl testOddEven
    mov r0,#12
    bl testOddEven
    mov r0,#2021
    bl testOddEven
100:                                  @ standard end of the program
    mov r0, #0                        @ return code
    mov r7, #EXIT                     @ request to exit program
    svc #0                            @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResultOdd:       .int sMessResultOdd
iAdrsMessResultEven:      .int sMessResultEven
iAdrsZoneConv:            .int sZoneConv
/***************************************************/
/*     test if number is odd or even               */
/***************************************************/
// r0 contains à number
testOddEven:
    push {r2-r8,lr}             @ save  registers
    tst r0,#1                   @ test bit 0 to one
    beq 1f                      @ if result are all zéro, go to even
    ldr r1,iAdrsZoneConv        @ else display odd message
    bl conversion10             @ call decimal conversion
    ldr r0,iAdrsMessResultOdd
    ldr r1,iAdrsZoneConv        @ insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    b 100f
1:
    ldr r1,iAdrsZoneConv
    bl conversion10             @ call decimal conversion
    ldr r0,iAdrsMessResultEven
    ldr r1,iAdrsZoneConv        @ insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
100:
    pop {r2-r8,lr}             @ restaur registers
    bx lr                      @ return
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


function FibonacciNumber ( $count )
{
    $answer = @(0,1)
    while ($answer.Length -le $count)
    {
        $answer += $answer[-1] + $answer[-2]
    }
    return $answer
}


// Little Man Computer
// Reads an integer n and prints n factorial
// Works for n = 0..6
        LDA one    // initialize factorial to 1
        STA fac
        INP        // get n from user
        BRZ done   // if n = 0, return 1
        STA n      // else store n
        LDA one    // initialize k = 1
outer   STA k      // outer loop: store latest k
        LDA n      // test for k = n
        SUB k
        BRZ done   // done if so
        LDA fac    // save previous factorial
        STA prev
        LDA k      // initialize i = k
inner   STA i      // inner loop: store latest i
        LDA fac    // build factorial by repeated addition
        ADD prev
        STA fac
        LDA i      // decrement i
        SUB one
        BRZ next_k // if i = 0, move on to next k
        BRA inner  // else loop for another addition
next_k  LDA k      // increment k
        ADD one
        BRA outer  // back to start of outer loop
done    LDA fac    // done, load the result
        OUT        // print it
        HLT        // halt
n       DAT 0      // input value
k       DAT 0      // outer loop counter, 1 up to n
i       DAT 0      // inner loop counter, k down to 0
fac     DAT 0      // holds k!, i.e. n! when done
prev    DAT 0      // previous value of fac
one     DAT 1      // constant 1
// end


// recursive
function factorialr n
    if n < 2 then
        return 1
    else
        return n * factorialr(n-1)
    end if
end factorialr

// using accumulator
function factorialacc n acc
    if n = 0 then
        return acc
    else
        return factorialacc(n-1, n * acc)
    end if
end factorialacc

function factorial n
    return factorialacc(n,1)
end factorial

// iterative
function factorialit n
    put 1 into f
    if n > 1 then
        repeat with i = 1 to n
            multiply f by i
        end repeat
    end if
    return f
end factorialit


; A way to get pi.
(define pi (acos -1))

; Print the value of e^(i*pi) + 1 -- should be 0.
(printf "e^(i*pi) + 1 = ~a~%" (+ (exp (* +i pi)) 1))


say ('e**iπ + 1 ≅ 0 : ', Num.e**Num.pi.i + 1 ≅ 0)
say ('Error: ', Num.e**Num.pi.i + 1)


# Set up complex sandbox (since we're doing a star import)
namespace eval complex_ns {
    package require math::complexnumbers
    namespace import ::math::complexnumbers::*

    set pi [expr {acos(-1)}]

    set r [+ [exp [complex 0 $pi]] [complex 1 0]]
    puts "e**(pi*i) = [real $r]+[imag $r]i"
}


import "/complex" for Complex

System.print((Complex.new(0, Num.pi).exp + Complex.one).toString)


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
Z,pi,e := GSL.Z, (0.0).pi, (0.0).e;

println("e^(\u03c0i) + 1 = %s \u2245 0".fmt( Z(e).pow(Z(0,1)*pi) + 1 ));
println("TMI: ",(Z(e).pow(Z(0,1)*pi) + 1 ).format(0,25,"g"));


import ceylon.random {

	DefaultRandom
}

shared void run() {

	value mutationRate = 0.05;
	value childrenPerGeneration = 100;
	value target = "METHINKS IT IS LIKE A WEASEL";
	value alphabet = {' ', *('A'..'Z')};
	value random = DefaultRandom();

	value randomLetter => random.nextElement(alphabet);

	function fitness(String a, String b) =>
			count {for([c1, c2] in zipPairs(a, b)) c1 == c2};

	function mutate(String string) =>
			String {
				for(letter in string)
				if(random.nextFloat() < mutationRate)
				then randomLetter
				else letter
			};

	function makeCopies(String string) =>
			{for(i in 1..childrenPerGeneration) mutate(string)};

	function chooseFittest(String+ children) =>
			children
			.map((String element) => element->fitness(element, target))
			.max(increasingItem)
			.key;

	variable value parent = String {for(i in 1..target.size) randomLetter};
	variable value generationCount = 0;
	function display() => print("``generationCount``: ``parent``");

	display();
	while(parent != target) {
		parent = chooseFittest(parent, *makeCopies(parent));
		generationCount++;
		display();
	}

	print("mutated into target in ``generationCount`` generations!");

}


(def c 100)  ;number of children in each generation
(def p 0.05) ;mutation probability

(def target "METHINKS IT IS LIKE A WEASEL")
(def tsize (count target))

(def alphabet " ABCDEFGHIJLKLMNOPQRSTUVWXYZ")


Structure mRule
  pattern.s
  replacement.s
  isTerminal.i
EndStructure

Procedure parseRule(text.s, List rules.mRule())
  #tab = 9: #space = 32: #whiteSpace$ = Chr(#space) + Chr(#tab)
  Protected tLen, cPtr, nChar.c, pEnd, pLast, pattern.s

  cPtr = 1
  If FindString(#whiteSpace$, Left(text, cPtr), 1): ProcedureReturn 0: EndIf ;parse error
  If Left(text, cPtr) = "#": ProcedureReturn 2: EndIf ;comment skipped

  tLen = Len(text)
  Repeat
    cPtr + 1
    If cPtr > tLen: ProcedureReturn 0: EndIf ;parse error
    nChar = Asc(Mid(text, cPtr, 1))
    Select nChar
      Case #space, #tab
        Select pEnd
          Case 0 To 2
            pEnd = 1
            pLast = cPtr - 1
          Case 3
            pattern = Left(text, pLast)
        EndSelect
      Case '-'
        If pEnd = 1: pEnd = 2: EndIf
      Case '>'
        If pEnd = 2: pEnd = 3: EndIf
    EndSelect
  Until pattern <> ""

  Repeat
    cPtr + 1
  Until Not FindString(#whiteSpace$, Mid(text, cPtr, 1), 1)
  Protected isTerminal
  If Mid(text, cPtr, 1) = "."
    isTerminal = #True: cPtr + 1
  EndIf

  LastElement(rules()): AddElement(rules())
  rules()\pattern = pattern
  rules()\replacement = Right(text, tLen - cPtr + 1)
  rules()\isTerminal = isTerminal
  ProcedureReturn 1 ;processed rule
EndProcedure

Procedure.s interpretMarkov(text.s, List rules.mRule())
  Repeat
    madeReplacement = #False
    ForEach rules()
      If FindString(text, rules()\pattern, 1)
        text = ReplaceString(text, rules()\pattern, rules()\replacement)
        madeReplacement = #True: isFinished = rules()\isTerminal
        Break
      EndIf
    Next
  Until Not madeReplacement Or isFinished
  ProcedureReturn text
EndProcedure

Procedure addRule(text.s, List rules.mRule())
  Protected result = parseRule(text, rules())
  Select result
    Case 0: AddGadgetItem(7, -1, "Invalid rule: " + #DQUOTE$ + text + #DQUOTE$)
    Case 1: AddGadgetItem(7, -1, "Added: " + #DQUOTE$ + text + #DQUOTE$)
    Case 2: AddGadgetItem(7, -1, "Comment: " + #DQUOTE$ + text + #DQUOTE$)
  EndSelect
EndProcedure

OpenWindow(0, 0, 0, 350, 300, "Markov Algorithm Interpreter", #PB_Window_SystemMenu)
ButtonGadget(0, 45, 10, 75, 20, "Load Ruleset")
ButtonGadget(1, 163, 10, 65, 20, "Add Rule")
ButtonGadget(2, 280, 10, 65, 20, "Interpret")
TextGadget(3, 5, 40, 30, 20, "Input:")
StringGadget(4, 45, 40, 300, 20,"")
TextGadget(5, 5, 100, 35, 20, "Output:")
ButtonGadget(6, 160, 70, 70, 20, "Clear Output")
EditorGadget(7, 45, 100, 300, 195, #PB_Editor_ReadOnly)

NewList rules.mRule()
Define event, isDone, text.s, result, file.s
Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Define file.s, rule.s
          file = OpenFileRequester("Select rule set", "*.txt", "Text (*.txt)|*.txt", 0)
          If file
            ClearList(rules())
            ReadFile(0, file)
            While Not(Eof(0))
              addRule(ReadString(0), rules())
            Wend
            AddGadgetItem(7, -1, "Loaded " +  Str(ListSize(rules())) + " rules."): AddGadgetItem(7, -1, "")
          EndIf
        Case 1
          addRule(GetGadgetText(4), rules())
        Case 2
          text = GetGadgetText(4): AddGadgetItem(7, -1, "Interpret: " + #DQUOTE$ + text + #DQUOTE$)
          AddGadgetItem(7, -1, "Result: " + #DQUOTE$ + interpretMarkov(text, rules()) + #DQUOTE$): AddGadgetItem(7, -1, "")
        Case 6
          ClearGadgetItems(7)
      EndSelect
    Case #PB_Event_CloseWindow
      isDone = #True
  EndSelect
Until isDone


LISTEN TO ME VERY CAREFULLY isOdd
I NEED YOUR CLOTHES YOUR BOOTS AND YOUR MOTORCYCLE n
GIVE THESE PEOPLE AIR
HEY CHRISTMAS TREE result
YOU SET US UP @I LIED
GET TO THE CHOPPER result
HERE IS MY INVITATION n
I LET HIM GO 2
ENOUGH TALK
I'LL BE BACK result
HASTA LA VISTA, BABY

LISTEN TO ME VERY CAREFULLY showParity
I NEED YOUR CLOTHES YOUR BOOTS AND YOUR MOTORCYCLE n
TALK TO THE HAND n
HEY CHRISTMAS TREE parity
YOU SET US UP @I LIED
GET YOUR A** TO MARS parity
DO IT NOW isOdd n
BECAUSE I'M GOING TO SAY PLEASE parity
TALK TO THE HAND "odd"
BULLS***
TALK TO THE HAND "even"
YOU HAVE NO RESPECT FOR LOGIC
TALK TO THE HAND ""
HASTA LA VISTA, BABY

IT'S SHOWTIME
DO IT NOW showParity 5
DO IT NOW showParity 6
DO IT NOW showParity -11
YOU HAVE BEEN TERMINATED


loop (neg 5)..5 [x][
	if? even? x -> print [pad to :string x 4 ": even"]
	else -> print [pad to :string x 4 ": odd"]
]


void setup() {
  size(400, 400);
  fill(255, 64);
  frameRate(2);
}
void draw() {
  int num = fibonacciNum(frameCount);
  println(frameCount, num);
  rect(0,0,num, num);
  if(frameCount==14) frameCount = -1; // restart
}
int fibonacciNum(int n) {
  return (n < 2) ? n : fibonacciNum(n - 1) + fibonacciNum(n - 2);
}


; ModuleID = 'factorial.c'
; source_filename = "factorial.c"
; target datalayout = "e-m:w-i64:64-f80:128-n8:16:32:64-S128"
; target triple = "x86_64-pc-windows-msvc19.21.27702"

; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

; Additional comments have been inserted, as well as changes made from the output produced by clang such as putting more meaningful labels for the jumps

$"\[email protected][email protected][email protected]" = comdat any

@"\[email protected][email protected][email protected]" = linkonce_odr unnamed_addr constant [5 x i8] c"%ld\0A\00", comdat, align 1

;--- The declaration for the external C printf function.
declare i32 @printf(i8*, ...)

; Function Attrs: noinline nounwind optnone uwtable
define i32 @factorial(i32) #0 {
;-- local copy of n
  %2 = alloca i32, align 4
;-- long result
  %3 = alloca i32, align 4
;-- int i
  %4 = alloca i32, align 4
;-- local n = parameter n
  store i32 %0, i32* %2, align 4
;-- result = 1
  store i32 1, i32* %3, align 4
;-- i = 1
  store i32 1, i32* %4, align 4
  br label %loop

loop:
;-- i <= n
  %5 = load i32, i32* %4, align 4
  %6 = load i32, i32* %2, align 4
  %7 = icmp sle i32 %5, %6
  br i1 %7, label %loop_body, label %exit

loop_body:
;-- result *= i
  %8 = load i32, i32* %4, align 4
  %9 = load i32, i32* %3, align 4
  %10 = mul nsw i32 %9, %8
  store i32 %10, i32* %3, align 4
  br label %loop_increment

loop_increment:
;-- ++i
  %11 = load i32, i32* %4, align 4
  %12 = add nsw i32 %11, 1
  store i32 %12, i32* %4, align 4
  br label %loop

exit:
;-- return result
  %13 = load i32, i32* %3, align 4
  ret i32 %13
}

; Function Attrs: noinline nounwind optnone uwtable
define i32 @main() #0 {
;-- factorial(5)
  %1 = call i32 @factorial(i32 5)
;-- printf("%ld\n", factorial(5))
  %2 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([5 x i8], [5 x i8]* @"\[email protected][email protected][email protected]", i32 0, i32 0), i32 %1)
;-- return 0
  ret i32 0
}

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }

!llvm.module.flags = !{!0, !1}
!llvm.ident = !{!2}

!0 = !{i32 1, !"wchar_size", i32 2}
!1 = !{i32 7, !"PIC Level", i32 2}
!2 = !{!"clang version 6.0.1 (tags/RELEASE_601/final)"}


fitness = proc (s, t: string) returns (int)
    f: int := 0
    for i: int in int$from_to(1,string$size(s)) do
        if s[i] ~= t[i] then f := f-1 end
    end
    return(f)
end fitness

mutate = proc (mut: int, s: string) returns (string)
    own charset: string := " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    out: array[char] := array[char]$predict(1,string$size(s))
    for c: char in string$chars(s) do
        if random$next(10000) < mut then
            c := charset[1+random$next(string$size(charset))]
        end
        array[char]$addh(out,c)
    end
    return(string$ac2s(out))
end mutate

weasel = iter (mut, c: int, tgt: string) yields (string)
    own charset: string := " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    start: array[char] := array[char]$[]
    for i: int in int$from_to(1,string$size(tgt)) do
        array[char]$addh(start,charset[1+random$next(string$size(charset))])
    end
    cur: string := string$ac2s(start)
    while true do
        yield(cur)
        if cur = tgt then break end
        best: string := cur
        best_fitness: int := fitness(cur, tgt)
        for i: int in int$from_to(2,c) do
            next: string := mutate(mut, cur)
            next_fitness: int := fitness(next, tgt)
            if best_fitness <= next_fitness then
                best, best_fitness := next, next_fitness
            end
        end
        cur := best
    end
end weasel

start_up = proc ()
    d: date := now()
    random$seed(d.second + 60*(d.minute + 60*d.hour))
    po: stream := stream$primary_output()
    for m: string in weasel(100, 1000, "METHINKS IT IS LIKE A WEASEL") do
        stream$putl(po, m)
    end
end start_up


identification division.
program-id. evolutionary-program.
data division.
working-storage section.
01  evolving-strings.
    05 target                pic a(28)
        value 'METHINKS IT IS LIKE A WEASEL'.
    05 parent                pic a(28).
    05 offspring-table.
        10 offspring         pic a(28)
            occurs 50 times.
01  fitness-calculations.
    05 fitness               pic 99.
    05 highest-fitness       pic 99.
    05 fittest               pic 99.
01  parameters.
    05 character-set         pic a(27)
        value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '.
    05 size-of-generation    pic 99
        value 50.
    05 mutation-rate         pic 99
        value 5.
01  counters-and-working-variables.
    05 character-position    pic 99.
    05 randomization.
        10 random-seed       pic 9(8).
        10 random-number     pic 99.
        10 random-letter     pic 99.
    05 generation            pic 999.
    05 child                 pic 99.
    05 temporary-string      pic a(28).
procedure division.
control-paragraph.
    accept random-seed from time.
    move function random(random-seed) to random-number.
    perform random-letter-paragraph,
    varying character-position from 1 by 1
    until character-position is greater than 28.
    move temporary-string to parent.
    move zero to generation.
    perform output-paragraph.
    perform evolution-paragraph,
    varying generation from 1 by 1
    until parent is equal to target.
    stop run.
evolution-paragraph.
    perform mutation-paragraph varying child from 1 by 1
    until child is greater than size-of-generation.
    move zero to highest-fitness.
    move 1 to fittest.
    perform check-fitness-paragraph varying child from 1 by 1
    until child is greater than size-of-generation.
    move offspring(fittest) to parent.
    perform output-paragraph.
output-paragraph.
    display generation ': ' parent.
random-letter-paragraph.
    move function random to random-number.
    divide random-number by 3.80769 giving random-letter.
    add 1 to random-letter.
    move character-set(random-letter:1)
    to temporary-string(character-position:1).
mutation-paragraph.
    move parent to temporary-string.
    perform character-mutation-paragraph,
    varying character-position from 1 by 1
    until character-position is greater than 28.
    move temporary-string to offspring(child).
character-mutation-paragraph.
    move function random to random-number.
    if random-number is less than mutation-rate
    then perform random-letter-paragraph.
check-fitness-paragraph.
    move offspring(child) to temporary-string.
    perform fitness-paragraph.
fitness-paragraph.
    move zero to fitness.
    perform character-fitness-paragraph,
    varying character-position from 1 by 1
    until character-position is greater than 28.
    if fitness is greater than highest-fitness
    then perform fittest-paragraph.
character-fitness-paragraph.
    if temporary-string(character-position:1) is equal to
    target(character-position:1) then add 1 to fitness.
fittest-paragraph.
    move fitness to highest-fitness.
    move child to fittest.


import re

def extractreplacements(grammar):
    return [ (matchobj.group('pat'), matchobj.group('repl'), bool(matchobj.group('term')))
                for matchobj in re.finditer(syntaxre, grammar)
                if matchobj.group('rule')]

def replace(text, replacements):
    while True:
        for pat, repl, term in replacements:
            if pat in text:
                text = text.replace(pat, repl, 1)
                if term:
                    return text
                break
        else:
            return text

syntaxre = r"""(?mx)
^(?:
  (?: (?P<comment> \# .* ) ) |
  (?: (?P<blank>   \s*  ) (?: \n | $ )  ) |
  (?: (?P<rule>    (?P<pat> .+? ) \s+ -> \s+ (?P<term> \.)? (?P<repl> .+) ) )
)$
"""

grammar1 = """\
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"""

grammar2 = '''\
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
'''

grammar3 = '''\
# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
'''

grammar4 = '''\
### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
'''

grammar5 = '''\
# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
'''

text1 = "I bought a B of As from T S."

text2 = "I bought a B of As W my Bgage from T S."

text3 = '_1111*11111_'

text4 = '000000A000000'

if __name__ == '__main__':
    assert replace(text1, extractreplacements(grammar1)) \
           == 'I bought a bag of apples from my brother.'
    assert replace(text1, extractreplacements(grammar2)) \
           == 'I bought a bag of apples from T shop.'
    # Stretch goals
    assert replace(text2, extractreplacements(grammar3)) \
           == 'I bought a bag of apples with my money from T shop.'
    assert replace(text3, extractreplacements(grammar4)) \
           == '11111111111111111111'
    assert replace(text4, extractreplacements(grammar5)) \
           == '00011H1111000'


for (int i = 1; i <= 10; ++i)  {
  if (i % 2 == 0) {
    write(string(i), " is even");
  } else {
    write(string(i), " is odd");
  }
}


if ( int & 1 ){
	; do odd stuff
}else{
	; do even stuff
}


to factorial :n
  if :n < 2 [output 1]
  output :n * factorial :n-1
end


HAI 1.3

HOW IZ I Faktorial YR Number
  BOTH SAEM 1 AN BIGGR OF Number AN 1
  O RLY?
   YA RLY
    FOUND YR 1
   NO WAI
    FOUND YR PRODUKT OF Number AN I IZ Faktorial YR DIFFRENCE OF Number AN 1 MKAY
  OIC
IF U SAY SO

IM IN YR LOOP UPPIN YR Index WILE DIFFRINT Index AN 13
  VISIBLE Index "! = " I IZ Faktorial YR Index MKAY
IM OUTTA YR LOOP
KTHXBYE


<Cfset theString = 'METHINKS IT IS LIKE A WEASEL'>
<cfparam name="parent" default="">
<Cfset theAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ">
<Cfset fitness = 0>
<Cfset children = 3>
<Cfset counter = 0>

<Cfloop from="1" to="#children#" index="child">
  <Cfparam name="child#child#" default="">
  <Cfparam name="fitness#child#" default=0>
</Cfloop>

<Cfloop condition="fitness lt 1">

  <Cfset oldparent = parent>
  <Cfset counter = counter + 1>

  <cfloop from="1" to="#children#" index="child">
    <Cfset thischild = ''>

    <Cfloop from="1" to="#len(theString)#" index="i">
      <cfset Mutate = Mid(theAlphabet, RandRange(1, 28), 1)>
      <cfif fitness eq 0>
        <Cfset thischild = thischild & mutate>
      <Cfelse>

        <Cfif Mid(theString, i, 1) eq Mid(variables["child" & child], i, 1)>
          <Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
        <Cfelse>
          <cfset MutateChance = 1/fitness>
          <Cfset MutateChanceRand = rand()>
          <Cfif MutateChanceRand lte MutateChance>
            <Cfset thischild = thischild & mutate>
          <Cfelse>
            <Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
          </Cfif>
        </Cfif>

      </cfif>
    </Cfloop>

    <Cfset variables["child" & child] = thischild>

</cfloop>

  <cfloop from="1" to="#children#" index="child">
    <Cfset thisChildFitness = 0>
    <Cfloop from="1" to="#len(theString)#" index="i">
      <Cfif Mid(variables["child" & child], i, 1) eq Mid(theString, i, 1)>
        <Cfset thisChildFitness = thisChildFitness + 1>
      </Cfif>
    </Cfloop>

    <Cfset variables["fitness" & child] = (thisChildFitness)/len(theString)>

    <Cfif variables["fitness" & child] gt fitness>
      <Cfset fitness = variables["fitness" & child]>
      <Cfset parent = variables["child" & child]>
    </Cfif>

  </cfloop>

  <Cfif parent neq oldparent>
    <Cfoutput>###counter# #numberformat(fitness*100, 99)#% fit: #parent#<br></Cfoutput><cfflush>
  </Cfif>

</Cfloop>


#lang racket

(struct ->  (A B))
(struct ->. (A B))

(define ((Markov-algorithm . rules) initial-string)
  (let/cc stop
    ; rewriting rules
    (define (rewrite rule str)
      (match rule
        [(->  a b) (cond [(replace a str b) => apply-rules]
                         [else str])]
        [(->. a b) (cond [(replace a str b) => stop]
                         [else str])]))
    ; the cycle through rewriting rules
    (define (apply-rules s) (foldl rewrite s rules))
    ; the result is a fixed point of rewriting procedure
    (fixed-point apply-rules initial-string)))

;; replaces the first substring A to B in a string s
(define (replace A s B)
  (and (regexp-match? (regexp-quote A) s)
       (regexp-replace (regexp-quote A) s B)))

;; Finds the least fixed-point of a function
(define (fixed-point f x0)
  (let loop ([x x0] [fx (f x0)])
    (if (equal? x fx) fx (loop fx (f fx)))))


grammar Markov {
    token TOP {
        ^ [^^ [<rule> | <comment>] $$ [\n|$]]* $
        { make $<rule>>>.ast }
    }
    token comment {
        <before ^^> '#' \N*
        { make Nil }
    }
    token ws {
        [' '|\t]*
    }
    rule rule {
        <before ^^>$<pattern>=[\N+?] '->'
        $<terminal>=[\.]?$<replacement>=[\N*]
        { make {:pattern($<pattern>.Str),
                :replacement($<replacement>.Str),
                :terminal($<terminal>.Str eq ".")} }
    }
}

sub run(:$ruleset, :$start_value, :$verbose?) {
    my $value = $start_value;
    my @rules = Markov.parse($ruleset).ast.list;
    loop {
        my $beginning = $value;
        for @rules {
            my $prev = $value;
            $value = $value.subst(.<pattern>, .<replacement>);
            say $value if $verbose && $value ne $prev;
            return $value if .<terminal>;
            last if $value ne $prev;
        }
        last if $value eq $beginning;
    }
    return $value;
}

multi sub MAIN(Bool :$verbose?) {
    my @rulefiles = dir.grep(/rules.+/).sort;
    for @rulefiles -> $rulefile {
        my $testfile = $rulefile.subst("rules", "test");
        my $start_value = (try slurp($testfile).trim-trailing)
                          // prompt("please give a start value: ");

        my $ruleset = slurp($rulefile);
        say $start_value;
        say run(:$ruleset, :$start_value, :$verbose);
        say '';
    }
}

multi sub MAIN(Str $rulefile where *.IO.f, Str $input where *.IO.f, Bool :$verbose?) {
    my $ruleset = slurp($rulefile);
    my $start_value = slurp($input).trim-trailing;
    say "starting with: $start_value";
    say run(:$ruleset, :$start_value, :$verbose);
}

multi sub MAIN(Str $rulefile where *.IO.f, *@pieces, Bool :$verbose?) {
    my $ruleset = slurp($rulefile);
    my $start_value = @pieces.join(" ");
    say "starting with: $start_value";
    say run(:$ruleset, :$start_value, :$verbose);
}


function isodd(x) {
	return (x%2)!=0;
}

function iseven(x) {
	return (x%2)==0;
}


' Even or odd
OPTION MEMTYPE int
SPLIT ARGUMENT$ BY " " TO arg$ SIZE dim
n = IIF$(dim < 2, 0, VAL(arg$[1]))
PRINT n, " is ", IIF$(EVEN(n), "even", "odd")


fib n = loop 0 1 n with
  loop a b n = if n==0 then a else loop b (a+b) (n-1);
end;


F binomial_coeff(n, k)
   V result = 1
   L(i) 1..k
      result = result * (n - i + 1) / i
   R result

print(binomial_coeff(5, 3))


function fact(n)
  return n > 0 and n * fact(n-1) or 1
end


Module CheckIt {
      Locale 1033 ' ensure #,### print with comma
      Function factorial (n){
            If n<0 then Error "Factorial Error!"
            If n>27 then Error "Overflow"

            [email protected]:While n>1 {m*=n:n--}:=m
      }
      Const Proportional=4
      Const ProportionalLeftJustification=5
      Const NonProportional=0
      Const NonProportionalLeftJustification=1
      For i=1 to 27
      \\ we can print over (erasing line first), without new line at the end
      \\ and we can change how numbers apears, and the with of columns
      \\ numbers by default have right justification
      \\ all $() format have temporary use in this kind of print.
      Print Over $(Proportional),$("\f\a\c\t\o\r\i\a\l\(#\)\=",15), i, $(ProportionalLeftJustification), $("#,###",40), factorial(i)
      Print        \\ new line
      Next i
}
Checkit


10 N=100:P=0.05:TI$="000000"
20 Z$="METHINKS IT IS LIKE A WEASEL"
30 L=LEN(Z$)
40 DIMX(N,L)
50 FORI=1TOL
60 IFMID$(Z$,I,1)=" "THENX(0,I)=0:GOTO80
70 X(0,I)=ASC(MID$(Z$,I))-64
80 NEXT
90 FORK=1TON:FORI=1TOL:X(K,I)=INT(RND(0)*27):NEXT:NEXT
100 S=-100:B=0
110 K=B:GOSUB300
120 FORK=1TON:IFK=BTHEN150
130 FORI=1TOL:IFRND(.)<PTHENX(K,I)=INT(RND(0)*27)
140 NEXT
150 NEXT
160 S=-100:B=0
170 FORK=1TON
180 F=0:FORI=1TOL:IFX(K,I)<>X(0,I)THENF=F-1:IFF<STHENI=L
190 NEXT:IFF>STHENS=F:B=K
200 NEXT
210 PRINT"BEST:"B;"SCORE:"S
220 IFS=0THEN270
230 FORK=1TON:IFK=BTHEN250
240 FORI=1TOL:X(K,I)=X(B,I):NEXT
250 NEXT
260 GOTO110
270 PRINT"WE HAVE A WEASEL!":K=B:GOSUB300
280 PRINT"TIME:"TI$:END
300 FORI=1TOL:IFX(K,I)THENPRINTCHR$(64+X(K,I));:GOTO320
310 PRINT" ";
320 NEXT:PRINT"<":RETURN


/*REXX program executes a  Markov  algorithm(s)  against  specified entries.            */
parse arg low high .                             /*allows which  ruleset  to process.   */
if  low=='' |  low==","  then  low=1             /*Not specified?  Then use the default.*/
if high=='' | high==","  then high=6             /* "      "         "   "   "     "    */
tellE= low<0;          tellR= high<0             /*flags: used to display file contents.*/
call readEntry
               do j=abs(low)  to abs(high)       /*process each of these  rulesets.     */
               call readRules j                  /*read    a particular   ruleset.      */
               call execRules j                  /*execute "     "            "         */
               say 'result for ruleset'      j      "───►"      !.j
               end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
execRules: parse arg q .;           if tellE | tellR  then say      /*show a blank line?*/
             do f=1
                do k=1  while @.k\=='';      if left(@.k, 1)=='#' | @.k=''  then iterate
                parse var  @.k   a   ' ->'    b  /*obtain the  A  &  B  parts from rule.*/
                a=strip(a);      b=strip(b)      /*strip leading and/or trailing blanks.*/
                fullstop= left(b, 1)==.          /*is this a  "fullstop"  rule?   1≡yes */
                if fullstop  then b=substr(b, 2) /*purify the  B  part of the rule.     */
                old=!.q                          /*remember the value before the change.*/
                !.q=changestr(a, !.q, b)         /*implement the  ruleset  change.      */
                if fullstop   then if old\==!.q  then return          /*should we stop? */
                if old\==!.q  then iterate f     /*Has Entry changed?   Then start over.*/
                end   /*k*/
              return
              end     /*f*/
           return
/*──────────────────────────────────────────────────────────────────────────────────────*/
readEntry: eFID= 'MARKOV.ENT';     if tellE  then say               /*show a blank line?*/
           !.=                                   /*placeholder for all the test entries.*/
                  do e=1  while lines(eFID)\==0  /*read the input file until End-Of-File*/
                  !.e=linein(eFID);  if tellE  then say 'test entry'    e    "───►"    !.e
                  end   /*e*/                    /* [↑]  read and maybe echo the entry. */
           return
/*──────────────────────────────────────────────────────────────────────────────────────*/
readRules: parse arg ? .;  rFID= 'MARKOV_R.'?;  if tellR  then say  /*show a blank line?*/
           @.=                                   /*placeholder for all the Markov rules.*/
                  do r=1  while lines(rFID)\==0  /*read the input file until End-Of-File*/
                  @.r=linein(rFID);  if tellR  then say 'ruleSet' ?"."left(r,4) '───►' @.r
                  end   /*r*/                    /* [↑]  read and maybe echo the rule.  */
           return


10 INPUT "ENTER A NUMBER: ";N
20 IF N/2 <> INT(N/2) THEN PRINT "THE NUMBER IS ODD":GOTO 40
30 PRINT "THE NUMBER IS EVEN"
40 END


@echo off
set /p i=Insert number:

::bitwise and
set /a "test1=%i%&1"

::divide last character by 2
set /a test2=%i:~-1%/2

::modulo
set /a test3=%i% %% 2

set test
pause>nul


Macro Fibonacci (n)
	Int((Pow(((1+Sqr(5))/2),n)-Pow(((1-Sqr(5))/2),n))/Sqr(5))
EndMacro


*        Evaluate binomial coefficients - 29/09/2015
BINOMIAL CSECT
         USING  BINOMIAL,R15       set base register
         SR     R4,R4              clear for mult and div
         LA     R5,1               r=1
         LA     R7,1               i=1
         L      R8,N               m=n
LOOP     LR     R4,R7              do while i<=k
         C      R4,K               i<=k
         BH     LOOPEND            if not then exit while
         MR     R4,R8              r*m
         DR     R4,R7              r=r*m/i
         LA     R7,1(R7)           i=i+1
         BCTR   R8,0               m=m-1
         B      LOOP               loop while
LOOPEND  XDECO  R5,PG              edit r
         XPRNT  PG,12              print r
         XR     R15,R15            set return code
         BR     R14                return to caller
N        DC     F'10'              <== input value
K        DC     F'4'               <== input value
PG       DS     CL12               buffer
         YREGS
         END    BINOMIAL


CLASS lcl_binom DEFINITION CREATE PUBLIC.

  PUBLIC SECTION.
    CLASS-METHODS:
      calc
        IMPORTING n               TYPE i
                  k               TYPE i
        RETURNING VALUE(r_result) TYPE f.

ENDCLASS.

CLASS lcl_binom IMPLEMENTATION.

  METHOD calc.

    r_result = 1.
    DATA(i) = 1.
    DATA(m) = n.

    WHILE i <= k.
      r_result = r_result * m / i.
      i = i + 1.
      m = m - 1.
    ENDWHILE.

  ENDMETHOD.

ENDCLASS.


(defun fac (n)
   (if (zp n)
       1
       (* n (fac (1- n)))))

(defun binom (n k)
   (/ (fac n) (* (fac (- n k)) (fac k)))


            NORMAL MODE IS INTEGER

          R   CALCULATE FACTORIAL OF N
            INTERNAL FUNCTION(N)
            ENTRY TO FACT.
            RES = 1
            THROUGH FACMUL, FOR MUL = 2, 1, MUL.G.N
FACMUL      RES = RES * MUL
            FUNCTION RETURN RES
            END OF FUNCTION

          R   USE THE FUNCTION TO PRINT 0! THROUGH 12!
            VECTOR VALUES FMT = $I2,6H ! IS ,I9*$
            THROUGH PRNFAC, FOR NUM = 0, 1, NUM.G.12
PRNFAC      PRINT FORMAT FMT, NUM, FACT.(NUM)

            END OF PROGRAM


(defun fitness (string target)
  "Closeness of string to target; lower number is better"
  (loop for c1 across string
        for c2 across target
        count (char/= c1 c2)))

(defun mutate (string chars p)
  "Mutate each character of string with probablity p using characters from chars"
  (dotimes (n (length string))
    (when (< (random 1.0) p)
      (setf (aref string n) (aref chars (random (length chars))))))
  string)

(defun random-string (chars length)
  "Generate a new random string consisting of letters from char and specified length"
  (do ((n 0 (1+ n))
       (str (make-string length)))
      ((= n length) str)
    (setf (aref str n) (aref chars (random (length chars))))))

(defun evolve-string (target string chars c p)
  "Generate new mutant strings, and choose the most fit string"
  (let ((mutated-strs (list string)))
    (dotimes (n c)
      (push (mutate (copy-seq string) chars p) mutated-strs))
    (reduce #'(lambda (s0 s1)
                (if (< (fitness s0 target)
                       (fitness s1 target))
                    s0
                    s1))
            mutated-strs)))

(defun evolve-gens (target c p)
  (let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
    (do ((parent (random-string chars (length target))
                 (evolve-string target parent chars c p))
         (n 0 (1+ n)))
        ((string= target parent) (format t "Generation ~A: ~S~%" n parent))
      (format t "Generation ~A: ~S~%" n parent))))


def setup(ruleset)
  ruleset.each_line.inject([]) do |rules, line|
    if line =~ /^\s*#/
      rules
    elsif line =~ /^(.+)\s+->\s+(\.?)(.*)$/
      rules << [$1, $3, $2 != ""]
    else
      raise "Syntax error: #{line}"
    end
  end
end

def morcov(ruleset, input_data)
  rules = setup(ruleset)
  while (matched = rules.find { |match, replace, term|
    input_data[match] and input_data.sub!(match, replace)
    }) and !matched[2]
  end
  input_data
end


use std::str::FromStr;

#[derive(Clone, Debug)]
pub struct Rule {
    pub pat: String,
    pub rep: String,
    pub terminal: bool,
}

impl Rule {
    pub fn new(pat: String, rep: String, terminal: bool) -> Self {
        Self { pat, rep, terminal }
    }

    pub fn applicable_range(&self, input: impl AsRef<str>) -> Option<std::ops::Range<usize>> {
        input
            .as_ref()
            .match_indices(&self.pat)
            .next()
            .map(|(start, slice)| start..start + slice.len())
    }

    pub fn apply(&self, s: &mut String) -> bool {
        self.applicable_range(s.as_str()).map_or(false, |range| {
            s.replace_range(range, &self.rep);
            true
        })
    }
}

impl FromStr for Rule {
    type Err = String;

    fn from_str(s: &str) -> Result<Self, Self::Err> {
        let mut split = s.splitn(2, " -> ");
        let pat = split.next().ok_or_else(|| s.to_string())?;
        let rep = split.next().ok_or_else(|| s.to_string())?;

        let pat = pat.to_string();
        if rep.starts_with('.') {
            Ok(Self::new(pat, rep[1..].to_string(), true))
        } else {
            Ok(Self::new(pat, rep.to_string(), false))
        }
    }
}

#[derive(Clone, Debug)]
pub struct Rules {
    rules: Vec<Rule>,
}

impl Rules {
    pub fn new(rules: Vec<Rule>) -> Self {
        Self { rules }
    }

    pub fn apply(&self, s: &mut String) -> Option<&Rule> {
        self.rules
            .iter()
            .find(|rule| rule.apply(s))
    }

    pub fn execute(&self, mut buffer: String) -> String {
        while let Some(rule) = self.apply(&mut buffer) {
            if rule.terminal {
                break;
            }
        }

        buffer
    }
}

impl FromStr for Rules {
    type Err = String;

    fn from_str(s: &str) -> Result<Self, Self::Err> {
        let mut rules = Vec::new();

        for line in s.lines().filter(|line| !line.starts_with('#')) {
            rules.push(line.parse::<Rule>()?);
        }

        Ok(Rules::new(rules))
    }
}

#[cfg(test)]
mod tests {

    use super::Rules;

    #[test]
    fn case_01() -> Result<(), String> {
        let input = "I bought a B of As from T S.";
        let rules = "\
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule";

        assert_eq!(
            rules.parse::<Rules>()?.execute(input.to_string()),
            "I bought a bag of apples from my brother."
        );

        Ok(())
    }

    #[test]
    fn case_02() -> Result<(), String> {
        let input = "I bought a B of As from T S.";
        let rules = "\
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule";

        assert_eq!(
            rules.parse::<Rules>()?.execute(input.to_string()),
            "I bought a bag of apples from T shop."
        );

        Ok(())
    }

    #[test]
    fn case_03() -> Result<(), String> {
        let input = "I bought a B of As W my Bgage from T S.";
        let rules = "\
# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule";

        assert_eq!(
            rules.parse::<Rules>()?.execute(input.to_string()),
            "I bought a bag of apples with my money from T shop."
        );

        Ok(())
    }

    #[test]
    fn case_04() -> Result<(), String> {
        let input = "_1111*11111_";
        let rules = "\
### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ -> ";

        assert_eq!(
            rules.parse::<Rules>()?.execute(input.to_string()),
            "11111111111111111111"
        );

        Ok(())
    }

    #[test]
    fn case_05() -> Result<(), String> {
        let input = "000000A000000";
        let rules = "\
# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11";

        assert_eq!(
            rules.parse::<Rules>()?.execute(input.to_string()),
            "00011H1111000"
        );

        Ok(())
    }
}


      IF FNisodd%(14) PRINT "14 is odd" ELSE PRINT "14 is even"
      IF FNisodd%(15) PRINT "15 is odd" ELSE PRINT "15 is even"
      IF FNisodd#(9876543210#) PRINT "9876543210 is odd" ELSE PRINT "9876543210 is even"
      IF FNisodd#(9876543211#) PRINT "9876543211 is odd" ELSE PRINT "9876543211 is even"
      END

      REM Works for -2^31 <= n% < 2^31
      DEF FNisodd%(n%) = (n% AND 1) <> 0

      REM Works for -2^53 <= n# <= 2^53
      DEF FNisodd#(n#) = n# <> 2 * INT(n# / 2)


i = -3

/* Assumes that i is an integer. */
scale = 0
if (i % 2 == 0) "i is even
"
if (i % 2) "i is odd
"


beads 1 program 'Even or odd'

calc main_init
	loop across:[-10, -5, 10, 5] val:v
		log "{v}\todd:{is_odd(v)}\teven:{is_even(v)}"


data Fib1 = FoldNat
            <
              const (Cons One (Cons One Empty)),
              (uncurry Cons) . ((uncurry Add) . (Head, Head . Tail), id)
            >


with Ada.Text_IO;  use Ada.Text_IO;
procedure Test_Binomial is
   function Binomial (N, K : Natural) return Natural is
      Result : Natural := 1;
      M      : Natural;
   begin
      if N < K then
         raise Constraint_Error;
      end if;
      if K > N/2 then -- Use symmetry
         M := N - K;
      else
         M := K;
      end if;
      for I in 1..M loop
         Result := Result * (N - M + I) / I;
      end loop;
      return Result;
   end Binomial;
begin
   for N in 0..17 loop
      for K in 0..N loop
         Put (Integer'Image (Binomial (N, K)));
      end loop;
      New_Line;
   end loop;
end Test_Binomial;


PROC factorial = (INT n)INT:
(
        INT result;

        result := 1;
        FOR i  TO n DO
                result *:= i
        OD;

        result
);

PROC choose = (INT n, INT k)INT:
(
        INT result;

# Note: code can be optimised here as k < n #
        result := factorial(n) OVER (factorial(k) * factorial(n - k));

        result
);

test:(
        print((choose(5, 3), new line))
)


F bf(source)
   V tape = DefaultDict[Int, Int]()
   V cell = 0
   V ptr = 0
   L ptr < source.len
      S source[ptr]
         ‘>’
            cell++
         ‘<’
            cell--
         ‘+’
            tape[cell]++
         ‘-’
            tape[cell]--
         ‘.’
            :stdout.write(Char(code' tape[cell]))
         ‘,’
            tape[cell] = :stdin.read(1).code
         ‘[’
            I tape[cell] == 0
               V nesting_level = 0
               L
                  S source[ptr]
                     ‘[’
                        nesting_level++
                     ‘]’
                        I --nesting_level == 0
                           L.break
                  ptr++
         ‘]’
            I tape[cell] != 0
               V nesting_level = 0
               L
                  S source[ptr]
                     ‘[’
                        I --nesting_level == 0
                           L.break
                     ‘]’
                        nesting_level++
                  ptr--
      ptr++

bf(‘++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.’)


{ let rec
  { Fact = -- compile-time constant binding
    { proc { N } as -- precondition: N.IsI48[] & (N >= 0)
    : if N == 0 then 1 else
      N * Fact[N - 1]
    }
  }
  in -- use Fact here or just make the whole expression to evaluate to it:
  Fact
}