import std.stdio, std.random, std.algorithm, std.range, std.ascii;

enum target = "METHINKS IT IS LIKE A WEASEL"d;
enum C = 100;  // Number of children in each generation.
enum P = 0.05; // Mutation probability.
enum fitness = (dchar[] s) => target.zip(s).count!q{ a[0] != a[1] };
dchar rnd() { return (uppercase ~ " ")[uniform(0, $)]; }
enum mut = (dchar[] s) => s.map!(a => uniform01 < P ? rnd : a).array;

void main() {
    auto parent = generate!rnd.take(target.length).array;
    for (auto gen = 1; parent != target; gen++) {
        // parent = parent.repeat(C).map!mut.array.max!fitness;
        parent = parent.repeat(C).map!mut.array
                 .minPos!((a, b) => a.fitness < b.fitness)[0];
        writefln("Gen %2d, dist=%2d: %s", gen, parent.fitness, parent);
    }
}


import scala.io.Source

object MarkovAlgorithm {
  val RulePattern = """(.*?)\s+->\s+(\.?)(.*)""".r
  val CommentPattern = """#.*|\s*""".r

  def rule(line: String) = line match {
    case CommentPattern() => None
    case RulePattern(pattern, terminal, replacement) => Some(pattern, replacement, terminal == ".")
    case _ => error("Syntax error on line "+line)
  }

  def main(args: Array[String]) {
    if (args.size != 2 ) {
      println("Syntax: MarkovAlgorithm inputFile inputPattern")
      exit(1)
    }

    val rules = (Source fromPath args(0) getLines () map rule).toList.flatten

    def algorithm(input: String): String = rules find (input contains _._1) match {
      case Some((pattern, replacement, true)) => input replaceFirst ("\\Q"+pattern+"\\E", replacement)
      case Some((pattern, replacement, false)) => algorithm(input replaceFirst ("\\Q"+pattern+"\\E", replacement))
      case None => input
    }

    println(args(1))
    println(algorithm(args(1)))
  }
}


from math import *

def analytic_fibonacci(n):
  sqrt_5 = sqrt(5);
  p = (1 + sqrt_5) / 2;
  q = 1/p;
  return int( (p**n + q**n) / sqrt_5 + 0.5 )

for i in range(1,31):
  print analytic_fibonacci(i),


begin
    % calculates n!/k!                                                       %
    integer procedure factorialOverFactorial( integer value n, k ) ;
        if      k > n then 0
        else if k = n then 1
        else %  k < n %    begin
            integer f;
            f := 1;
            for i := k + 1 until n do f := f * i;
            f
        end factorialOverFactorial ;

    % calculates n!                                                          %
    integer procedure factorial( integer value n ) ;
        begin
            integer f;
            f := 1;
            for i := 2 until n do f := f * i;
            f
        end factorial ;

    % calculates the binomial coefficient of (n k)                           %
    % uses the factorialOverFactorial procedure for a slight optimisation    %
    integer procedure binomialCoefficient( integer value n, k ) ;
        if ( n - k ) > k
        then factorialOverFactorial( n, n - k ) div factorial(   k   )
        else factorialOverFactorial( n,   k   ) div factorial( n - k );

    % display the binomial coefficient of (5 3)                              %
    write( binomialCoefficient( 5, 3 ) )

end.


set n to 5
set k to 3

on calculateFactorial(val)
	set partial_factorial to 1 as integer
	repeat with i from 1 to val
		set factorial to i * partial_factorial
		set partial_factorial to factorial
	end repeat
	return factorial
end calculateFactorial

set n_factorial to calculateFactorial(n)
set k_factorial to calculateFactorial(k)
set n_minus_k_factorial to calculateFactorial(n - k)

return n_factorial / (n_minus_k_factorial) * 1 / (k_factorial) as integer


;
; Brainfuck interpreter by Thorham
;
; 68000+ AmigaOs2+
;
; Cell size is a byte
;
    incdir  "asminc:"

    include "dos/dosextens.i"
    include "lvo/lvos.i"

execBase equ 4

start

; parse command line parameter

    move.l  a0,fileName

    move.b  (a0)+,d0
    beq     exit ; no parameter

    cmp.b   #'"',d0 ; filter out double quotes
    bne     .loop

    addq.l  #1,fileName

.loop
    move.b  (a0)+,d0

    cmp.b   #'"',d0 ; filter out double quotes
    beq     .done

    cmp.b   #32,d0
    bge     .loop

.done
    clr.b   -(a0) ; end of string

; open dos library

    move.l  execBase,a6

    lea     dosName,a1
    moveq   #36,d0
    jsr     _LVOOpenLibrary(a6)
    move.l  d0,dosBase
    beq     exit

; get stdin and stdout handles

    move.l  dosBase,a6

    jsr     _LVOInput(a6)
    move.l  d0,stdIn
    beq     exit

    jsr     _LVOOutput(a6)
    move.l  d0,stdOut
    beq     exit

    move.l  stdIn,d1
    jsr     _LVOFlush(a6)

; open file

    move.l  fileName,d1
    move.l  #MODE_OLDFILE,d2
    jsr     _LVOOpen(a6)
    move.l  d0,fileHandle
    beq     exit

; examine file

    lea     fileInfoBlock,a4

    move.l  fileHandle,d1
    move.l  a4,d2
    jsr     _LVOExamineFH(a6)
    tst.w   d0
    beq     exit

; exit if the file is a folder

    tst.l   fib_DirEntryType(a4)
    bge     exit

; allocate file memory

    move.l  execBase,a6

    move.l  fib_Size(a4),d0
    beq     exit ; exit if file is empty
    clr.l   d1
    jsr     _LVOAllocVec(a6)
    move.l  d0,program
    beq     exit

; read file

    move.l  dosBase,a6

    move.l  fileHandle,d1
    move.l  program,d2
    move.l  fib_Size(a4),d3
    jsr     _LVORead(a6)
    tst     d0
    ble     exit ; exit if read didn't succeed

; close file

    move.l  fileHandle,d1
    jsr     _LVOClose(a6)
    clr.l   fileHandle

; clear tape (bss section is allocated by os but not cleared)

    lea     tape,a0
    lea     tapeEnd,a1

.loopClear
    clr.b   (a0)+
    cmp.l   a0,a1
    bne     .loopClear

; interpreter

    move.l  program,a2
    lea     tape,a3

    clr.l   d2

    move.l  a2,d6 ; start of program
    move.l  a2,d7 ; end of program
    add.l   fib_Size(a4),d7

loop
    move.b  (a2)+,d2

    cmp.b   #">",d2
    beq     .incPtr

    cmp.b   #"<",d2
    beq     .decPtr

    cmp.b   #"+",d2
    beq     .incMem

    cmp.b   #"-",d2
    beq     .decMem

    cmp.b   #".",d2
    beq     .outMem

    cmp.b   #",",d2
    beq     .inMem

    cmp.b   #"[",d2
    beq     .jmpForward

    cmp.b   #"]",d2
    beq     .jmpBack

; next command

.next
    cmp.l   d7,a2 ; test end of program
    blt     loop

; end of program reached

    bra     exit

; command implementations

.incPtr
    addq.l  #1,a3
    cmp.l   #tapeEnd,a3 ; test end of tape
    bge     exit
    bra     .next

.decPtr
    subq.l  #1,a3
    cmp.l   #tape,a3 ; test start of tape
    blt     exit
    bra     .next

.incMem
    addq.b  #1,(a3)
    bra     .next

.decMem
    subq.b  #1,(a3)
    bra     .next

.outMem
    move.l  stdOut,d1
    move.b  (a3),d2
    jsr     _LVOFPutC(a6)
    bra     .next

.inMem
    move.l  stdIn,d1
    jsr     _LVOFGetC(a6)

    cmp.b   #27,d0 ; convert escape to 0
    bne     .notEscape
    moveq   #0,d0
.notEscape
    move.b  d0,(a3)

    bra     .next

.jmpForward
    tst.b   (a3)
    bne     .next

    move.l  a2,a4
    clr.l   d3

.loopf
    cmp.l   d7,a4 ; test end of program
    bge     exit

    move.b  (a4)+,d2

    cmp.b   #"[",d2
    bne     .lf

    addq.l  #1,d3
    bra     .loopf
.lf
    cmp.b   #"]",d2
    bne     .loopf

    subq.l  #1,d3
    bge     .loopf

    move.l  a4,a2
    bra     .next

.jmpBack
    tst.b   (a3)
    beq     .next

    move.l  a2,a4
    clr.l   d3

.loopb
    move.b  -(a4),d2

    cmp.l   d6,a4 ; test start of program
    blt     exit

    cmp.b   #"]",d2
    bne     .lb

    addq.l  #1,d3
    bra     .loopb
.lb
    cmp.b   #"[",d2
    bne     .loopb

    subq.l  #1,d3
    bgt     .loopb

    move.l  a4,a2
    bra     .next

; cleanup and exit

exit
    move.l  dosBase,a6

    move.l  fileHandle,d1
    beq     .noFile
    jsr     _LVOClose(a6)
.noFile

    move.l  execBase,a6

    move.l  program,a1
    tst.l   a1
    beq     .noMem
    jsr     _LVOFreeVec(a6)
.noMem

    move.l  dosBase,a1
    tst.l   a1
    beq     .noLib
    jsr     _LVOCloseLibrary(a6)
.noLib

    rts

; data

    section data,data_p

dosBase
    dc.l    0

fileName
    dc.l    0

fileHandle
    dc.l    0

fileInfoBlock
    dcb.b   fib_SIZEOF

stdIn
    dc.l    0

stdOut
    dc.l    0

program
    dc.l    0

dosName
    dc.b    "dos.library",0

; tape memory

    section mem,bss_p

tape
    ds.b    1024*64
tapeEnd


factorial[n_Integer] := n*factorial[n-1]
factorial[0] = 1


pragma.syntax("0.9")
pragma.enable("accumulator")

def target := "METHINKS IT IS LIKE A WEASEL"
def alphabet := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
def C := 100
def RATE := 0.05

def randomCharString() {
  return E.toString(alphabet[entropy.nextInt(alphabet.size())])
}

def fitness(string) {
    return accum 0 for i => ch in string {
      _ + (ch == target[i]).pick(1, 0)
    }
}

def mutate(string, rate) {
  return accum "" for i => ch in string {
    _ + (entropy.nextDouble() < rate).pick(randomCharString(), E.toString(ch))
  }
}

def weasel() {
  var parent := accum "" for _ in 1..(target.size()) { _ + randomCharString() }
  var generation := 0

  while (parent != target) {
    println(`$generation $parent`)
    def copies := accum [] for _ in 1..C { _.with(mutate(parent, RATE)) }
    var best := parent
    for c in copies {
      if (fitness(c) > fitness(best)) {
        best := c
      }
    }
    parent := best
    generation += 1
  }
  println(`$generation $parent`)
}

weasel()


(define split-into-lines
  (lambda (str)
    (let loop ((index 0)
               (result '()))
      (let ((next-index (string-index str #\newline index)))
        (if next-index
            (loop (+ next-index 1)
                  (cons (substring str index next-index) result))
            (reverse (cons (substring str index) result)))))))

(define parse-rules
  (lambda (str)
    (let loop ((rules (split-into-lines str))
               (result '()))
      (if (null? rules)
          (reverse result)
          (let ((rule (car rules)))
            (loop (cdr rules)
                  (if (or (string=? rule "")
                          (eq? (string-ref rule 0) #\#))
                      result
                      (cons
                       (let ((index (string-contains rule "->" 1)))
                         (list (string-trim-right (substring rule 0 index))
                               (string-trim (substring rule (+ index 2)))))
                       result))))))))

(define apply-rules
  (lambda (str rules)
    (let loop ((remaining rules)
               (result str))
      (if (null? remaining)
          result
          (let* ((rule (car remaining))
                 (pattern (car rule))
                 (replacement (cadr rule))
                 (start (string-contains result pattern)))
            (if start
                (if (eq? #\. (string-ref replacement 0))
                    (string-replace result replacement start
                                    (+ start (string-length pattern)) 1)
                    (apply-rules
                     (string-replace result replacement start
                                     (+ start (string-length pattern)))
                     rules))
                (loop (cdr remaining) result)))))))


,[>,----------] Read until newline
++<             Get a 2 and move into position
[->-[>+>>]>     Do
[+[-<+>]>+>>]   divmod
<<<<<]          magic
>[-]<++++++++   Clear and get an 8
[>++++++<-]     to get a 48
>[>+<-]>.       to get n % 2 to ASCII and print


_DEFINE F AS _UNSIGNED _INTEGER64
CLS
PRINT
PRINT "Enter 40 to more easily see the difference in calculation speeds."
PRINT
INPUT "Enter n for Fibonacci(n): ", n
PRINT
PRINT " Analytic Method (Fastest): F("; LTRIM$(STR$(n)); ") ="; fA(n)
PRINT "Iterative Method    (Fast): F("; LTRIM$(STR$(n)); ") ="; fI(n)
PRINT "Recursive Method    (Slow): F("; LTRIM$(STR$(n)); ") ="; fR(n)
END

' === Analytic Fibonacci Function (Fastest)
FUNCTION fA (n)
  fA = INT(0.5 + (((SQR(5) + 1) / 2) ^ n) / SQR(5))
END FUNCTION

' === Iterative Fibonacci Function (Fast)
FUNCTION fI (n)
  FOR i = 1 TO n
    IF i < 3 THEN a = 1: b = 1
    t = fI + b: fI = b: b = t
  NEXT
END FUNCTION

' === Recursive Fibonacci function (Slow)
FUNCTION fR (n)
  IF n <= 1 THEN
    fR = n
  ELSE
    fR = fR(n - 1) + fR(n - 2)
  END IF
END FUNCTION


factorial: function [n]-> product 1..n
binomial:  function [x,y]-> (factorial x) / (factorial y) * factorial x-y

print binomial 5 3


# syntax: GAWK -f EVALUATE_BINOMIAL_COEFFICIENTS.AWK
BEGIN {
    main(5,3)
    main(100,2)
    main(33,17)
    exit(0)
}
function main(n,k,  i,r) {
    r = 1
    for (i=1; i<k+1; i++) {
      r *= (n - i + 1) / i
    }
    printf("%d %d = %d\n",n,k,r)
}


	;;; 	CP/M Brainfuck compiler/interpreter, with a few optimizations
getch:	equ	1	; Read character from console
putch:	equ	2	; Print character to console
puts:	equ	9	; Print string to console
fopen:	equ	15	; Open file
fread:	equ	20	; Read from file
dmaoff:	equ	26	; Set DMA address
fcb:	equ	5Ch	; FCB for first command line argument
EOFCH:	equ	-1	; Value stored on the tape on EOF
	org	100h
	jmp	start
	;;;	Print the character on the tape, saving HL (tape location),
	;;;	and including CR/LF translation.
bfout:	push	h	; Keep tape location
	mov	a,m	; What are we printing?
	cpi	10	; Newline?
	jnz	outch	; If not, just print the character.
	mvi	e,13	; Otherwise, print a carriage return first.
	mvi	c,putch
	call	5
	pop	h	; Then get the tape back
	push	h
outch:	mov	e,m	; Print the character in A.
	mvi	c,putch
	call	5
	pop	h	; Restore tape location.
	ret
	;;;	Read a character and store it on the tape, including CR/LF
	;;;	translation; ^Z is EOF.
bfin:	push	h	; Keep tape location
	lda	bfeoff	; Have we seen EOF yet?
	ana	a
	jnz	bfeof	; If so, return EOF.
	mvi	c,getch	; Otherwise, read character
	call	5
	cpi	26	; Was it EOF?
	jz	bfeof	; Then handle EOF.
	cpi	13	; Was it CR? (Pressing 'Enter' only gives CR.)
	jnz	bfin_s	; If not, just store the character.
	mvi	c,putch	; Otherwise, output a LF (only CR is echoed as well)
	mvi	e,10
	call	5
	mvi	a,10	; And then store a LF instead of the CR.
bfin_s:	pop	h	; Restore tape location
	mov	m,a	; Store the character
	ret
bfeof:	sta	bfeoff	; Set the EOF flag (A is nonzero here)
	pop	h	; Restore tape location
	mvi	m,EOFCH	; Store EOF return value.
	ret
bfeoff:	db	0	; EOF flag, EOF seen if nonzero.
	;;;	Print mismatched brackets error
brkerr:	lxi	d,ebrk
	;;;	Print error message under DE and quit
err:	mvi	c,puts	; Print string
	call	5
	rst	0	; Then quit
	;;;	Error messages.
efile:	db	'Cannot read file.$'
ebrk:	db	'Mismatched brackets.$'
	;;;	BF characters
bfchr:	db	'+-<>,.[]',26
	;;;	Main program
start:	lhld	6 	; Set stack pointer to highest available address
	sphl
	mvi	c,fopen	; Try to open the file given on the command line
	lxi	d,fcb
	call	5
	inr	a	; A=FF on error,
	lxi	d,efile	; so if we couldn't open the file, say so, and stop
	jz	err
	;;;	Read file into memory in its entirety
	lxi 	d,pgm	; Start of input
block:	mvi	c,dmaoff
	push	d	; Keep current address on stack
	call	5	; Set DMA to location of current block
	mvi	c,fread	; Read 128-byte block to that address
	lxi	d,fcb
	call	5
	dcr	a	; A=1 = end of file
	jz	fdone
	inr	a	; Otherwise, A<>0 = error
	lxi	d,efile
	jnz	err
	pop	h	; Retrieve DMA address
	lxi	d,128	; Add 128 (advance to next block)
	dad	d
	xchg		; Put in DE
	jmp	block	; Go get next block.
fdone:	pop	h	; When done, find next address
	mvi	m,26	; Write EOF, so file always ends with EOF.
	;;;	Filter out all the non-BF characters
	lxi 	h,pgm	; Output pointer
	push	h 	; On stack
	lxi	b,pgm	; Input pointer
filter:	ldax	b	; Get current character
	inx	b	; Look at next char next time
	lxi	h,bfchr	; Test against 9 brainfuck characters (8 + EOF)
	mvi	e,9
filchk:	cmp	m	; Is it a match?
	jz	filfnd	; Then we found it
	inx	h
	dcr	e
	jnz	filchk
	jmp	filter	; Otherwise, try next character
filfnd:	pop	h	; Get pointer from stack
	mov	m,a	; Store current character
	inx	h	; Move pointer
	push	h	; Store pointer back on stack
	cpi	26	; Reached the end?
	jnz	filter	; If not, keep going.
	;;;	Move the program as high up into memory as possible.
	lxi	h,-1024	; Keep 1K stack space (allowing 512 levels of nested
	dad	sp	; loops)
	pop	d	; Source pointer in DE (destination in HL)
move:	ldax	d	; Copy backwards
	dcx	d
	mov	m,a
	dcx 	h
	ana	a	; Until zero is reached
	jnz	move
	inx	h	; Move pointer to byte after zero
	inx	h
	;;;	Compile the Brainfuck code into 8080 machine code
	lxi	b,0	; Push zero on stack (as boundary marker)
	push	b
	lxi 	d,pgm	; DE = start of binary area (HL at start of source)
compil:	mov	a,m	; Get source byte
	cpi	'+'	; Plus or minus - change the tape value
	jz	tapval
	cpi	'-'
	jz	tapval
	cpi	'<'	; Left or right - move the tape
	jz	tapmov
	cpi	'>'
	jz 	tapmov
	cpi	'.'	; Input and output
	jz	chout
	cpi	','
	jz	chin
	cpi	'['	; Start of loop
	jz	loops
	cpi	']'	; End of loop
	jz 	loope
	cpi	26	; EOF?
	jz	cdone
	inx	h	; Anything else is ignored
	jmp	compil
	;;;	Write code for '+' or '-' (change cell value)
tapval:	mvi	c,0	; C = change in value necessary
tapv_s:	mov	a,m	; Get current byte
	cpi	'+'	; If plus,
	jz	tapinc	; Then we need to increment
	cpi	'-'	; If minus,
	jz	tapdec 	; Then we need to decrement
	;;;	The effect of the last instructions should be to
	;;;	change the cell at the tape head by C.
	;;;	If -3 <= B <= 3, INR M/DCR M are most efficient.
	;;;	Otherwise, MVI A,NN / ADD M / MOV M,A is most efficient.
	mov	a,c
	ana	a	; Zero?
	jz	compil	; Then we do nothing.
	cpi	4	; Larger than 3?
	jc	tapinr	; If not, 'INR M' * C
	cpi	-3	; Smaller than -3?
	jnc	tapdcr	; Then, 'DCR M' * -C
	xchg		; Otherwise, use an ADD instruction
	mvi	m,3Eh	; 'MVI A,'
	inx	h
	mov	m,c	; C (all math is mod 256)
	inx	h
	mvi	m,86h	; 'ADD M'
	inx	h
	mvi 	m,77h	; 'MOV M,A'
	inx	h
	xchg
	jmp	compil
tapinc:	inr	c	; '+' means one more
	inx	h	; Check next byte
	jmp	tapv_s
tapdec:	dcr	c	; '-' means one less
	inx	h	; Check next byte
	jmp	tapv_s
tapinr:	mvi	a,34h	; INR M (increment cell)
	jmp	wrbyte
tapdcr:	mvi	a,35h	; DCR M (decrement cell)
	jmp	wrnegc
	;;;	Write code for '<' or '>' (move tape head)
tapmov:	lxi	b,0	; BC = change in value necessary
tapm_s:	mov	a,m	; Get current byte
	cpi	'>'	; If right,
	jz	taprgt	; Then we need to move the tape right
	cpi	'<'	; If left,
	jz	taplft	; Then we need to move the tape left
	;;;	Move the tape by BC.
	;;;	If -4 <= BC <= 4, INX H/DCX H are most efficient.
	;;;	Otherwise, LXI B,NNNN / DAD B is most efficient.
	mov	a,b	; Is the displacement zero?
	ora	c
	jz	compil	; Then do nothing
	mov	a,b	; Otherwise, is the high byte 0?
	ana	a
	jnz	tbchi	; If not, it might be FF, but
	mov	a,c	; if so, is low byte <= 4?
	cpi	5
	jc	tapinx	; Then we need to write 'INX H' C times
	xra	a	; Otherwise, do it the long way
tbchi:	inr	a	; Is the high byte FF?
	jnz	tapwbc	; If not, we'll have to do it the long way
	mov	a,c	; But if so, is low byte >= -4?
	cpi	-4
	jnc	tapdcx	; Then we can write 'DCX H' -C times
tapwbc:	xchg		; Otherwise, use a DAD instruction
	mvi	m,1h	; 'LXI B,'
	inx	h
	mov	m,c	; Low byte
	inx	h
	mov	m,b	; High byte
	inx	h
	mvi	m,9h	; 'DAD B'
	inx	h
	xchg
	jmp	compil
taprgt:	inx	b	; '>' is one to the right
	inx	h	; Check next byte
	jmp	tapm_s
taplft:	dcx	b	; '<' is one to the left
	inx	h	; Check next byte
	jmp	tapm_s
tapinx:	mvi	a,23h	; INX H (move tape right)
	jmp	wrbyte
tapdcx:	mvi	a,2Bh	; DCX H (move tape left)
	jmp	wrnegc
	;;;	Write the byte in A, -C times, to [DE++]
wrnegc: mov	b,a	; Keep A
	mov	a,c	; Negate C
	cma
	inr	a
	mov	c,a
	mov	a,b
	;;;	Write the byte in A, C times, to [DE++]
wrbyte:	stax	d
	inx	d
	dcr	c
	jnz	wrbyte
	jmp	compil
	;;;	Write code to print the current tape value
chout:	inx	h	; We know the cmd is '.', so skip it
	lxi	b,bfout	; Call the output routine
	jmp	wrcall
	;;;	Write code to read a character and store it on the tape
chin:	inx	h	; We know the cmd is ',', so skip it
	lxi	b,bfin
	;;;	Write code to CALL the routine with address BC
wrcall:	xchg
	mvi	m,0CDh	; CALL
	inx	h
	mov	m,c	; Low byte
	inx	h
	mov	m,b	; High byte
	inx	h
	xchg
	jmp	compil
	;;;	Write code to start a loop
loops:	inx	h	; We know the first cmd is '['
	mov	b,h	; Check for '-]'
	mov	c,l
	ldax	b
	cpi	'-'
	jnz	loopsw	; If not '-', it's a real loop
	inx	b
	ldax 	b
	cpi	']'
	jz	lzero	; If ']', we just need to set the cell to 0
	;;;	Code for loop: MOV A,M / ANA A / JZ cmd-past-loop
loopsw:	xchg		; Destination pointer in HL
	mvi	m,7Eh	; MOV A,M
	inx	h
	mvi	m,0A7h	; ANA A
	inx	h
	mvi	m,0CAh	; JZ
	inx	h
	inx	h	; Advance past where the destination will go
	inx	h	; (End of loop will fill it in)
	push	h 	; Store the address to jump back to on the stack
	xchg
	jmp	compil
	;;;	Code to set a cell to zero in one go: MVI M,0
lzero:	inx	h	; Move past '-]'
	inx	h
	xchg		; Destination pointer in HL
	mvi	m,36h	; MVI M,
	inx	h
	mvi	m,0	; 0
	inx	h
	xchg
	jmp	compil
	;;;	Write code to end a loop: MOV A,M / ANA A / JNZ loop-start
loope:	inx	h	; We know the first cmd is ']'
	xchg		; Destination pointer in HL
	mvi	m,7Eh	; MOV A,M
	inx	h
	mvi	m,0A7h	; ANA A
	inx	h
	mvi	m,0C2h	; JNZ
	inx	h
	pop	b	; Get loop-start from the stack
	mov	a,b	; If it is 0, we've hit the sentinel, which means
	ora	c	; mismatched brackets
	jz	brkerr
	mov	m,c	; Store loop-start, low byte first,
	inx	h
	mov	m,b	; then high byte.
	inx	h
	dcx	b	; The two bytes before loop-start must be filled in
	mov	a,h	; with the address of the cmd past the loop, high
	stax	b	; byte last,
	dcx	b
	mov	a,l	; then low byte
	stax 	b
	xchg
	jmp	compil
	;;;	Done: finish the code with a RST 0 to end the program
cdone:	xchg
	mvi	m,0C7h
	pop 	b 	; If the brackets are all matched, there should be
	mov	a,b	; a zero on the stack.
	ora	c
	jnz	brkerr
	;;;	Initialize the tape. The fastest way to fill up memory on the
	;;;	8080 is to push values to the stack, so we will fill it up
	;;;	with zeroes, and position the tape there.
	;;;	HL contains the top of the program.
	lxi	d,32	; The Brainfuck program doesn't use the stack, so
	dad	d	; reserving 16 levels for CP/M is more than enough.
	mov	a,l	; Complement the value (almost negation, but low bit
	cma		; doesn't really matter here)
	mov	l,a
	mov	a,h
	cma
	mov	h,a
	dad	sp	; Add the current stack pointer, giving bytes to fill
	ana	a	; Zero carry
	mov	a,h	; Divide value by two (we push words)
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a
	lxi	d,0
ztape:	push	d	; Zero out the tape (on the stack)
	dcx	h
	mov	a,h
	ora	l
	jnz	ztape
	dad	sp	; HL is now 0, add SP to get tape bottom
	;;;	The compiled program is stored after this point, so we just
	;;;	fall through into it.
	nop		; No-op (sentinel value)
pgm:	equ	$	; Compiled BF program stored here.


	;;;	MS-DOS Brainf*** interpreter/compiler
	cpu	8086
putch:	equ	2h		; Print character
puts:	equ	9h		; Print string
open:	equ	3Dh		; Open file
read:	equ	3Fh		; Read from file
exit:	equ	4Ch		; Exit to DOS
flags:	equ	33h		; Set break flags
CMDLEN:	equ	80h		; Address of length of command line argument
CMDARG:	equ	81h		; Address of text of command line argument
BRK:	equ	1		; Break flag
EOFCH:	equ	-1		; Written to the tape on EOF
section	.text
	org	100h
	;;;	See if there is enough memory
	mov	sp,stack.top	; Move stack inward to free up memory
	mov	ax,cs		; Get allocated memory size from DOS
	dec	ax		; (It is at location 3 in the MCB, which
	mov	es,ax		; is located one paragraph above CS.)
	mov	ax,[es:3]
	mov	bx,sp		; The amount of memory the program itself
	mov	cl,4		; needs is from CS:0 up to CS:SP in bytes,
	shr	bx,cl		; shifted right by 4 to give paragraphs;
	inc	bx		; making sure to round up.
	mov	bp,cs		; The paragraph right after this is used
	add	bp,bx 		; as the segment base for BF's memory.
	sub	ax,bx		; Free mem = allocated mem - program mem
	cmp	ax,128*1024/16	; We'll require at least 128k bytes
	jae	mem_ok		; (for two separate code and data segments)
	mov	dx,err.mem	; If we don't have enough,
	jmp	error		; give an error message.
	;;;	Stop on Ctrl+C
mem_ok:	mov	ax,flags<<8|BRK
	mov	dl,1
	int	21h
	;;;	See if a command line argument was given
	mov	bl,[CMDLEN]	; Get length of argument
	test	bl,bl		; See if it's zero
	jnz	arg_ok
	mov	dx,err.usage	; Print usage string if no argument given
	jmp	error
arg_ok:	xor	bh,bh
	mov	[CMDARG+bx],bh	; Terminate the argument string with a zero
	mov	ax,open<<8	; Try to open the file for reading
	mov	dx,CMDARG+1	; Skip first item (always 1)
	int	21h
	jnc	fileok
	mov	dx,err.file	; Print file error if it fails
	jmp	error
fileok: mov	di,ax		; Keep file handle in DI
	xor	si,si		; Keep pointer in SI
	mov	ds,bp		; Start reading into the memory past our stack
block:	mov	ah,read		; Read from file
	mov	bx,di
	mov	cx,0FFFEh
	mov	dx,si		; To the place just beyond the last read
	int	21h
	jnc	.rdok
	mov	dx,err.file	; Read error
	jmp	error
.rdok:	test	ax,ax		; If zero bytes read, we're done
	jz	.done
	add	si,ax		; Move pointer past read
	jnc	block		; If there's still room, do another read
	mov	dx,err.mem	; If we overshot, then give memory error
	jmp	error
.done:	mov	[si],byte 0	; Zero-terminate the data
	;;;	Filter out all non-BF characters
	push	ds		; Set ES to DS
	pop	es
	xor	si,si		; Source and destination pointer to beginning
	xor	di,di
filter:	lodsb			; Get byte from source
	xor	bx,bx		; See if byte is BF command
.test:	cmp	al,[cs:bx+bfchar]	; Test against current character
	je	.match		; If a match, we found it
	inc	bx		; If not, try next possible command
	cmp	bx,8
	jbe	.test
	jmp	filter		; If we didn't find it, ignore this character
.match:	stosb			; We found it, keep it
	test	al,al		; If zero, we found the end,
	jnz	filter		; Otherwise, do next character
	;;;	Compile the BF source into 8086 machine code
	add	bp,65536/16	; Set ES to point to the start of the second
	mov	es,bp		; 64k (4k paragraphs) that we allocated earlier
	xor	di,di		; Start at address zero,
	push	di		; Store a zero on the stack as boundary marker,
	mov	ax,stop		; At 0000, store a far pointer to the
	stosw			; cleanup routine,
	mov	ax,cs
	stosw
	mov	ax,bfout	; At 0004, store a far pointer to the
	stosw			; output routine,
	mov	ax,cs
	stosw
	mov	ax,bfin		; At 0008, store a far pointer to the
	stosw			; input routine,
	mov	ax,cs
	stosw			; Compiled BF code starts at 000C.
	xor	si,si		; Start at beginning of BF source code
compil:	lodsb			; Get current command
.ch:	cmp	di,-16		; See if we still have 16 bytes free
	jb	.fch		; (Loop is 11 bytes, +5 for INT 21h/4Ch at end)
	mov	dx,err.mem	; If not, we're out of memory
	jmp	error
.fch:	cmp	al,'+'		; + and - change the value of the current cell
	je	tapval
	cmp	al,'-'
	je	tapval
	cmp	al,'>'		; < and > move the tape
	je	tapmov
	cmp	al,'<'
	je	tapmov
	cmp	al,','		; I/O
	jne	.tsout		; Conditional jumps are limited to 128-byte
	jmp	chin		; displacement
.tsout:	cmp	al,'.'
	jne	.tsls
	jmp	chout
.tsls:	cmp	al,'['		; Loops
	jne	.tsle
	jmp	loops
.tsle:	cmp	al,']'
	jne	.tsend
	jmp	loope
.tsend:	test	al,al 		; Reached zero?
	jnz 	compil		; If not, next command
	jmp	cdone		; If so, we're done
	;;;	Compile a string of +s and -s into an 8086 instruction
tapval:	xor	cl,cl		; Count up contiguous +s and -s modulo 256
.ch:	cmp	al,'+'
	je	.inc
	cmp	al,'-'
	je	.dec
	test	cl,cl		; If zero,
	jz	compil.ch	; it's a no-op.
	mov	bl,al		; Otherwise, keep next character
	cmp	cl,-1		; If -1, decrement cell
	mov	ax,0FFEh	; DEC BYTE [BX]
	je	.wword
	cmp	cl,1		; If 1, increment cell
	mov	ax,07FEh	; INC BYTE [BX]
	je	.wword
	mov	ax,0780h	; ADD BYTE [BX],
	stosw
	mov	al,cl		; change to cell
	stosb
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
.inc:	inc	cl		; Increment cell
	lodsb
	jmp	.ch
.dec:	dec	cl		; Decrement cell
	lodsb
	jmp	.ch
.wword:	stosw			; Write instruction word
	mov	al,bl		; Move next character back into AL
	jmp 	compil.ch	; Compile next command
	;;;	Compile a string of <s and >s into an 8086 instruction
tapmov:	xor	cx,cx		; Count up contiguous <s and >s modulo 65536
.ch:	cmp	al,'>'
	je	.right
	cmp	al,'<'
	je	.left
	test	cx,cx		; Is there any net movement at all?
	jnz	.move		; If so, generate a move instruction
	jmp	compil.ch	; But otherwise it's a no-op, ignore it
.move:	mov	bl,al		; Otherwise, keep next character
	cmp	cx,4		; If CX<4, a series of INC BX are best
	mov	al,43h		; INC BX
	jb	.wbyte
	neg	cx
	cmp	cx,4		; If -CX<4, a series of DEC BX are best
	mov	al,4Bh		; DEC BX
	jb	.wbyte
	neg	cx
	mov	ax,0C381h	; ADD BX,
	stosw
	mov	ax,cx		; tape movement
	stosw
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
.left:	dec	cx		; Left: decrement pointer
	lodsb
	jmp	.ch
.right:	inc	cx		; Right: increment pointer
	lodsb
	jmp	.ch
.wbyte:	rep	stosb		; Write AL, CX times.
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
	;;;	Compile BF input
chin:	mov	al,2Eh		; CS segment override
	stosb
	mov	ax,1EFFh	; CALL FAR PTR
	stosw
	mov	ax,8		; Pointer to input routine at address 8
	stosw
	jmp	compil		; Compile next command
	;;;	Compile BF output
chout:	mov	al,2Eh		; CS segment override
	stosb
	mov	ax,1EFFh	; CALL FAR PTR
	stosw
	mov	ax,4		; Pointer to output routine at address 4
	stosw
	jmp	compil
	;;;	Compile start of loop
loops:	cmp	word [si],5D2Dh	; Are the next two characters '-]'?
	je	.zero		; Then just set the cell to zero
	mov	ax,078Ah	; Otherwise, write out a real loop
	stosw			; ^- MOV AL,[BX]
	mov	ax,0C084h	; TEST AL,AL
	stosw
	mov	ax,0575h	; JNZ loop-body
	stosw
	mov	al,0B8h		; MOV AX,  (simulate absolute near jmp)
	stosb
	xor	ax,ax		; loop-end (we don't know it yet so 0)
	stosw
	mov	ax,0E0FFh	; JMP AX
	stosw
	push	di		; Store addr of loop body on stack
	jmp	compil		; Compile next command
.zero:	mov	ax,07C6h	; MOV BYTE [BX],
	stosw
	xor	al,al		; 0
	stosb
	inc	si		; Move past -]
	inc	si
	jmp	compil		; Compile next command
	;;;	Compile end of loop
loope:	pop	bx		; Retrieve address of loop body from stack
	test	bx,bx 		; If it is zero, we've hit the top of stack
	jz	.ebrkt		; so the brackets aren't balanced.
	mov	ax,078Ah	; MOV AL,[BX]
	stosw
	mov	ax,0C084h	; TEST AL,AL
	stosw
	mov	ax,0574h	; JZ loop-end
	stosw
	mov	al,0B8h		; MOV AX, (simulate absolute near jmp)
	stosb
	mov	ax,bx		; loop-start
	stosw
	mov	ax,0E0FFh	; JMP AX
	stosw
	mov	[es:bx-4],di	; Store loop-end in matching loop start code
	jmp	compil
.ebrkt:	mov	dx,err.brk
	jmp	error
	;;;	Compilation is done.
cdone:	mov	al,2Eh		; Code to jump to cleanup routine
	stosb			; ^- CS segment override
	mov	ax,2EFFh	; JMP FAR PTR
	stosw
	pop	ax		; Should be zero if all loops closed
	stosw
	test	ax,ax		; Were all loops closed?
	jz	.lp_ok
	mov	dx,err.brk	; If not, print error
	jmp	error
.lp_ok:	mov	[cs:cp],word 12	; Make far pointer to start of BF code
	mov	[cs:cp+2],bp	; (which starts at ES:0C = BP:0C)
	mov	ax,ds		; Set both DS and ES to BF tape segment
	mov	es,ax		; (also the initial source segment)
	xor	ax,ax		; Clear the tape (set all bytes to zero)
	mov	cx,32768
	rep	stosw
	xor	bx,bx		; Tape begins at address 0
	xor	cx,cx		; No EOF and char buffer is empty
	jmp	far [cs:cp]	; Jump into the BF code
	;;;	BF program jumps here to stop the program
stop:	mov	ax,exit<<8|0	; Quit to DOS with return code 0
	int	21h
	;;;	Print error message in CS:DX and quit with errorlevel 2
error:	push	cs		; Set DS to CS
	pop	ds
	mov	ah,puts		; Print DS:DX
	int	21h
	mov	ax,exit<<8|2	; Quit to DOS
	int	21h
	;;;	Output subroutine called by the BF program (far call)
bfout:	mov	ah,putch	; Prepare to write character
	mov	dl,[bx] 	; Get character from tape
	cmp 	dl,10		; Is it LF?
	jne	.wr		; If not, just write it
	mov	dl,13		; Otherwise, print CR first,
	int	21h
	mov	dl,10		; then LF.
.wr:	int	21h		; Write character
	retf
	;;;	Input subroutine called by the BF program (far call)
	;;;	Buffered input with CR/LF translation
	;;;	Note: this keeps state in registers!
	;;;	CL = chars left in buffer, CH = set if EOF seen,
	;;;	SI = buffer pointer, ES = BF data segment
bfin:	test	ch,ch		; EOF seen?
	jnz	.r_eof
	mov	ax,cs		; Set DS to our segment
	mov	ds,ax
.getch:	test	cl,cl		; Characters left in buffer?
	jnz	.retch		; If so, return next character
	mov	bp,bx		; Keep BF tape pointer
	mov	ah,read		; Read
	xor	bx,bx		; From STDIN
	mov	cx,255		; Max 255 characters
	mov	dx,ibuf		; Into the buffer
	int	21h
	mov	bx,bp		; Restore tape pointer
	jc	.ioerr		; If carry set, I/O error
	test	ax,ax		; If nothing returned, EOF
	jz	.s_eof
	mov	cx,ax		; Otherwise, set character count,
	mov	si,ibuf		; set buffer pointer back to start,
	jmp	.getch		; and return first character from buffer.
.s_eof:	inc	ch		; We've seen EOF now
.r_eof:	mov	al,EOFCH	; Return EOF
	jmp	.ret
.retch:	lodsb			; Get char from buffer
	dec	cl		; One fewer character left
	cmp	al,26		; ^Z = EOF when reading from keyboard
	je	.s_eof
	cmp	al,10		; If it is LF, ignore it and get another
	je	.getch
	cmp	al,13		; If it is CR, return LF instead
	jne	.ret
	mov	al,10
.ret:	mov	dx,es		; Set DS back to BF's data segment
	mov	ds,dx
	mov	[bx],al		; Put character on tape
	retf
.ioerr:	mov	dx,err.io	; Print I/O error and quit
	jmp	error
section	.data
bfchar:	db	'+-<>,.[]',0
err:	;;;	Error messages
.usage:	db	'BRAINFK PGM.B',13,10,10,9,'Run the BF program in PGM.B$'
.file:	db	'Cannot read file$'
.brk:	db	'Mismatched brackets$'
.mem:	db	'Out of memory$'
.io:	db	'I/O Error$'
section	.bss
cp:	resw	2		; Far pointer to start of BF code
ibuf:	resb	256		; 255 char input buffer
stack:	resw	512		; 512 words for the stack
.top:	equ	$


fmod FACTORIAL is

	protecting INT .

	op undefined : -> Int .
	op _! : Int -> Int .

	var n : Int .

	eq 0 ! = 1 .
	eq n ! = if n < 0 then undefined else n * (sd(n, 1) !) fi .

endfm

red 11 ! .


import <Utilities/Sequence.sl>;

Rule ::= ( pattern : char(1),
           replacement : char(1),
           terminal : bool);

ReplaceResult ::= (newString : char(1), wasReplaced : bool);

main(args(2)) := markov(createRule(split(args[1], '\n')), 1, args[2]);

createRule(line(1)) :=
    let
        containsComments := firstIndexOf(line, '#');
        removedComments := line when containsComments = 0 else
                           line[1 ... containsComments - 1];

        arrowLocation := startOfArrow(removedComments, 1);
        lhs := removedComments[1 ... arrowLocation-1];
        rhs := removedComments[arrowLocation + 4 ... size(removedComments)];
        isTerminal := size(rhs) > 0 and rhs[1] = '.';
    in
        (pattern : lhs,
         replacement : rhs[2 ... size(rhs)] when isTerminal else rhs,
         terminal : isTerminal) when size(removedComments) > 0 and arrowLocation /= -1;

startOfArrow(line(1), n) :=
    -1 when n > size(line) - 3 else
    n when (line[n]=' ' or line[n]='\t') and
           line[n+1] = '-' and line[n+2] = '>' and
           (line[n+3]=' ' or line[n+3]='\t') else
    startOfArrow(line, n+1);

markov(rules(1), n, input(1)) :=
    let
        replaced := replaceSubString(input, rules[n].pattern, rules[n].replacement, 1);
    in
    input when n > size(rules) else
    replaced.newString when replaced.wasReplaced and rules[n].terminal else
    markov(rules, 1, replaced.newString) when replaced.wasReplaced else
    markov(rules, n+1, input);

replaceSubString(str(1), original(1), new(1), n) :=
    (newString : str, wasReplaced : false)
        when n > size(str) - size(original) + 1 else
    (newString : str[1 ... n - 1] ++ new ++ str[n + size(original) ... size(str)], wasReplaced : true)
        when equalList(str[n ... n + size(original) - 1], original) else
    replaceSubString(str, original, new, n + 1);


#!/bin/sh
         exec "snobol4" "-r" "$0" "[email protected]"
*
* http://rosettacode.org/wiki/Execute_a_Markov_algorithm
*
         define('repl(s1,s2,s3)c,t,findc') :(repl_end)
repl     s2 len(1) . c = :f(freturn)
         findc = break(c) . t len(1)
         s2 = pos(0) s2
repl_1   s1 findc = :f(repl_2)
         s1 s2 = :f(repl_3)
         repl = repl t s3 :(repl_1)
repl_3   repl = repl t c :(repl_1)
repl_2   repl = repl s1 :(return)
repl_end
*
         define('quote(s)q,qq') :(quote_end)
quote    q = "'"; qq = '"'
         quote = q repl(s, q, q ' ' qq q qq ' ' q) q :(return)
quote_end
*
         whitespace = span(' ' char(9))
top      r = 0
read     s = input :f(end)
         s pos(0) 'ENDRULE' rpos(0) :s(interp)
         s pos(0) '#' :s(read)
         pattern =; replacement =; term =
         s arb . pattern whitespace '->' whitespace
+           ('.' | '') . term arb . replacement rpos(0) :f(syntax)
         r = r + 1
         f = ident(term, '.') ' :(done)'
         f = ident(term) ' :f(rule' r + 1 ')s(rule1)'
         c = 'rule' r ' s ' quote(pattern) ' = ' quote(replacement) f
         code(c) :s(read)
         output = 'rule: ' s ' generates code ' c ' in error' :(end)
syntax   output = 'rule: ' s ' in error' :(read)
interp   code('rule' r + 1 ' :(done)')
go       s = input :f(end)
         s pos(0) 'END' rpos(0) :s(top)f(rule1)
done     output = s :(go)
end
# 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
ENDRULE
I bought a B of As from T S.
END
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
ENDRULE
I bought a B of As from T S.
END
# 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
ENDRULE
I bought a B of As W my Bgage from T S.
END
### 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
_+_ ->
ENDRULE
_1111*11111_
END
# 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
ENDRULE
000000A000000
END


@echo off & setlocal

if "%~2"=="" ( echo Usage: %~nx0 n k && goto :EOF )

call :binom binom %~1 %~2
1>&2 set /P "=%~1 choose %~2 = "<NUL
echo %binom%

goto :EOF

:binom <var_to_set> <N> <K>
setlocal
set /a coeff=1, nk=%~2 - %~3 + 1
for /L %%I in (%nk%, 1, %~2) do set /a coeff *= %%I
for /L %%I in (1, 1, %~3) do set /a coeff /= %%I
endlocal && set "%~1=%coeff%"
goto :EOF


GET "libhdr"

LET choose(n, k) =
	~(0 <= k <= n) -> 0,
	2*k > n -> binomial(n, n - k),
	binomial(n, k)

AND binomial(n, k) =
	k = 0 -> 1,
	binomial(n, k - 1) * (n - k + 1) / k

LET start() = VALOF {
    LET n, k = ?, ?
    LET argv = VEC 20
    LET sz = ?

    sz := rdargs("n/a/n/p,k/a/n/p", argv, 20)
    UNLESS sz ~= 0 RESULTIS 1

    n := !argv!0
    k := !argv!1

    writef("%d  choose %d  = %d *n", n, k, choose(n, k))
    RESULTIS 0
}


      @%=&1010

      PRINT "Binomial (5,3) = "; FNbinomial(5, 3)
      PRINT "Binomial (100,2) = "; FNbinomial(100, 2)
      PRINT "Binomial (33,17) = "; FNbinomial(33, 17)
      END

      DEF FNbinomial(N%, K%)
      LOCAL R%, D%
      R% = 1 : D% = N% - K%
      IF D% > K% THEN K% = D% : D% = N% - K%
      WHILE N% > K%
        R% *= N%
        N% -= 1
        WHILE D% > 1 AND (R% MOD D%) = 0
          R% /= D%
          D% -= 1
        ENDWHILE
      ENDWHILE
      = R%


# Brain**** interpreter

# execute the Brain**** program in the code string
bf := proc( code :: string ) is
    local address       := 1;  # current data address
    local pc            := 1;  # current position in code
    local data          := []; # data - initially empty
    local input         := ""; # user input - initially empty
    local bfOperations  :=     # table of operations and their implemntations
          [ ">" ~ proc() is inc address, 1 end
          , "<" ~ proc() is dec address, 1 end
          , "+" ~ proc() is inc data[ address ], 1 end
          , "-" ~ proc() is dec data[ address ], 1 end
          , "." ~ proc() is io.write( char( data[ address ] ) ) end
          , "," ~ proc() is
                      # get next input character, converted to an integer
                      while input = ""
                      do
                          # no input left - get the next line
                          input := io.read()
                      od;
                      data[ address ] := abs( input[ 1 ] );
                      # remove the latest character from the input
                      if size input < 2
                      then
                          input := ""
                      else
                          input := input[ 2 to -1 ]
                      fi
                  end
          , "[" ~ proc() is
                      if data[ address ] = 0
                      then
                          # skip to the end of the loop
                          local depth := 0;
                          do
                              inc pc, 1;
                              if code[ pc ] = "["
                              then
                                  inc depth, 1
                              elif code[ pc ] = "]"
                              then
                                  dec depth, 1
                              fi
                          until depth < 0
                      fi
                  end
          , "]" ~ proc() is
                      if data[ address ] <> 0
                      then
                          # skip to the start of the loop
                          local depth := 0;
                          do
                              dec pc, 1;
                              if code[ pc ] = "["
                              then
                                  dec depth, 1
                              elif code[ pc ] = "]"
                              then
                                  inc depth, 1
                              fi
                          until depth < 0
                      fi
                  end
          ];
    # execute the operations - ignore anything invalid
    while pc <= size code
    do
        if  data[ address ] = null
        then
            data[ address ] := 0
        fi;
        if  bfOperations[ code[ pc ] ] <> null
        then
            bfOperations[ code[ pc ] ]()
        fi;
        inc pc, 1
    od
end;

# prompt for Brain**** code and execute it, repeating until an empty code string is entered
scope
    local code;
    do
        io.write( "BF> " );
        code := io.read();
        bf( code )
    until code = ""
epocs;


BEGIN # Brain**** -> Algol 68 transpiler #
      # a single line of Brain**** code is prompted for and read from #
      # standard input, the generated code is written to standard output #
      # the original code is included in the output as a comment #

    # transpiles the Brain**** code in code list to Algol 68 #
    PROC generate = ( STRING code list )VOID:
    BEGIN

        PROC emit  = ( STRING code )VOID: print( ( code, newline ) );
        PROC emit1 = ( STRING code )VOID:
             print( ( IF need semicolon THEN ";" ELSE "" FI
                    , newline, indent, code
                    )
                  );
        PROC next  = CHAR: IF   c pos > c max
                           THEN "$"
                           ELSE CHAR result = code list[ c pos ];
                                c pos +:= 1;
                                result
                           FI;

        # address and data modes and the data space #
        emit( "BEGIN" );
        emit( "  MODE DADDR = INT; # data address #" );
        emit( "  MODE DATA  = INT;" );
        emit( "  DATA zero  = 0;" );
        emit( "  [-255:255]DATA data;  # finite data space #" );
        emit( "  FOR i FROM LWB data TO UPB data DO data[i] := zero OD;" );
        emit( "  DADDR addr := ( UPB data + LWB data ) OVER 2;" );

        # actual code #

        STRING indent         := "  ";
        BOOL   need semicolon := FALSE;
        INT    c pos          := LWB code list;
        INT    c max           = UPB code list;
        CHAR   c              := next;
        WHILE c /= "$" DO
            IF   c = "?"
            THEN emit1( "SKIP" );
                 need semicolon := TRUE;
                 WHILE ( c := next ) = "?" DO SKIP OD
            ELIF c = "<" OR c = ">"
            THEN CHAR op code   = c;
                 CHAR assign op = IF c = ">" THEN "+" ELSE "-" FI;
                 INT incr      := 1;
                 WHILE ( c := next ) = op code DO incr +:= 1 OD;
                 emit1( "addr " + assign op + ":= " + whole( incr, 0 ) );
                 need semicolon := TRUE
            ELIF c = "+" OR c = "-"
            THEN CHAR op code   = c;
                 INT incr      := 1;
                 WHILE ( c := next ) = op code DO incr +:= 1 OD;
                 emit1( "data[ addr ] " + op code + ":= " + whole( incr, 0 ) );
                 need semicolon := TRUE
            ELIF c = "."
            THEN emit1( "print( ( REPR data[ addr ] ) )" );
                 need semicolon := TRUE;
                 c              := next
            ELIF c = ","
            THEN emit1( "data[ addr ] := ABS read char" );
                 need semicolon := TRUE;
                 c              := next
            ELIF c = "["
            THEN emit1( "WHILE data[ addr ] /= zero DO" );
                 indent        +:= "  ";
                 need semicolon := FALSE;
                 c              := next
            ELIF c = "]"
            THEN need semicolon := FALSE;
                 indent         := indent[ LWB indent + 2 : ];
                 emit1( "OD" );
                 need semicolon := TRUE;
                 c              := next
            ELSE
                 print( ( "Invalid op code: """, c, """", newline ) );
                 c              := next
            FI
        OD;
        emit( "" );
        emit( "END" )

    END # gen # ;

    # get the code to transpile and output it as a comment at the start #
    # of the code #
    print( ( "CO BF> " ) );
    STRING code list;
    read( ( code list, newline ) );
    print( ( newline, code list, newline, "CO", newline ) );
    # transpile the code #
    generate( code list )

END


fn factorial n =
(
    if n == 0 then return 1
    local fac = 1
    for i in 1 to n do
    (
        fac *= i
    )
    fac
)


:- module factorial.

:- interface.
:- import_module integer.

:- func factorial(integer) = integer.

:- implementation.

:- pragma memo(factorial/1).

factorial(N) =
    (   N =< integer(0)
    ->  integer(1)
    ;   factorial(N - integer(1)) * N
    ).


(require 'sequences)
(define ALPHABET (list->vector  ["A" .. "Z"] ))
(vector-push ALPHABET " ")

(define (fitness source target) ;; score >=0, best is 0
	(for/sum  [(s source)(t target)]
		(if (= s t) 0 1)))

(define (mutate source rate)
	(for/string [(s source)]
		(if (< (random) rate) [ALPHABET (random 27)] s)))

(define (select parent target rate copies (copy) (score))
	(define best (fitness parent target))
	(define selected parent)
	(for [(i copies)]
		(set! copy (mutate parent rate))
		(set! score (fitness copy target))
		(when (< score  best)
			(set! selected copy)
			(set! best  score)))
	selected )

(define MUTATION_RATE 0.05) ;; 5% chances to change
(define COPIES 100)
(define TARGET "METHINKS IT IS LIKE A WEASEL")

(define (task (rate MUTATION_RATE) (copies COPIES) (target TARGET) (score))
	(define parent ;; random source
		(for/string
                [(i (string-length target))] [ALPHABET (random 27)]))

	(for [(i (in-naturals))]
		(set! score (fitness parent target))
		(writeln i parent 'score score)
		#:break (zero? score)
		(set! parent (select parent target rate copies))
		))


import Foundation

func setup(ruleset: String) -> [(String, String, Bool)] {
    return ruleset.componentsSeparatedByCharactersInSet(NSCharacterSet.newlineCharacterSet())
        .filter { $0.rangeOfString("^s*#", options: .RegularExpressionSearch) == nil }
        .reduce([(String, String, Bool)]()) { rules, line in
            let regex = try! NSRegularExpression(pattern: "^(.+)\\s+->\\s+(\\.?)(.*)$", options: .CaseInsensitive)
            guard let match = regex.firstMatchInString(line, options: .Anchored, range: NSMakeRange(0, line.characters.count)) else { return rules }
            return rules + [(
                (line as NSString).substringWithRange(match.rangeAtIndex(1)),
                (line as NSString).substringWithRange(match.rangeAtIndex(3)),
                (line as NSString).substringWithRange(match.rangeAtIndex(2)) != ""
            )]
        }
}

func markov(ruleset: String, var input: String) -> String {
    let rules = setup(ruleset)
    var terminate = false
    while !terminate {
        guard let i = rules.indexOf ({
            if let range = input.rangeOfString($0.0) {
                input.replaceRange(range, with: $0.1)
                return true
            }
            return false
        }) else { break }
        terminate = rules[i].2
    }
    return input
}

let tests: [(ruleset: String, input: String)] = [
    ("# This rules file is extracted from Wikipedia:\n# http://en.wikipedia.org/wiki/Markov_Algorithm\nA -> apple\nB -> bag\nS -> shop\nT -> the\nthe shop -> my brother\na never used -> .terminating rule", "I bought a B of As from T S."),
    ("# Slightly modified from the rules on Wikipedia\nA -> apple\nB -> bag\nS -> .shop\nT -> the\nthe shop -> my brother\na never used -> .terminating rule", "I bought a B of As from T S."),
    ("# BNF Syntax testing rules\nA -> apple\nWWWW -> with\nBgage -> ->.*\nB -> bag\n->.* -> money\nW -> WW\nS -> .shop\nT -> the\nthe shop -> my brother\na never used -> .terminating rule", "I bought a B of As W my Bgage from T S."),
    ("### Unary Multiplication Engine, for testing Markov Algorithm implementations\n### By Donal Fellows.\n# Unary addition engine\n_+1 -> _1+\n1+1 -> 11+\n# Pass for converting from the splitting of multiplication into ordinary\n# addition\n1! -> !1\n,! -> !+\n_! -> _\n# Unary multiplication by duplicating left side, right side times\n1*1 -> x,@y\n1x -> xX\nX, -> 1,1\nX1 -> 1X\n_x -> _X\n,x -> ,X\ny1 -> 1y\ny_ -> _\n# Next phase of applying\[email protected] -> x,@y\[email protected]_ -> @_\n,@_ -> !_\n++ -> +\n# Termination cleanup for addition\n_1 -> 1\n1+_ -> 1\n_+_ ->", "_1111*11111_"),
    ("# Turing machine: three-state busy beaver\n#\n# state A, symbol 0 => write 1, move right, new state B\nA0 -> 1B\n# state A, symbol 1 => write 1, move left, new state C\n0A1 -> C01\n1A1 -> C11\n# state B, symbol 0 => write 1, move left, new state A\n0B0 -> A01\n1B0 -> A11\n# state B, symbol 1 => write 1, move right, new state B\nB1 -> 1B\n# state C, symbol 0 => write 1, move left, new state B\n0C0 -> B01\n1C0 -> B11\n# state C, symbol 1 => write 1, move left, halt\n0C1 -> H01\n1C1 -> H11", "000000A000000")
]

for (index, test) in tests.enumerate() {
    print("\(index + 1):", markov(test.ruleset, input: test.input))
}


package require Tcl 8.5
if {$argc < 3} {error "usage: $argv0 ruleFile inputFile outputFile"}
lassign $argv ruleFile inputFile outputFile

# Read the file of rules
set rules {}
set f [open $ruleFile]
foreach line [split [read $f] \n[close $f]] {
    if {[string match "#*" $line] || $line eq ""} continue
    if {[regexp {^(.+)\s+->\s+(\.?)(.*)$} $line -> from final to]} {
    lappend rules $from $to [string compare "." $final] [string length $from]
    } else {
    error "Syntax error: \"$line\""
    }
}

# Apply the rules
set f [open $inputFile]
set out [open $outputFile w]
foreach line [split [read $f] \n[close $f]] {
    set any 1
    while {$any} {
    set any 0
    foreach {from to more fl} $rules {
        # If we match the 'from' pattern...
        if {[set idx [string first $from $line]] >= 0} {
        # Change for the 'to' replacement
        set line [string replace $line $idx [expr {$idx+$fl-1}] $to]

        # Stop if we terminate, otherwise note that we've more work to do
            set any $more
        break;  # Restart search for rules to apply
        }
    }
        #DEBUG# puts $line
    }

    # Output the processed line
    puts $out $line
}
close $out


if (x & 1) {
    /* x is odd */
} else {
    /* or not */
}


namespace RosettaCode
{
    using System;

    public static class EvenOrOdd
    {
        public static bool IsEvenBitwise(this int number)
        {
            return (number & 1) == 0;
        }

        public static bool IsOddBitwise(this int number)
        {
            return (number & 1) != 0;
        }

        public static bool IsEvenRemainder(this int number)
        {
            int remainder;
            Math.DivRem(number, 2, out remainder);
            return remainder == 0;
        }

        public static bool IsOddRemainder(this int number)
        {
            int remainder;
            Math.DivRem(number, 2, out remainder);
            return remainder != 0;
        }

        public static bool IsEvenModulo(this int number)
        {
            return (number % 2) == 0;
        }

        public static bool IsOddModulo(this int number)
        {
            return (number % 2) != 0;
        }
    }
    public class Program
    {
        public static void Main()
        {
            int num = 26;               //Set this to any integer.
            if (num.IsEvenBitwise())    //Replace this with any even function.
            {
                Console.Write("Even");
            }
            else
            {
                Console.Write("Odd");
            }
            //Prints "Even".
            if (num.IsOddBitwise())    //Replace this with any odd function.
            {
                Console.Write("Odd");
            }
            else
            {
                Console.Write("Even");
            }
            //Prints "Even".
        }
    }
}


  [ 0 1 rot times [ tuck + ] drop ] is fibo ( n --> n )

  100 fibo echo


#include <stdio.h>
#include <limits.h>

/* We go to some effort to handle overflow situations */

static unsigned long gcd_ui(unsigned long x, unsigned long y) {
  unsigned long t;
  if (y < x) { t = x; x = y; y = t; }
  while (y > 0) {
    t = y;  y = x % y;  x = t;  /* y1 <- x0 % y0 ; x1 <- y0 */
  }
  return x;
}

unsigned long binomial(unsigned long n, unsigned long k) {
  unsigned long d, g, r = 1;
  if (k == 0) return 1;
  if (k == 1) return n;
  if (k >= n) return (k == n);
  if (k > n/2) k = n-k;
  for (d = 1; d <= k; d++) {
    if (r >= ULONG_MAX/n) {  /* Possible overflow */
      unsigned long nr, dr;  /* reduced numerator / denominator */
      g = gcd_ui(n, d);  nr = n/g;  dr = d/g;
      g = gcd_ui(r, dr);  r = r/g;  dr = dr/g;
      if (r >= ULONG_MAX/nr) return 0;  /* Unavoidable overflow */
      r *= nr;
      r /= dr;
      n--;
    } else {
      r *= n--;
      r /= d;
    }
  }
  return r;
}

int main() {
    printf("%lu\n", binomial(5, 3));
    printf("%lu\n", binomial(40, 19));
    printf("%lu\n", binomial(67, 31));
    return 0;
}


/*
  BFC.COM
  BrainF**k's Pseudo-compiler!
  Mr_Dalien. NOV 26, 2021
*/
#include <hopper.h>

#proto checkMove(_S_,_OPE_,_CODE_,_BF_)
#proto check(_S_,_OPE_,_CODE_,_BF_)
#proto tabulation(_S_)

main:

  total arg,minus(1) zero?
  do {
      {"\LR","Bad filename!\OFF\n"}print
      {0}return
  }
  filename = [&2]    // get filename parameter 2 (parameter 1 is "bfc.com")

  sf="",{filename}exist?,not,
  do{
      {"File: \LR",filename,"\OFF"," don't exist!\n"}print
      {0}return
  }
  {filename}load string(sf)   // load file as string
  --sf                        // "load string" load adding a newline at the EOS. "--sf" delete it!

  // determine tape size:
  rightMove=0,{">",sf}count at, mov(rightMove)
  leftMove=0,{"<",sf}count at, mov(leftMove)
  totalCells = 0
  prec(0)   // precision 0 decimals: all number are integers!
  {0}{rightMove}minus(leftMove), cpy(totalCells),lt?
  do{
      {"In file \LR",filename,"\OFF",": program bad formed!\n"}print
      {0}return
  }

  // start process!
  nLen=0, {sf}len,mov(nLen)

  i=1,       // index
  res={},    // new file "C"
  space=5    // tab space
  // header:
  {"#include <stdio.h>","int main(){","     int ptr=0, i=0, cell["},{totalCells},xtostr,cat,{"];"}cat,push all(res)
  {"     for( i=0; i<",totalCells},xtostr,cat,{"; ++i) cell[i]=0;"}cat,push(res)

  iwhile={},swOk=0,true(swOk)
  cntMove=0
  v=""
  __PRINCIPAL__:
     [i:i]get(sf),mov(v),
     switch(v)
        case(">")::do{
           _checkMove(">","+","ptr",sf),
           _tabulation(space),{"if(ptr>="}cat,{totalCells},xtostr,cat
                              {") perror(\"Program pointer overflow\");"}cat,push(res),
           exit
        }
        case("<")::do{
           _checkMove("<","-","ptr",sf),
           _tabulation(space),{"if(ptr<0) perror(\"Program pointer underflow\");"}cat,push(res),
           exit
        }
        case("+")::do{
           _check("+","+","cell[ptr]",sf), exit
        }
        case("-")::do{
           _check("-","-","cell[ptr]",sf), exit
        }
        case("[")::do{
           {"]"}push(iwhile)
           _tabulation(space),{"while(cell[ptr])"}cat,push(res),
           _tabulation(space),{"{"}cat,push(res)
           space += 5
           exit
        }
        case("]")::do{
           try
               pop(iwhile),kill
               space -= 5, _tabulation(space),{"}"}cat,push(res)
           catch(e)
              {"SIMBOL: ",v,", POS: ",i,": \LR","Symbol out of context \OFF"}println
              false(swOk)
           finish
           exit
        }
        case(".")::do{
            _tabulation(space),{"putchar(cell[ptr]);"}cat,push(res)
            exit
        }
        case(",")::do{
            _tabulation(space),{"cell[ptr] = getc(stdin);"}cat,push(res)
            exit
        }
       // otherwise?
        {"WARNING! SIMBOL(ASCII): ",v}asc,{", POS: ",i,": \LY","Invalid code, is ommited!\OFF\n"}print

     end switch
     {cntMove}neg?    // exist more "<" than ">" ??
     do {
        {"SIMBOL: ",v,", POS: ",i,": \LR","Underflow detected!\OFF\n"}print
        false(swOk)
     }
     ++i,{nLen,i}le?,{swOk},and,jt(__PRINCIPAL__)

  {swOk} do{
     _tabulation(space),{"return 0;"}cat,push(res)
     space -=5
     {"}"}push(res)

     name="",   {"",".bf",filename},transform,mov(name),  // bye bye ".bf"!
     cname="",  {name,".c"}cat,mov(cname),                // hello <filename>.c!
     {"\n"}tok sep                     // save array with newlines
     {res,cname},save                  // save the array into the <filename>.c"
     {" "}tok sep                      // "join" need this!
     executable="",  {"gcc ",cname," -o ",name} join(executable)  // line to compile new filename
     {executable}execv                 // do compile c program generated!

     /* OPTIONAL: remove <filename>.c */
     // {"rm ",cname}cat,execv
  }
  {"\LG","Compilation terminated "}
  if({swOk}not)
     {"\LR","with errors!\OFF\n"}
  else
     {"successfully!\OFF\n"}
  end if
  print
exit(0)

.locals
checkMove(simb,operator,code,bfprg)
   c=1,
   {cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
   __SUB_MOVE__:
      ++i,[i:i]get(sf),{simb}eq?
      do{ ++c,
          {cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
          jmp(__SUB_MOVE__)
      }
   _tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
   push(res)
   --i
back
check(simb,operator,code,bfprg)
   c=1,
   __SUB__:
      ++i,[i:i]get(sf),{simb}eq? do{ ++c, jmp(__SUB__) }
   _tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
   push(res)
   --i
back
tabulation(space)
   {" "}replyby(space)
back


set codeString to text returned of (display dialog "Enter BF code:" buttons "OK" default answer "")
set inputString to text returned of (display dialog "Enter input string" buttons "OK" default answer "")
set codePointer to 1
set loopPosns to {}
set tape to {}
set tapePointer to 1
set output to {}
set inputPointer to 1
set step to 0

set thePath to (path to desktop as Unicode text) & "log.txt"
set debug to (open for access file thePath with write permission)

write (step as string) & " (" & ((codePointer - 1) as string) & "): (The program contains " & ((length of codeString) as string) & " instructions.)
" to debug

set step to 1

on betterMod(x, y) -- so -2 mod 256 is 254 instead of -2
	local x
	local y
	try
		return -y * (round (x / y) rounding down) + x
	on error eMsg number eNum
		error "Can't call betterMod() on " & eMsg number eNum
	end try
end betterMod

repeat while codePointer ≤ length of codeString
	set theChar to (get character codePointer of codeString)

	if (theChar = "+") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		set item tapePointer of tape to betterMod(((get item tapePointer of tape) + 1), 256)
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | a[" & ((tapePointer - 1) as string) & "]= " & ((item tapePointer of tape) as string) & "
" to debug
	else if (theChar = "-") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		set item tapePointer of tape to betterMod(((get item tapePointer of tape) - 1), 256)
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | a[" & ((tapePointer - 1) as string) & "]= " & ((item tapePointer of tape) as string) & "
" to debug
	else if (theChar = "<") then
		set tapePointer to tapePointer - 1
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | array pos. now " & ((tapePointer - 1) as string) & "
" to debug

	else if (theChar = ">") then
		set tapePointer to tapePointer + 1
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | array pos. now " & ((tapePointer - 1) as string) & "
" to debug

	else if (theChar = "[") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Array[" & ((tapePointer - 1) as string) & "] is '" & ((item tapePointer of tape) as string) & "'" to debug
		if (item tapePointer of tape ≠ 0) then
			set loopPosns to loopPosns & codePointer
			write " ** Loop nesting level: " & (((length of loopPosns) - 1) as string) & ".
" to debug
		else
			write "
" & (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Not entering a loop but skipping to instruction number " to debug
			set matchLoops to 1
			repeat while matchLoops ≠ 0
				set codePointer to codePointer + 1
				if (item codePointer of codeString = "[") then
					set matchLoops to matchLoops + 1
				else if (item codePointer of codeString = "]") then
					set matchLoops to matchLoops - 1
				end if
			end repeat
			write ((codePointer - 1) as string) & "
" to debug
		end if

	else if (theChar = "]") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Array[" & ((tapePointer - 1) as string) & "] is '" & ((item tapePointer of tape) as string) & "'
" to debug
		if (item tapePointer of tape ≠ 0) then
			write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | looping back to " & (((item (length of loopPosns) of loopPosns) - 1) as string) & "
" to debug
			set codePointer to (item (length of loopPosns) of loopPosns) - 1
		end if
		if (length of loopPosns > 1) then
			set loopPosns to items 1 thru ((length of loopPosns) - 1) of loopPosns
		else
			set loopPosns to {}
		end if

	else if (theChar = ".") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | output '" & ((item tapePointer of tape) as string) & "' " & string id (item tapePointer of tape) & "
" to debug
		set output to output & item tapePointer of tape

	else if (theChar = ",") then
		repeat while (length of tape < tapePointer)
			set tape to tape & 0
		end repeat
		if (inputPointer > length of inputString) then
			set inputPointer to 1
		end if
		set item tapePointer of tape to id of item inputPointer of inputString
		set inputPointer to inputPointer + 1
		write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | read in " & string id (item tapePointer of tape) & " (" & ((item tapePointer of tape) as string) & ")
" to debug
	end if

	set codePointer to codePointer + 1
	set step to step + 1
end repeat

set strout to string id output
display dialog strout
close access debug


'Factorial - smallbasic - 05/01/2019
For n = 1 To 25
    f = 1
    For i = 1 To n
        f = f * i
    EndFor
    TextWindow.WriteLine("Factorial(" + n + ")=" + f)
EndFor


((dup 0 ==) 'succ (dup pred) '* linrec) :factorial


import system'routines;
import extensions;
import extensions'text;

const string Target = "METHINKS IT IS LIKE A WEASEL";
const string AllowedCharacters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";

const int C = 100;
const real P = 0.05r;

rnd = randomGenerator;

randomChar
    = AllowedCharacters[rnd.nextInt(AllowedCharacters.Length)];

extension evoHelper
{
    randomString()
        = 0.repeatTill(self).selectBy:(x => randomChar).summarize(new StringWriter());

    fitnessOf(s)
        = self.zipBy(s, (a,b => a==b ? 1 : 0)).summarize(new Integer()).toInt();

    mutate(p)
        = self.selectBy:(ch => rnd.nextReal() <= p ? randomChar : ch).summarize(new StringWriter());
}

class EvoAlgorithm : Enumerator
{
    object theTarget;
    object theCurrent;
    object theVariantCount;

    constructor new(s,count)
    {
        theTarget := s;
        theVariantCount := count.toInt();
    }

    get() = theCurrent;

    bool next()
    {
        if (nil == theCurrent)
            { theCurrent := theTarget.Length.randomString(); ^ true };

        if (theTarget == theCurrent)
            { ^ false };

        auto variants := Array.allocate(theVariantCount).populate:(x => theCurrent.mutate:P );

        theCurrent := variants.sort:(a,b => a.fitnessOf:Target > b.fitnessOf:Target ).at:0;

        ^ true
    }

    reset()
    {
        theCurrent := nil
    }

    enumerable() => theTarget;
}

public program()
{
    var attempt := new Integer();
    EvoAlgorithm.new(Target,C).forEach:(current)
    {
        console
            .printPaddingLeft(10,"#",attempt.append(1))
            .printLine(" ",current," fitness: ",current.fitnessOf(Target))
    };

    console.readChar()
}


defmodule Log do
  def show(offspring,i) do
    IO.puts "Generation: #{i}, Offspring: #{offspring}"
  end

  def found({target,i}) do
    IO.puts "#{target} found in #{i} iterations"
  end
end

defmodule Evolution do
  # char list from A to Z; 32 is the ord value for space.
  @chars  [32 | Enum.to_list(?A..?Z)]

  def select(target) do
    (1..String.length(target)) # Creates parent for generation 0.
      |> Enum.map(fn _-> Enum.random(@chars) end)
      |> mutate(to_charlist(target),0)
      |> Log.found
  end

  # w is used to denote fitness in population genetics.

  defp mutate(parent,target,i) when target == parent, do: {parent,i}
  defp mutate(parent,target,i) do
    w = fitness(parent,target)
    prev = reproduce(target,parent,mu_rate(w))

    # Check if the most fit member of the new gen has a greater fitness than the parent.
    if w < fitness(prev,target) do
      Log.show(prev,i)
      mutate(prev,target,i+1)
    else
      mutate(parent,target,i+1)
    end
  end

  # Generate 100 offspring and select the one with the greatest fitness.

  defp reproduce(target,parent,rate) do
    [parent | (for _ <- 1..100, do: mutation(parent,rate))]
      |> Enum.max_by(fn n -> fitness(n,target) end)
  end

  # Calculate fitness by checking difference between parent and offspring chars.

  defp fitness(t,r) do
    Enum.zip(t,r)
      |> Enum.reduce(0, fn {tn,rn},sum -> abs(tn - rn) + sum end)
      |> calc
  end

  # Generate offspring based on parent.

  defp mutation(p,r) do
    # Copy the parent chars, then check each val against the random mutation rate
    Enum.map(p, fn n -> if :rand.uniform <= r, do: Enum.random(@chars), else: n end)
  end

  defp calc(sum),  do: 100 * :math.exp(sum/-10)
  defp mu_rate(n), do: 1   - :math.exp(-(100-n)/400)
end

Evolution.select("METHINKS IT IS LIKE A WEASEL")


class markovparser

    dim aRules
    public property let ruleset( sBlock )
        dim i
        aRules = split( sBlock, vbNewLine )
        '~ remove blank lines from end of array
        do while aRules( ubound( aRules ) ) = vbnullstring
            redim preserve aRules( ubound( aRules ) - 1 )
        loop
        '~ parse array
        for i = lbound( aRules ) to ubound( aRules )
            if left( aRules( i ), 1 ) = "#" then
                aRules( i ) = Array( vbnullstring, aRules(i))
            else
                aRules( i ) = Split( aRules( i ), " -> ", 2 )
            end if
        next
    end property

    public function apply( sArg )
        dim ruleapplied
        dim terminator
        dim was
        dim i
        dim repl
        dim changes

        ruleapplied = true
        terminator = false

        do while ruleapplied and (not terminator)
            changes = 0
            was = sArg
            for i = lbound( aRules ) to ubound( aRules )
                repl = aRules(i)(1)
                if left( repl, 1 ) = "." then
                    terminator = true
                    repl = mid( repl, 2 )
                end if
                sArg = replace( sArg, aRules(i)(0), repl)
                if was <> sArg then
                    changes = changes + 1
                    if changes = 1 then
                        exit for
                    end if
                end if
                if terminator then
                    exit for
                end if
            next
            if changes = 0 then
                ruleapplied = false
            end if
        loop
        apply = sArg
    end function

    sub dump
        dim i
        for i = lbound( aRules ) to ubound( aRules )
            wscript.echo eef(aRules(i)(0)=vbnullstring,aRules(i)(1),aRules(i)(0)& " -> " & aRules(i)(1))  & eef( left( aRules(i)(1), 1 ) = ".", " #terminator", "" )
        next
    end sub

    private function eef( bCond, sExp1, sExp2 )
        if bCond then
            eef = sExp1
        else
            eef = sExp2
        end if
    end function
end class


bool isOdd(int x)
{
    return x % 2;
}

bool isEven(int x)
{
    return !(x % 2);
}


(if (even? some-var) (do-even-stuff))
(if (odd? some-var) (do-odd-stuff))


fib=function(n,x=c(0,1)) {
   if (abs(n)>1) for (i in seq(abs(n)-1)) x=c(x[2],sum(x))
   if (n<0) return(x[2]*(-1)^(abs(n)-1)) else if (n) return(x[2]) else return(0)
}

sapply(seq(-31,31),fib)


using System;

namespace BinomialCoefficients
{
    class Program
    {
        static void Main(string[] args)
        {
            ulong n = 1000000, k = 3;
            ulong result = biCoefficient(n, k);
            Console.WriteLine("The Binomial Coefficient of {0}, and {1}, is equal to: {2}", n, k, result);
            Console.ReadLine();
        }

        static int fact(int n)
        {
            if (n == 0) return 1;
            else return n * fact(n - 1);
        }

        static ulong biCoefficient(ulong n, ulong k)
        {
            if (k > n - k)
            {
                k = n - k;
            }

            ulong c = 1;
            for (uint i = 0; i < k; i++)
            {
                c = c * (n - i);
                c = c / (i + 1);
            }
            return c;
        }
    }
}


double Factorial(double nValue)
   {
       double result = nValue;
       double result_next;
       double pc = nValue;
       do
       {
           result_next = result*(pc-1);
           result = result_next;
           pc--;
       }while(pc>2);
       nValue = result;
       return nValue;
   }

double binomialCoefficient(double n, double k)
   {
       if (abs(n - k) < 1e-7 || k  < 1e-7) return 1.0;
       if( abs(k-1.0) < 1e-7 || abs(k - (n-1)) < 1e-7)return n;
       return Factorial(n) /(Factorial(k)*Factorial((n - k)));
   }


;
; Brainf*ck compiler
; In Arturo
;

Tape: [0]
DataPointer: new 0
InstructionPointer: new 0

; Look for jumps in Code an register them
; in the Jumps table

precomputeJumps: function [][
    vstack: new []
    jumphash: new #[]
    instrPointer: 0

    while [instrPointer<CodeLength] [
        command: get split Code instrPointer
        if? command="[" -> 'vstack ++ instrPointer
        else [
            if command="]" [
                target: last vstack
                chop 'vstack
                jumphash\[target]: instrPointer
                jumphash\[instrPointer]: target
            ]
        ]
        instrPointer: instrPointer+1
    ]
    jumphash
]

; Check if current state is valid

StateIsValid: function [][
    all? @[
        0 =< DataPointer
        DataPointer < size Tape
        0 =< InstructionPointer
        InstructionPointer < CodeLength
    ]
]

; Compile the program

interpret: function [].export:[DataPointer,InstructionPointer,Tape][
    while [StateIsValid][
        command: get split Code InstructionPointer
        case [command=]
            when? ["+"] -> Tape\[DataPointer]: Tape\[DataPointer]+1
            when? ["-"] -> Tape\[DataPointer]: Tape\[DataPointer]-1
            when? [">"] [
                inc 'DataPointer
                if DataPointer = size Tape -> Tape: Tape ++ 0
            ]
            when? ["<"] -> dec 'DataPointer
            when? ["."] -> prints to :string to :char Tape\[DataPointer]
            when? [","][
                inp: to :integer input ""
                if inp=13 -> inp: 10
                if inp=3  -> panic "something went wrong!"
                set Tape DataPointer inp
            ]
            when? ["["] ->
                if 0 = get Tape DataPointer [ InstructionPointer: new get Jumps InstructionPointer ]

            when? ["]"] ->
                if 0 <> get Tape DataPointer [
                    InstructionPointer: new get Jumps InstructionPointer
                ]

        inc 'InstructionPointer
    ]
]

Code: ""
if? 1>size arg  -> Code: "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
else            -> Code: read arg\0

CodeLength: size Code
Jumps: precomputeJumps

interpret


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

print factorial(10)


var int: factorial(int: n) =
  let {
    array[0..n] of var int: factorial;
    constraint forall(a in 0..n)(
      factorial[a] == if (a == 0) then
        1
      else
        a*factorial[a-1]
      endif
  )} in factorial[n];

var int: fac = factorial(6);
solve satisfy;
output [show(fac),"\n"];


-module(evolution).
-export([run/0]).

-define(MUTATE, 0.05).
-define(POPULATION, 100).
-define(TARGET, "METHINKS IT IS LIKE A WEASEL").
-define(MAX_GENERATIONS, 1000).

run() -> evolve_gens().

evolve_gens() ->
    Initial = random_string(length(?TARGET)),
    evolve_gens(Initial,0,fitness(Initial)).
evolve_gens(Parent,Generation,0) ->
    io:format("Generation[~w]: Achieved the target: ~s~n",[Generation,Parent]);
evolve_gens(Parent,Generation,_Fitness) when Generation == ?MAX_GENERATIONS ->
    io:format("Reached Max Generations~nFinal string is ~s~n",[Parent]);
evolve_gens(Parent,Generation,Fitness) ->
    io:format("Generation[~w]: ~s, Fitness: ~w~n",
              [Generation,Parent,Fitness]),
    Child = evolve_string(Parent),
    evolve_gens(Child,Generation+1,fitness(Child)).

fitness(String) -> fitness(String, ?TARGET).
fitness([],[]) -> 0;
fitness([H|Rest],[H|Target]) -> fitness(Rest,Target);
fitness([_H|Rest],[_T|Target]) -> 1+fitness(Rest,Target).

mutate(String) -> mutate(String,[]).
mutate([],Acc) -> lists:reverse(Acc);
mutate([H|T],Acc) ->
    case random:uniform() < ?MUTATE of
        true ->
            mutate(T,[random_character()|Acc]);
        false ->
            mutate(T,[H|Acc])
    end.

evolve_string(String) ->
    evolve_string(String,?TARGET,?POPULATION,String).
evolve_string(_,_,0,Child) -> Child;
evolve_string(Parent,Target,Population,Best_Child) ->
    Child = mutate(Parent),
    case fitness(Child) < fitness(Best_Child) of
        true ->
            evolve_string(Parent,Target,Population-1,Child);
        false ->
            evolve_string(Parent,Target,Population-1,Best_Child)
    end.

random_character() ->
    case random:uniform(27)-1 of
        26  -> $ ;
        R -> $A+R
    end.

random_string(Length) -> random_string(Length,[]).
random_string(0,Acc) -> Acc;
random_string(N,Acc) when N > 0 ->
    random_string(N-1,[random_character()|Acc]).


import "/ioutil" for FileUtil, File
import "/pattern" for Pattern

var lb = FileUtil.lineBreak

/* rulesets assumed to be separated by a blank line in file */
var readRules = Fn.new { |path|
    return File.read(path).trimEnd().split("%(lb)%(lb)").map { |rs| rs.split(lb) }.toList
}

/* tests assumed to be on consecutive lines */
var readTests = Fn.new { |path| File.read(path).trimEnd().split(lb) }

var rules = readRules.call("markov_rules.txt")
var tests = readTests.call("markov_tests.txt")
var pattern = Pattern.new("+0/s[~.][+0/z]", Pattern.start)
var ix = 0
for (origTest in tests) {
    var captures = []
    for (rule in rules[ix]) {
        if (rule.startsWith("#")) continue
        var splits = rule.split(" -> ")
        var m = pattern.find(splits[1])
        if (m) captures.add([splits[0].trimEnd()] + m.capsText)
    }
    var test = origTest
    while (true) {
        var copy = test
        var redo = false
        for (c in captures) {
            test = test.replace(c[0], c[2])
            if (c[1] == ".") break
            if (test != copy) {
                redo = true
                break
            }
        }
        if (!redo) break
    }
    System.print("%(origTest)\n%(test)\n")
    ix = ix + 1
}


       IF FUNCTION REM(Num, 2) = 0
           DISPLAY Num " is even."
       ELSE
           DISPLAY Num " is odd."
       END-IF


class FibonacciSequence
	**Prints the nth fibonacci number**

	on start

		args := program arguments

		if args empty
			print .fibonacci(8)

		else

			try
				print .fibonacci(integer.parse(args[0]))

			catch FormatException
				print to Console.error made !, "Input must be an integer"
				exit program with error code

			catch OverflowException
				print to Console.error made !, "Number too large"
				exit program with error code

	define fibonacci(n as integer) as integer is shared
		**Returns the nth fibonacci number**

		test
			assert fibonacci(0) = 0
			assert fibonacci(1) = 1
			assert fibonacci(2) = 1
			assert fibonacci(3) = 2
			assert fibonacci(4) = 3
			assert fibonacci(5) = 5
			assert fibonacci(6) = 8
			assert fibonacci(7) = 13
			assert fibonacci(8) = 21

		body
			a, b := 0, 1

			for n
				a, b := b, a + b

			return a


(defn binomial-coefficient [n k]
  (let [rprod (fn [a b] (reduce * (range a (inc b))))]
    (/ (rprod (- n k -1) n) (rprod 1 k))))


binomial_coefficient = (n, k) ->
  result = 1
  for i in [0...k]
    result *= (n - i) / (i + 1)
  result

n = 5
for k in [0..n]
  console.log "binomial_coefficient(#{n}, #{k}) = #{binomial_coefficient(n,k)}"


10 REM BINOMIAL COEFFICIENTS
20 REM COMMODORE BASIC 2.0
30 REM 2021-08-24
40 REM BY ALVALONGO
100 Z=0:U=1
110 FOR N=U TO 10
120 PRINT N;
130 FOR K=Z TO N
140 GOSUB 900
150 PRINT C;
160 NEXT K
170 PRINT
180 NEXT N
190 END
900 REM BINOMIAL COEFFICIENT
910 IF K<Z OR K>N THEN C=Z:RETURN
920 IF K=Z OR K=N THEN C=U:RETURN
930 P=K:IF N-K<P THEN P=N-K
940 C=U
950 FOR I=Z TO P-U
960 C=C/(I+U)*(N-I)
980 NEXT I
990 RETURN


; AutoFucck
; A AutoIt Brainfuck Interpreter
; by minx
; AutoIt Version: 3.3.8.x

; Commands:
; - 	DEC
; +		INC
; [		LOOP START
; ]		LOOP END
; .		Output cell value as ASCII Chr
; ,		Input a ASCII char (cell value = ASCII code)
; :		Ouput cell value as integer
; ;		Input a Integer
; _		Output a single whitespace
; / 	Output an Carriage Return and Line Feed

; You can load & save .atf Files.

#include <WindowsConstants.au3>
#include <EditConstants.au3>
#include <Array.au3>
#include <GUIConstants.au3>
#include <StaticCOnstants.au3>

HotKeySet("{F5}", "_Runn")

$hMain = GUICreate("Autofuck - Real Brainfuck Interpreter", 600, 525)
$mMain = GUICtrlCreateMenu("File")
Global $mCode = GUICtrlCreateMenu("Code")
$mInfo = GUICtrlCreateMenu("Info")
$mCredits = GUICtrlCreateMenuItem("Credits", $mInfo)
$mFile_New = GUICtrlCreateMenuItem("New", $mMain)
$mFile_Open = GUICtrlCreateMenuItem("Open", $mMain)
$mFile_Save = GUICtrlCreateMenuItem("Save", $mMain)
Global $mCode_Run = GUICtrlCreateMenuItem("Run [F5]", $mCode)
Global $lStatus = GUICtrlCreateLabel("++ Autofuck started...", 5, 480, 590, 20, $SS_SUNKEN)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
$eCode = GUICtrlCreateEdit("", 5, 5, 590, 350)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
$eConsole = GUICtrlCreateEdit("", 5, 360, 590, 115, $ES_WANTRETURN)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
GUISetState()

While 1
	$nMsg = GUIGetMsg()
	Switch $nMsg
		Case $mFile_New
			GUICtrlSetData($eCode, "")
		Case $mFile_Open
			GUICtrlSetData($eCode, FileRead(FileOpenDialog("Open Autofuck script", @DesktopDir, "Autofuck (*.atf)")))
		Case $mFile_Save
			FileWrite(FileOpen(StringReplace(FileSaveDialog("Save Autofuck script", @DesktopDir, "Autofuck (*.atf)"), ".atf", "") &".atf", 2), GUICtrlRead($eCode))
		Case $GUI_EVENT_CLOSE
			Exit
		Case $mCredits
			MsgBox(0, "Autofuck", "Copyright by: "&@CRLF&"minx (autoit.de)"&@CRLF&"crashdemons (autoitscript.com)")
	EndSwitch
WEnd

Func _Runn()
	$Timer = TimerInit()
	GUICtrlSetData($lStatus, "++ Program started")
	Global $tData=DllStructCreate('BYTE[65536]')
	Global $pData=0
	GUICtrlSetData($eConsole, "")
	Local $aError[6]=['','Unmatched closing bracket during search','Unmatched opening bracket during search','Unexpected closing bracket','Data pointer passed left boundary','Data pointer passed right boundary']
    Local $sError=''
    Local $i=_Run(GUICtrlRead($eCode))
    If @error>=0 And @error<6 Then $sError=$aError[@error]
    If StringLen($sError) Then GUICtrlSetData($eConsole, 'ERROR: '&$sError&'.'&@CRLF&'Ending Instruction Pointer: '&($i-1)&@CRLF&'Current Data Pointer: '&$pData)
	GUICtrlSetData($lStatus, "++ Program terminated. Runtime: "& Round( TimerDiff($Timer) / 1000, 4) &"s")
EndFunc

Func _Run($Code,$iStart=1,$iEnd=0)
    If $iEnd<1 Then $iEnd=StringLen($Code)
    For $i = $iStart to $iEnd
        Switch StringMid($Code, $i, 1)
            Case ">"
                $pData+=1
                If $pData=65536 Then Return SetError(5,0,$i)
            Case "<"
                $pData-=1
                If $pData<0 Then Return SetError(4,0,$i)
            Case "+"
                DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)+1,$pData+1)
            Case "-"
                DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)-1,$pData+1)
            Case ":"
                GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & (DllStructGetData($tData,1,$pData+1)))
			Case "."
                GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & Chr(DllStructGetData($tData,1,$pData+1)))
            Case ";"
                Local $cIn=StringMid(InputBox('Autofuck','Enter Number'),1)
                DllStructSetData($tData,1,Number($cIn),$pData+1)
			Case ","
                Local $cIn=StringMid(InputBox('Autofuck','Enter one ASCII character'),1,1)
                DllStructSetData($tData,1,Asc($cIn),$pData+1)
            Case "["
                Local $iStartSub=$i
                Local $iEndSub=_MatchBracket($Code,$i,$iEnd)
                If @error<>0 Then Return SetError(@error,0,$iEndSub)
                While DllStructGetData($tData,1,$pData+1)<>0
                    Local $iRet=_Run($Code,$iStartSub+1,$iEndSub-1)
                    If @error<>0 Then Return SetError(@error,0,$iRet)
                WEnd
                $i=$iEndSub
            Case ']'
                Return SetError(3,0,$i)
			Case "_"
				GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&" ")
			Case "/"
				GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&@CRLF)
        EndSwitch
    Next
    Return 0
EndFunc

Func _MatchBracket($Code,$iStart=1,$iEnd=0)
    If $iEnd<1 Then $iEnd=StringLen($Code)
    Local $Open=0
    For $i=$iStart To $iEnd
        Switch StringMid($Code,$i,1)
            Case '['
                $Open+=1
            Case ']'
                $Open-=1
                If $Open=0 Then Return $i
                If $Open<0 Then Return SetError(1,0,$i)
        EndSwitch
    Next
    If $Open>0 Then Return SetError(2,0,$i)
    Return 0
EndFunc


#include <algorithm>
#include <cassert>
#include <iomanip>
#include <iostream>
#include <map>
#include <vector>

#include <primesieve.hpp>

class erdos_selfridge {
public:
    explicit erdos_selfridge(int limit);
    uint64_t get_prime(int index) const { return primes_[index].first; }
    int get_category(int index);

private:
    std::vector<std::pair<uint64_t, int>> primes_;
    size_t get_index(uint64_t prime) const;
};

erdos_selfridge::erdos_selfridge(int limit) {
    primesieve::iterator iter;
    for (int i = 0; i < limit; ++i)
        primes_.emplace_back(iter.next_prime(), 0);
}

int erdos_selfridge::get_category(int index) {
    auto& pair = primes_[index];
    if (pair.second != 0)
        return pair.second;
    int max_category = 0;
    uint64_t n = pair.first + 1;
    for (int i = 0; n > 1; ++i) {
        uint64_t p = primes_[i].first;
        if (p * p > n)
            break;
        int count = 0;
        for (; n % p == 0; ++count)
            n /= p;
        if (count != 0) {
            int category = (p <= 3) ? 1 : 1 + get_category(i);
            max_category = std::max(max_category, category);
        }
    }
    if (n > 1) {
        int category = (n <= 3) ? 1 : 1 + get_category(get_index(n));
        max_category = std::max(max_category, category);
    }
    pair.second = max_category;
    return max_category;
}

size_t erdos_selfridge::get_index(uint64_t prime) const {
    auto it = std::lower_bound(primes_.begin(), primes_.end(), prime,
                               [](const std::pair<uint64_t, int>& p,
                                  uint64_t n) { return p.first < n; });
    assert(it != primes_.end());
    assert(it->first == prime);
    return std::distance(primes_.begin(), it);
}

auto get_primes_by_category(erdos_selfridge& es, int limit) {
    std::map<int, std::vector<uint64_t>> primes_by_category;
    for (int i = 0; i < limit; ++i) {
        uint64_t prime = es.get_prime(i);
        int category = es.get_category(i);
        primes_by_category[category].push_back(prime);
    }
    return primes_by_category;
}

int main() {
    const int limit1 = 200, limit2 = 1000000;

    erdos_selfridge es(limit2);

    std::cout << "First 200 primes:\n";
    for (const auto& p : get_primes_by_category(es, limit1)) {
        std::cout << "Category " << p.first << ":\n";
        for (size_t i = 0, n = p.second.size(); i != n; ++i) {
            std::cout << std::setw(4) << p.second[i]
                      << ((i + 1) % 15 == 0 ? '\n' : ' ');
        }
        std::cout << "\n\n";
    }

    std::cout << "First 1,000,000 primes:\n";
    for (const auto& p : get_primes_by_category(es, limit2)) {
        const auto& v = p.second;
        std::cout << "Category " << std::setw(2) << p.first << ": "
                  << "first = " << std::setw(7) << v.front()
                  << "  last = " << std::setw(8) << v.back()
                  << "  count = " << v.size() << '\n';
    }
}


'**********************************************
'Subject: Comparing five methods for
'         computing Euler's constant 0.5772...
'tested : FreeBasic 1.08.1
'----------------------------------------------
const eps = 1e-6
dim as double a, b, h, n2, r, u, v
dim as integer k, k2, m, n

? "From the definition, err. 3e-10"

n = 400

h = 1
for k = 2 to n
   h += 1 / k
next k
'faster convergence: Negoi, 1997
a = log(n +.5 + 1 / (24*n))

? "Hn   "; h
? "gamma"; h - a; !"\nk ="; n
?

? "Sweeney, 1963, err. idem"

n = 21

dim as double s(1) = {0, n}
r = n
k = 1
do
   k += 1
   r *= n / k
   s(k and 1) += r / k
loop until r < eps

? "gamma"; s(1) - s(0) - log(n); !"\nk ="; k
?

? "Bailey, 1988"

n = 5

a = 1
h = 1
n2 = 2^n
r = 1
k = 1
do
   k += 1
   r *= n2 / k
   h += 1 / k
   b = a: a += r * h
loop until abs(b - a) < eps
a *= n2 / exp(n2)

? "gamma"; a - n * log(2); !"\nk ="; k
?

? "Brent-McMillan, 1980"

n = 13

a = -log(n)
b = 1
u = a
v = b
n2 = n * n
k2 = 0
k = 0
do
   k2 += 2*k + 1
   k += 1
   a *= n2 / k
   b *= n2 / k2
   a = (a + b) / k
   u += a
   v += b
loop until abs(a) < eps

? "gamma"; u / v; !"\nk ="; k
?

? "How Euler did it in 1735"
'Bernoulli numbers with even indices
dim as double B2(9) = {1,1/6,-1/30,1/42,_
 -1/30,5/66,-691/2730,7/6,-3617/510,43867/798}
m = 7
if m > 9 then end

n = 10

'n-th harmonic number
h = 1
for k = 2 to n
   h += 1 / k
next k
? "Hn   "; h

h -= log(n)
? "  -ln"; h

'expansion C = -digamma(1)
a = -1 / (2*n)
n2 = n * n
r = 1
for k = 1 to m
   r *= n2
   a += B2(k) / (2*k * r)
next k

? "err  "; a; !"\ngamma"; h + a; !"\nk ="; n + m
?
? "C  =  0.57721566490153286..."
end


##################################
# Factorial; iterative           #
# By Keith Stellyes :)           #
# Targets Mars implementation    #
# August 24, 2016                #
##################################

# This example reads an integer from user, stores in register a1
# Then, it uses a0 as a multiplier and target, it is set to 1

# Pseudocode:
# a0 = 1
# a1 = read_int_from_user()
# while(a1 > 1)
# {
# a0 = a0*a1
# DECREMENT a1
# }
# print(a0)

.text ### PROGRAM BEGIN ###
	### GET INTEGER FROM USER ###
	li $v0, 5 #set syscall arg to READ_INTEGER
	syscall #make the syscall
	move $a1, $v0 #int from READ_INTEGER is returned in $v0, but we need $v0
	              #this will be used as a counter

	### SET $a1 TO INITAL VALUE OF 1 AS MULTIPLIER ###
	li $a0,1

	### Multiply our multiplier, $a1 by our counter, $a0 then store in $a1 ###
loop:	ble $a1,1,exit # If the counter is greater than 1, go back to start
	mul $a0,$a0,$a1 #a1 = a1*a0

	subi $a1,$a1,1 # Decrement counter

	j loop # Go back to start

exit:
	### PRINT RESULT ###
	li $v0,1 #set syscall arg to PRINT_INTEGER
	#NOTE: syscall 1 (PRINT_INTEGER) takes a0 as its argument. Conveniently, that
	#      is our result.
	syscall  #make the syscall

	#exit
	li $v0, 10 #set syscall arg to EXIT
	syscall #make the syscall


constant table = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
function random_generation(integer len)
    sequence s
    s = rand(repeat(length(table),len))
    for i = 1 to len do
        s[i] = table[s[i]]
    end for
    return s
end function

function mutate(sequence s, integer n)
    for i = 1 to length(s) do
        if rand(n) = 1 then
            s[i] = table[rand(length(table))]
        end if
    end for
    return s
end function

function fitness(sequence probe, sequence target)
    atom sum
    sum = 0
    for i = 1 to length(target) do
        sum += power(find(target[i], table) - find(probe[i], table), 2)
    end for
    return sqrt(sum/length(target))
end function

constant target = "METHINKS IT IS LIKE A WEASEL", C = 30, MUTATE = 15
sequence parent, specimen
integer iter, best
atom fit, best_fit
parent = random_generation(length(target))
iter = 0
while not equal(parent,target) do
    best_fit = fitness(parent, target)
    printf(1,"Iteration: %3d, \"%s\", deviation %g\n", {iter, parent, best_fit})
    specimen = repeat(parent,C+1)
    best = C+1
    for i = 1 to C do
        specimen[i] = mutate(specimen[i], MUTATE)
        fit = fitness(specimen[i], target)
        if fit < best_fit then
            best_fit = fit
            best = i
        end if
    end for
    parent = specimen[best]
    iter += 1
end while
printf(1,"Finally, \"%s\"\n",{parent})


fcn parseRuleSet(lines){
   if(vm.numArgs>1) lines=vm.arglist;  // lines or object
   ks:=L(); vs:=L();
   foreach line in (lines){
      if(line[0]=="#") continue;    // nuke <comment>
      pattern,replacement:=line.replace("\t"," ")
         .split(" -> ",1).apply("strip");
      ks.append(pattern); vs.append(replacement);
   }
   return(ks,vs);
}

fcn markov(text,rules){
   ks,vs:=rules; eks:=ks.enumerate();
   do{ go:=False;
      foreach n,k in (eks){
     if (Void!=text.find(k)){
        if (Void==(v:=vs[n])) return(text);
        if (v[0,1]==".") v=v[1,*] else go=True;
        text=text.replace(k,v,1);
        break;  // restart after every rule application, unless terminating
     }
      }
   }while(go);
   text
}


function f(numeric n) {
   return n mod 2?"odd":"even"
}


(if (evenp some-var) (do-even-stuff))
(if (oddp some-other-var) (do-odd-stuff))


(define (fib n)
  (let loop ((cnt 0) (a 0) (b 1))
    (if (= n cnt)
        a
        (loop (+ cnt 1) b (+ a b)))))


(defun choose (n k)
  (labels ((prod-enum (s e)
	     (do ((i s (1+ i)) (r 1 (* i r))) ((> i e) r)))
	   (fact (n) (prod-enum 1 n)))
    (/ (prod-enum (- (1+ n) k) n) (fact k))))


T binomial(T)(in T n, T k) pure nothrow {
    if (k > (n / 2))
        k = n - k;
    T bc = 1;
    foreach (T i; T(2) .. k + 1)
        bc = (bc * (n - k + i)) / i;
    return bc;
}

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

    foreach (const d; [[5, 3], [100, 2], [100, 98]])
        writefln("(%3d %3d) = %s", d[0], d[1], binomial(d[0], d[1]));
    writeln("(100  50) = ", binomial(100.BigInt, 50.BigInt));
}


// Erdös-Selfridge categorization of primes. Nigel Galloway: April 12th., 2022
let rec fG n g=match n,g with ((_,1),_)|(_,[])->n |((_,p),h::_) when h>p->n |((p,q),h::_) when q%h=0->fG (p,q/h) g |(_,_::g)->fG n g
let fN g=Seq.unfold(fun(n,g)->let n,g=n|>List.map(fun n->fG n g)|>List.partition(fun(_,n)->n<>1) in let g=g|>List.map fst in if g=[] then None else Some(g,(n,g)))(primes32()|>Seq.take g|>Seq.map(fun n->(n,n+1))|>List.ofSeq,[2;3])
fN 200|>Seq.iteri(fun n g->printfn "Category %d: %A" (n+1) g)
fN 1000000|>Seq.iteri(fun n g->printfn "Category %d: first->%d last->%d count->%d" (n+1) (List.head g) (List.last g) (


USING: assocs combinators formatting grouping grouping.extras io
kernel math math.primes math.primes.factors math.statistics
prettyprint sequences sequences.deep ;

PREDICATE: >3 < integer 3 > ;

GENERIC: depth ( seq -- n )

M: sequence depth
    0 swap [ flatten1 [ 1 + ] dip ] to-fixed-point drop ;

M: integer depth drop 1 ;

MEMO: pfactors ( n -- seq ) 1 + factors ;

: category ( m -- n )
    [ dup >3? [ pfactors ] when ] deep-map depth ;

: categories ( n -- assoc ) nprimes [ category ] collect-by ;

: table. ( seq n -- )
    [ "" pad-groups ] keep group simple-table. ;

: categories... ( assoc -- )
    [ [ "Category %d:\n" printf ] dip 15 table. ] assoc-each ;

: row. ( category first last count -- )
    "Category %d: first->%d last->%d count->%d\n" printf ;

: categories. ( assoc -- )
    [ [ minmax ] keep length row. ] assoc-each ;

200 categories categories... nl
1,000,000 categories categories.


package main

import (
    "fmt"
    "math"
    "rcu"
)

var limit = int(math.Log(1e6) * 1e6 * 1.2) // should be more than enough
var primes = rcu.Primes(limit)

var prevCats = make(map[int]int)

func cat(p int) int {
    if v, ok := prevCats[p]; ok {
        return v
    }
    pf := rcu.PrimeFactors(p + 1)
    all := true
    for _, f := range pf {
        if f != 2 && f != 3 {
            all = false
            break
        }
    }
    if all {
        return 1
    }
    if p > 2 {
        len := len(pf)
        for i := len - 1; i >= 1; i-- {
            if pf[i-1] == pf[i] {
                pf = append(pf[:i], pf[i+1:]...)
            }
        }
    }
    for c := 2; c <= 11; c++ {
        all := true
        for _, f := range pf {
            if cat(f) >= c {
                all = false
                break
            }
        }
        if all {
            prevCats[p] = c
            return c
        }
    }
    return 12
}

func main() {
    es := make([][]int, 12)
    fmt.Println("First 200 primes:\n")
    for _, p := range primes[0:200] {
        c := cat(p)
        es[c-1] = append(es[c-1], p)
    }
    for c := 1; c <= 6; c++ {
        if len(es[c-1]) > 0 {
            fmt.Println("Category", c, "\b:")
            fmt.Println(es[c-1])
            fmt.Println()
        }
    }

    fmt.Println("First million primes:\n")
    for _, p := range primes[200:1e6] {
        c := cat(p)
        es[c-1] = append(es[c-1], p)
    }
    for c := 1; c <= 12; c++ {
        e := es[c-1]
        if len(e) > 0 {
            format := "Category %-2d: First = %7d  Last = %8d  Count = %6d\n"
            fmt.Printf(format, c, e[0], e[len(e)-1], len(e))
        }
    }
}


import std/math

const n = 1e6
var result = 1.0

for i in 2..int(n):
  result += 1/i

echo result - ln(n)


\l "euler_const.log"
\p 100
print("gamma ", Euler);
\q


#!/usr/bin/perl

use strict; # https://en.wikipedia.org/wiki/Euler%27s_constant
use warnings;
use List::Util qw( sum );

print sum( map 1 / $_, 1 .. 1e6) - log 1e6, "\n";


-- demo\rosetta\Eulers_constant.exw
with javascript_semantics
constant C = sum(sq_div(1,tagset(1e6)))-log(1e6)
printf(1,"gamma %.12f  (max 12d.p. of accuracy)\n",C)