rem - iterative function to calculate nth fibonacci number
function fibonacci(n = integer) = integer
var f, i, p1, p2 = integer
p1 = 0
p2 = 1
if n = 0 then
   f = 0
else
   for i = 1 to n
      f = p1 + p2
      p2 = p1
      p1 = f
   next i
end = f

rem - exercise the function
var i = integer
for i = 0 to 10
   print fibonacci(i);
next i

end


// Number of combinations nCr
00 0E  Go:    ENT  R0   // n
01 1E         ENT  R1   // r
02 2C         CLR  R2
03 2A  Loop:  ADD1 R2
04 0D         DEC  R0
05 1D         DEC  R1
06 C3         JNZ  Loop
07 3C         CLR  R3   // for result
08 3A         ADD1 R3
09 0A  Next:  ADD1 R0
0A 1A         ADD1 R1
0B 50         R5 = R0
0C 5D         DEC  R5
0D 63         R6 = R3
0E 46  Mult:  R4 = R6
0F 3A  Add:   ADD1 R3
10 4D         DEC  R4
11 CF         JNZ  Add
12 5D         DEC  R5
13 CE         JNZ  Mult
14 61  Divide:R6 = R1
15 5A         ADD1 R5
16 3D  Sub:   DEC  R3
17 9B         JZ   Exact
18 6D         DEC  R6
19 D6         JNZ  Sub
1A 94         JZ   Divide
1B 35  Exact: R3 = R5
1C 2D         DEC  R2
1D C9         JNZ  Next
1E 03         R0 = R3
1F 80         JZ   Go   // Display result


П1	<->	П0	ПП	22	П2	 ИП1	ПП	22	П3
ИП0	ИП1	-	ПП	22	ИП3	*	П3	ИП2	ИП3
/	С/П	ВП	П0	1	ИП0	*	L0	25	В/О


def binomialCoeff(n, k)
    result = 1
    for i in range(1, k)
        result = result * (n-i+1) / i
    end
    return result
end

if main
    println binomialCoeff(5,3)
end


proc binomialCoeff(n, k: int): int =
  result = 1
  for i in 1..k:
    result = result * (n-i+1) div i

echo binomialCoeff(5, 3)


MODULE Binomial;
IMPORT
  Out;

PROCEDURE For*(n,k: LONGINT): LONGINT;
VAR
  i,m,r: LONGINT;

BEGIN
  ASSERT(n > k);
  r := 1;
  IF k > n DIV 2 THEN m := n - k ELSE m := k END;
  FOR i := 1 TO m DO
    r := r * (n - m + i) DIV i
  END;
  RETURN r
END For;

BEGIN
  Out.Int(For(5,2),0);Out.Ln
END Binomial.


program Execute_Brain;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

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

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

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

  SetConsoleMode(StdIn, KeyMode);
end;

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

begin

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

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

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

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

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

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

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


: fact(n)  n ifZero: [ 1 ] else: [ n n 1- fact * ] ;


#include <order/interpreter.h>

#define ORDER_PP_DEF_8fac                     \
ORDER_PP_FN(8fn(8N,                           \
                8if(8less_eq(8N, 0),          \
                    1,                        \
                    8mul(8N, 8fac(8dec(8N))))))

ORDER_PP(8to_lit(8fac(8)))    // 40320


let euler f (h : float) t0 y0 =
    (t0, y0)
    |> Seq.unfold (fun (t, y) -> Some((t,y), ((t + h), (y + h * (f t y)))))

let newtonCoolíng _ y = -0.07 * (y - 20.0)

[<EntryPoint>]
let main argv =
    let f  = newtonCoolíng
    let a = 0.0
    let y0 = 100.0
    let b = 100.0
    let h = 10.0
    (euler newtonCoolíng h a y0)
    |> Seq.takeWhile (fun (t,_) -> t <= b)
    |> Seq.iter (printfn "%A")
    0


#include <primesieve.hpp>

#include <chrono>
#include <iomanip>
#include <iostream>
#include <locale>

class composite_iterator {
public:
    composite_iterator();
    uint64_t next_composite();

private:
    uint64_t composite;
    uint64_t prime;
    primesieve::iterator pi;
};

composite_iterator::composite_iterator() {
    composite = prime = pi.next_prime();
    for (; composite == prime; ++composite)
        prime = pi.next_prime();
}

uint64_t composite_iterator::next_composite() {
    uint64_t result = composite;
    while (++composite == prime)
        prime = pi.next_prime();
    return result;
}

int main() {
    std::cout.imbue(std::locale(""));
    auto start = std::chrono::high_resolution_clock::now();
    composite_iterator ci;
    primesieve::iterator pi;
    uint64_t prime_sum = pi.next_prime();
    uint64_t composite_sum = ci.next_composite();
    uint64_t prime_index = 1, composite_index = 1;
    std::cout << "Sum                   | Prime Index  | Composite Index\n";
    std::cout << "------------------------------------------------------\n";
    for (int count = 0; count < 11;) {
        if (prime_sum == composite_sum) {
            std::cout << std::right << std::setw(21) << prime_sum << " | "
                      << std::setw(12) << prime_index << " | " << std::setw(15)
                      << composite_index << '\n';
            composite_sum += ci.next_composite();
            prime_sum += pi.next_prime();
            ++prime_index;
            ++composite_index;
            ++count;
        } else if (prime_sum < composite_sum) {
            prime_sum += pi.next_prime();
            ++prime_index;
        } else {
            composite_sum += ci.next_composite();
            ++composite_index;
        }
    }
    auto end = std::chrono::high_resolution_clock::now();
    std::chrono::duration<double> duration(end - start);
    std::cout << "\nElapsed time: " << duration.count() << " seconds\n";
}


fitness(a::AbstractString, b::AbstractString) = count(l == t for (l, t) in zip(a, b))
function mutate(str::AbstractString, rate::Float64)
    L = collect(Char, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
    return map(str) do c
        if rand() < rate rand(L) else c end
    end
end

function evolve(parent::String, target::String, mutrate::Float64, nchild::Int)
    println("Initial parent is $parent, its fitness is $(fitness(parent, target))")
    gens = 0
    while parent != target
        children = collect(mutate(parent, mutrate) for i in 1:nchild)
        bestfit, best = findmax(fitness.(children, target))
        parent = children[best]
        gens += 1
        if gens % 10 == 0
            println("After $gens generations, the new parent is $parent and its fitness is $(fitness(parent, target))")
        end
    end
    println("After $gens generations, the parent evolved into the target $target")
end

evolve("IU RFSGJABGOLYWF XSMFXNIABKT", "METHINKS IT IS LIKE A WEASEL", 0.08998, 100)


import java.util.*

val target = "METHINKS IT IS LIKE A WEASEL"
val validChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

val random = Random()

fun randomChar() = validChars[random.nextInt(validChars.length)]
fun hammingDistance(s1: String, s2: String) =
        s1.zip(s2).map { if (it.first == it.second) 0 else 1 }.sum()

fun fitness(s1: String) = target.length - hammingDistance(s1, target)

fun mutate(s1: String, mutationRate: Double) =
        s1.map { if (random.nextDouble() > mutationRate) it else randomChar() }
                .joinToString(separator = "")

fun main(args: Array<String>) {
    val initialString = (0 until target.length).map { randomChar() }.joinToString(separator = "")

    println(initialString)
    println(mutate(initialString, 0.2))

    val mutationRate = 0.05
    val childrenPerGen = 50

    var i = 0
    var currVal = initialString
    while (currVal != target) {
        i += 1
        currVal = (0..childrenPerGen).map { mutate(currVal, mutationRate) }.maxBy { fitness(it) }!!
    }
    println("Evolution found target after $i generations")
}


Public Sub Form_Open()
Dim sAnswer, sMessage As String

sAnswer = InputBox("Input an integer", "Odd or even")

If IsInteger(sAnswer) Then
  If Odd(Val(sAnswer)) Then sMessage = "' is an odd number"
  If Even(Val(sAnswer)) Then sMessage = "' is an even number"
Else
  sMessage = "' does not compute!!"
Endif

Print "'" & sAnswer & sMessage

End


data fib;
    a=0;
    b=1;
    do n=0 to 20;
       f=a;
       output;
       a=b;
       b=f+a;
    end;
    keep n f;
run;


let binomialCoeff n p =
  let p = if p < n -. p then p else n -. p in
  let rec cm res num denum =
    (* this method partially prevents overflow.
     * float type is choosen to have increased domain on 32-bits computer,
     * however algorithm ensures an integral result as long as it is possible
     *)
    if denum <= p then cm ((res *. num) /. denum) (num -. 1.) (denum +. 1.)
    else res in
  cm 1. n 1.


: binomial(n, k)  | i |  1 k loop: i [ n i - 1+ * i / ] ;


declare
  fun {BinomialCoeff N K}
     {List.foldL {List.number 1 K 1}
      fun {$ Z I}
         Z * (N-I+1) div I
      end
      1}
  end
in
  {Show {BinomialCoeff 5 3}}


#Import some functions
clojure('count', 1) -> size
clojure('nth', 2) -> charAt
clojure('inc', 1) -> inc
clojure('dec', 1) -> dec
clojure('char', 1) -> char
clojure('int', 1) -> int
clojure('read-line', 0) -> readLine

#The characters we will need
charAt("\n", 0) -> newLine
charAt("@", 0) -> exitCommand
charAt("+", 0) -> incrCommand
charAt("-", 0) -> decrCommand
charAt("<", 0) -> shlCommand
charAt(">", 0) -> shrCommand
charAt(".", 0) -> printCommand
charAt(",", 0) -> inputCommand
charAt("[", 0) -> repeatCommand
charAt("]", 0) -> endCommand

#Read a character from a line of input.
fun readChar -> return
(
	readLine() -> line
	size(line) -> length

	#Return the ith character and a continuation
	fun nextFromLine -> i, return
	(
		'='(i, length) -> eol
		if (eol) ->
		(
			return(newLine, readChar)	#end of line
		)
		|
			charAt(line, i) -> value
			inc(i) -> i
			fun next (-> return) nextFromLine(i, return) | next
			return(value, next)
	)
	| nextFromLine

	nextFromLine(0, return)	#first character (position 0)
)
| readChar

#Define a buffer as a value and a left and right stack
fun empty (-> return, throw) throw("Error: out of bounds") | empty
fun fill (-> return, throw) return(0, fill) | fill

fun makeBuffer -> value, left, right, return
(
	fun buffer (-> return) return(value, left, right) | buffer
	return(buffer)
)
| makeBuffer

fun push -> value, stack, return
(
	fun newStack (-> return, throw) return(value, stack) | newStack
	return(newStack)
)
| push

#Brainf*** operations
fun noop -> buffer, input, return
(
	return(buffer, input)
)
| noop

fun selectOp -> command, return
(
	'='(command, incrCommand) -> eq
	if (eq) ->
	(
		fun increment -> buffer, input, return
		(
			buffer() -> value, left, right
			inc(value) -> value
			makeBuffer(value, left, right) -> buffer
			return(buffer, input)
		)
		| increment
		return(increment)
	)
	|
	'='(command, decrCommand) -> eq
	if (eq) ->
	(
		fun decrement -> buffer, input, return
		(
			buffer() -> value, left, right
			dec(value) -> value
			makeBuffer(value, left, right) -> buffer
			return(buffer, input)
		)
		| decrement
		return(decrement)
	)
	|
	'='(command, shlCommand) -> eq
	if (eq) ->
	(
		fun shiftLeft -> buffer, input, return
		(
			buffer() -> value, left, right
			push(value, right) -> right
			left() -> value, left
			(
				makeBuffer(value, left, right) -> buffer
				return(buffer, input)
			)
			| message
				println(message) ->
				exit()
		)
		| shiftLeft
		return(shiftLeft)
	)
	|
	'='(command, shrCommand) -> eq
	if (eq) ->
	(
		fun shiftRight -> buffer, input, return
		(
			buffer() -> value, left, right
			push(value, left) -> left
			right() -> value, right
			(
				makeBuffer(value, left, right) -> buffer
				return(buffer, input)
			)
			| message
				println(message) ->
				exit()
		)
		| shiftRight
		return(shiftRight)
	)
	|
	'='(command, printCommand) -> eq
	if (eq) ->
	(
		fun putChar -> buffer, input, return
		(
			buffer() -> value, left, right
			char(value) -> value
			'print'(value) -> dummy
			'flush'() -> dummy
			return(buffer, input)
		)
		| putChar
		return(putChar)
	)
	|
	'='(command, inputCommand) -> eq
	if (eq) ->
	(
		fun getChar -> buffer, input, return
		(
			input() -> letter, input
			int(letter) -> letter
			buffer() -> value, left, right
			makeBuffer(letter, left, right) -> buffer
			return(buffer, input)
		)
		| getChar
		return(getChar)
	)
	|
	return(noop)
)
| selectOp

#Repeat until zero operation
fun whileLoop -> buffer, input, continue, break
(
	buffer() -> value, left, right
	'='(value, 0) -> zero
	if (zero) ->
	(
		break(buffer, input)
	)
	|
		continue(buffer, input) -> buffer, input
		whileLoop(buffer, input, continue, break)
)
| whileLoop

#Convert the Brainf*** program into dodo0 instructions
fun compile -> input, endmark, return
(
	input() -> command, input

	'='(command, endmark) -> eq
	if (eq) ->
	(
		return(noop, input)	#the end, stop compiling
	)
	|
		#Put in sequence the current operation and the rest of the program
		fun chainOp -> op, input, return
		(
			compile(input, endmark) -> program, input
			fun exec -> buffer, input, return
			(
				op(buffer, input) -> buffer, input
				program(buffer, input, return)
			)
			| exec
			return(exec, input)
		)
		| chainOp

		'='(command, repeatCommand) -> eq
		if (eq) ->
		(
			compile(input, endCommand) -> body, input	#compile until "]"

			#Repeat the loop body until zero
			fun repeat -> buffer, input, return
			(
				whileLoop(buffer, input, body, return)
			)
			| repeat
			chainOp(repeat, input, return)
		)
		|
			selectOp(command) -> op
			chainOp(op, input, return)
)
| compile

#Main program
compile(readChar, exitCommand) -> program, input
makeBuffer(0, empty, fill) -> buffer
input() -> nl, input	#consume newline from input

#Execute the program instructions
program(buffer, input) -> buffer, input
exit()


fun {Fac1 N}
   {FoldL {List.number 1 N 1} Number.'*' 1}
end


fun fac(n) type integer->integer
  product{{1..n}}

1..10.fac


USING: formatting fry io kernel locals math math.ranges
sequences ;
IN: rosetta-code.euler-method

:: euler ( quot y! a b h -- )
    a b h <range> [
        :> t
        t y "%7.3f %7.3f\n" printf
        t y quot call h * y + y!
    ] each ; inline

: cooling ( t y -- x ) nip 20 - -0.07 * ;

: euler-method-demo ( -- )
   2 5 10 [ '[ [ cooling ] 100 0 100 _ euler ] call nl ] [email protected] ;

MAIN: euler-method-demo


: newton-cooling-law ( f: temp -- f: temp' )
  20e f-  -0.07e f* ;

: euler ( f: y0  xt step end -- )
  1+ 0 do
    cr i . fdup f.
    fdup over execute
    dup s>f f* f+
  dup +loop
  2drop fdrop ;

100e  ' newton-cooling-law  2 100 euler cr
100e  ' newton-cooling-law  5 100 euler cr
100e  ' newton-cooling-law 10 100 euler cr


program euler_method
use iso_fortran_env, only: real64
implicit none

abstract interface
  ! a derivative dy/dt as function of y and t
  function derivative(y, t)
    use iso_fortran_env, only: real64
    real(real64) :: derivative
    real(real64), intent(in) :: t, y
  end function
end interface

real(real64), parameter :: T_0 = 100, T_room = 20, k = 0.07, a = 0, b = 100, &
    h(3) = [2.0, 5.0, 10.0]

integer :: i

! loop over all step sizes
do i = 1, 3
  call euler(newton_cooling, T_0, a, b, h(i))
end do

contains

! Approximates y(t) in y'(t) = f(y, t) with y(a) = y0 and t = a..b and the
! step size h.
subroutine euler(f, y0, a, b, h)
  procedure(derivative) :: f
  real(real64), intent(in) :: y0, a, b, h
  real(real64) :: t, y

  if (a > b) return
  if (h <= 0) stop "negative step size"

  print '("# h = ", F0.3)', h

  y = y0
  t = a

  do
    print *, t, y
    t = t + h
    if (t > b) return
    y = y + h * f(y, t)
  end do
end subroutine

! Example: Newton's cooling law, f(T, _) = -k*(T - T_room)
function newton_cooling(T, unused) result(dTdt)
  real(real64) :: dTdt
  real(real64), intent(in) :: T, unused
  dTdt = -k * (T - T_room)
end function

end program


// Equal prime and composite sums. Nigel Galloway: March 3rd., 2022
let fN(g:seq<int64>)=let g=(g|>Seq.scan(fun(_,n,i) g->(g,n+g,i+1))(0,0L,0)|>Seq.skip 1).GetEnumerator() in (fun()->g.MoveNext()|>ignore; g.Current)
let fG n g=let rec fG a b=seq{match a,b with ((_,p,_),(_,c,_)) when p<c->yield! fG(n()) b |((_,p,_),(_,c,_)) when p>c->yield! fG a (g()) |_->yield(a,b); yield! fG(n())(g())} in fG(n())(g())
fG(fN(primes64()))(fN(primes64()|>Seq.pairwise|>Seq.collect(fun(n,g)->[1L+n..g-1L])))|>Seq.take 11|>Seq.iter(fun((n,i,g),(e,_,l))->printfn $"Primes up to %d{n} at position %d{g} and composites up to %d{e} at position %d{l} sum to %d{i}.")


#include "isprime.bas"

Dim As Integer i = 0
Dim As Integer IndN = 1, IndM = 1
Dim As Integer NumP = 2, NumC = 4
Dim As Integer SumP = 2, SumC = 4
Print "               sum    prime sum     composite sum"
Do
    If SumC > SumP Then
        Do
            NumP += 1
        Loop Until isPrime(NumP)
        SumP += NumP
        IndN += 1
    End If
    If SumP > SumC Then
        Do
            NumC += 1
        Loop Until Not isPrime(NumC)
        SumC += NumC
        IndM += 1
    End If
    If SumP = SumC Then
        Print Using "##,###,###,###,### - ##,###,###  - ##,###,###"; SumP; IndN; IndM
        i += 1
        If i >= 9 Then Exit Do
        Do
            NumC += 1
        Loop Until Not isPrime(NumC)
        SumC += NumC
        IndM += 1
    End If
Loop


package main

import (
    "fmt"
    "log"
    "rcu"
    "sort"
)

func ord(n int) string {
    if n < 0 {
        log.Fatal("Argument must be a non-negative integer.")
    }
    m := n % 100
    if m >= 4 && m <= 20 {
        return fmt.Sprintf("%sth", rcu.Commatize(n))
    }
    m %= 10
    suffix := "th"
    if m == 1 {
        suffix = "st"
    } else if m == 2 {
        suffix = "nd"
    } else if m == 3 {
        suffix = "rd"
    }
    return fmt.Sprintf("%s%s", rcu.Commatize(n), suffix)
}

func main() {
    limit := int(4 * 1e8)
    c := rcu.PrimeSieve(limit-1, true)
    var compSums []int
    var primeSums []int
    csum := 0
    psum := 0
    for i := 2; i < limit; i++ {
        if c[i] {
            csum += i
            compSums = append(compSums, csum)
        } else {
            psum += i
            primeSums = append(primeSums, psum)
        }
    }

    for i := 0; i < len(primeSums); i++ {
        ix := sort.SearchInts(compSums, primeSums[i])
        if ix < len(compSums) && compSums[ix] == primeSums[i] {
            cps := rcu.Commatize(primeSums[i])
            fmt.Printf("%21s - %12s prime sum, %12s composite sum\n", cps, ord(i+1), ord(ix+1))
        }
    }
}


C = 10
'mutaterate has to be greater than 1 or it will not mutate
mutaterate = 2
mutationstaken = 0
generations = 0
Dim parentcopies$((C - 1))
Global targetString$ : targetString$ = "METHINKS IT IS LIKE A WEASEL"
Global allowableCharacters$ : allowableCharacters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
currentminFitness = Len(targetString$)

For i = 1 To Len(targetString$)
    parent$ = parent$ + Mid$(allowableCharacters$, Int(Rnd(1) + 1 * Len(allowableCharacters$)), 1)  'corrected line
Next i

Print "Parent = " + parent$

While parent$ <> targetString$
    generations = (generations + 1)
    For i = 0 To (C - 1)
        parentcopies$(i) = mutate$(parent$, mutaterate)
        mutationstaken = (mutationstaken + 1)
    Next i
    For i = 0 To (C - 1)
        currentFitness = Fitness(targetString$, parentcopies$(i))
        If currentFitness = 0 Then
            parent$ = parentcopies$(i)
            Exit For
        Else
            If currentFitness < currentminFitness Then
                currentminFitness = currentFitness
                parent$ = parentcopies$(i)
            End If
        End If
    Next i
    CLS
    Print "Generation - " + str$(generations)
    Print "Parent - " + parent$
    Scan
Wend

Print
Print "Congratulations to me; I finished!"
Print "Final Mutation: " + parent$
'The ((i + 1) - (C)) reduces the total number of mutations that it took by one generation
'minus the perfect child mutation since any after that would not have been required.
Print "Total Mutations Taken - " + str$(mutationstaken - ((i + 1) - (C)))
Print "Total Generations Taken - " + str$(generations)
Print "Child Number " + str$(i) + " has perfect similarities to your target."
End

Function mutate$(mutate$, mutaterate)
        If (Rnd(1) * mutaterate) > 1 Then
            'The mutatingcharater randomizer needs 1 more than the length of the string
            'otherwise it will likely take forever to get exactly that as a random number
            mutatingcharacter = Int(Rnd(1) * (Len(targetString$) + 1))
            mutate$ = Left$(mutate$, (mutatingcharacter - 1))  + Mid$(allowableCharacters$, Int(Rnd(1) * Len(allowableCharacters$)), 1) _
                      + Mid$(mutate$, (mutatingcharacter + 1))
        End If
End Function

Function Fitness(parent$, offspring$)
    For i = 1 To Len(targetString$)
        If Mid$(parent$, i, 1) <> Mid$(offspring$, i, 1) Then
            Fitness = (Fitness + 1)
        End If
    Next i
End Function


class MAIN is

  -- RECURSIVE --
  fibo(n :INTI):INTI
    pre n >= 0
  is
    if n < 2.inti then return n; end;
    return fibo(n - 2.inti) + fibo(n - 1.inti);
  end;

  -- ITERATIVE --
  fibo_iter(n :INTI):INTI
    pre n >= 0
  is
    n3w :INTI;

    if n < 2.inti then return n; end;
    last ::= 0.inti; this ::= 1.inti;
    loop (n - 1.inti).times!;
      n3w := last + this;
      last := this;
      this := n3w;
    end;
    return this;
  end;

  main is
    loop i ::= 0.upto!(16);
      #OUT + fibo(i.inti) + " ";
      #OUT + fibo_iter(i.inti) + "\n";
    end;
  end;

end;


sub binomial {
    use bigint;
    my ($r, $n, $k) = (1, @_);
    for (1 .. $k) { $r *= $n--; $r /= $_ }
    $r;
}

print binomial(5, 3);


function factorial(n: integer): integer;
 var
  i, result: integer;
 begin
  result := 1;
  for i := 2 to n do
   result := result * i;
  factorial := result
 end;


let analytic(t0: f64) (time: f64): f64 =
  20.0 + (t0 - 20.0) * f64.exp(-0.07*time)

let cooling(_time: f64) (temperature: f64): f64 =
  -0.07 * (temperature-20.0)

let main(t0: f64) (a: f64) (b: f64) (h: f64): []f64 =
  let steps = i32.f64 ((b-a)/h)
  let temps = replicate steps 0.0
  let (_,temps) = loop (t,temps)=(t0,temps) for i < steps do
    let x = a + f64.i32 i * h
    let temps[i] = f64.abs(t-analytic t0 x)
    in (t + h * cooling x t,
        temps)
 in temps


package main

import (
    "fmt"
    "math"
)

// fdy is a type for function f used in Euler's method.
type fdy func(float64, float64) float64

// eulerStep computes a single new value using Euler's method.
// Note that step size h is a parameter, so a variable step size
// could be used.
func eulerStep(f fdy, x, y, h float64) float64 {
    return y + h*f(x, y)
}

// Definition of cooling rate.  Note that this has general utility and
// is not specific to use in Euler's method.

// newCoolingRate returns a function that computes cooling rate
// for a given cooling rate constant k.
func newCoolingRate(k float64) func(float64) float64 {
    return func(deltaTemp float64) float64 {
        return -k * deltaTemp
    }
}

// newTempFunc returns a function that computes the analytical solution
// of cooling rate integrated over time.
func newTempFunc(k, ambientTemp, initialTemp float64) func(float64) float64 {
    return func(time float64) float64 {
        return ambientTemp + (initialTemp-ambientTemp)*math.Exp(-k*time)
    }
}

// newCoolingRateDy returns a function of the kind needed for Euler's method.
// That is, a function representing dy(x, y(x)).
//
// Parameters to newCoolingRateDy are cooling constant k and ambient
// temperature.
func newCoolingRateDy(k, ambientTemp float64) fdy {
    crf := newCoolingRate(k)
    // note that result is dependent only on the object temperature.
    // there are no additional dependencies on time, so the x parameter
    // provided by eulerStep is unused.
    return func(_, objectTemp float64) float64 {
        return crf(objectTemp - ambientTemp)
    }
}

func main() {
    k := .07
    tempRoom := 20.
    tempObject := 100.
    fcr := newCoolingRateDy(k, tempRoom)
    analytic := newTempFunc(k, tempRoom, tempObject)
    for _, deltaTime := range []float64{2, 5, 10} {
        fmt.Printf("Step size = %.1f\n", deltaTime)
        fmt.Println(" Time Euler's Analytic")
        temp := tempObject
        for time := 0.; time <= 100; time += deltaTime {
            fmt.Printf("%5.1f %7.3f %7.3f\n", time, temp, analytic(time))
            temp = eulerStep(fcr, time, temp, deltaTime)
        }
        fmt.Println()
    }
}


Pn=: +/\ pn=: p: i.1e6 NB. first million primes pn and their running sum Pn
Cn=: +/\(4+i.{:pn)-.pn NB. running sum of composites starting at 4 and excluding those primes
both=: Pn(e.#[)Cn NB. numbers in both sequences

   both,.(Pn i.both),.Cn i.both NB. values, Pn index m, Cn index n
         10      2      1
       1988     32     50
      14697     79    146
      83292    174    360
    1503397    659   1581
   18859052   2142   5698
   93952013   4555  12820
89171409882 118784 403340


def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] +.;

def task($sievesize):
  {compSums:[],
   primeSums:[],
   csum:0,
   psum:0 }
  | reduce range(2; $sievesize) as $i (.;
      if $i|is_prime
      then .psum += $i
      | .primeSums += [.psum]
      else .csum += $i
      | .compSums += [ .csum ]
      end)
  | range(0; .primeSums|length) as $i
  | .primeSums[$i] as $ps
  | (.compSums | index( $ps )) as $ix
  | select($ix >= 0)
  | "\($ps|lpad(21)) - \($i+1|lpad(21)) prime sum, \($ix+1|lpad(12)) composite sum"
;

task(1E5)


using Primes

function getsequencematches(N, masksize = 1_000_000_000)
    pmask = primesmask(masksize)
    found, psum, csum, pindex, cindex, pcount, ccount = 0, 2, 4, 2, 4, 1, 1
    incrementpsum() = (pindex += 1; if pmask[pindex] psum += pindex; pcount += 1 end)
    incrementcsum() = (cindex += 1; if !pmask[cindex] csum += cindex; ccount += 1 end)
    while found < N
        while psum < csum
            pindex >= masksize && return
            incrementpsum()
        end
        if psum == csum
            println("Primes up to $pindex at position $pcount and composites up to $cindex at position $ccount sum to $psum.")
            found += 1
            while psum == csum
                incrementpsum()
                incrementcsum()
            end
        end
        while csum < psum
            incrementcsum()
        end
    end
end

@time getsequencematches(11)


use strict;
use warnings;
use feature <say state>;
use ntheory <is_prime next_prime>;

sub comma  { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }
sub suffix { my($d) = $_[0] =~ /(.)$/; $d == 1 ? 'st' : $d == 2 ? 'nd' : $d == 3 ? 'rd' : 'th' }

sub prime_sum {
    state $s = state $p = 2; state $i = 1;
    if ($i < (my $n = shift) ) { do { $s += $p = next_prime($p) } until ++$i == $n }
    $s
}

sub composite_sum {
    state $s = state $c = 4; state $i = 1;
    if ($i < (my $n = shift) ) { do { 1 until ! is_prime(++$c); $s += $c } until ++$i == $n }
    $s
}

my $ci++;
for my $pi (1 .. 5_012_372) {
    next if prime_sum($pi) < composite_sum($ci);
    printf( "%20s - %11s prime sum, %12s composite sum\n",
        comma(prime_sum $pi), comma($pi).suffix($pi), comma($ci).suffix($ci))
        and next if prime_sum($pi) == composite_sum($ci);
    $ci++;
    redo
}


make "target "|METHINKS IT IS LIKE A WEASEL|

to distance :w
  output reduce "sum (map.se [ifelse equal? ?1 ?2 [0][1]] :w :target)
end

to random.letter
  output pick "| ABCDEFGHIJKLMNOPQRSTUVWXYZ|
end

to mutate :parent :rate
  output map [ifelse random 100 < :rate [random.letter] [?]] :parent
end

make "C 100
make "mutate.rate 10     ; percent

to breed :parent
  make "parent.distance distance :parent
  localmake "best.child :parent
  repeat :C [
    localmake "child mutate :parent :mutate.rate
    localmake "child.distance distance :child
    if greater? :parent.distance :child.distance [
      make "parent.distance :child.distance
      make "best.child :child
    ]
  ]
  output :best.child
end

to progress
  output (sentence :trials :parent "distance: :parent.distance)
end

to evolve
  make "parent cascade count :target [lput random.letter ?] "||
  make "trials 0
  while [not equal? :parent :target] [
    make "parent breed :parent
    print progress
    make "trials :trials + 1
  ]
end


local target = "METHINKS IT IS LIKE A WEASEL"
local alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
local c, p = 100, 0.06

local function fitness(s)
	local score = #target
	for i = 1,#target do
		if s:sub(i,i) == target:sub(i,i) then score = score - 1 end
	end
	return score
end

local function mutate(s, rate)
	local result, idx = ""
	for i = 1,#s do
		if math.random() < rate then
			idx = math.random(#alphabet)
			result = result .. alphabet:sub(idx,idx)
		else
			result = result .. s:sub(i,i)
		end
	end
	return result, fitness(result)
end

local function randomString(len)
	local result, idx = ""
	for i = 1,len do
		idx = math.random(#alphabet)
		result = result .. alphabet:sub(idx,idx)
	end
	return result
end

local function printStep(step, s, fit)
	print(string.format("%04d: ", step) .. s .. " [" .. fit .."]")
end

math.randomseed(os.time())
local parent = randomString(#target)
printStep(0, parent, fitness(parent))

local step = 0
while parent ~= target do
	local bestFitness, bestChild, child, fitness = #target + 1
	for i = 1,c do
		child, fitness = mutate(parent, p)
		if fitness < bestFitness then bestFitness, bestChild = fitness, child end
	end
	parent, step = bestChild, step + 1
	printStep(step, parent, bestFitness)
end


[indent = 4]
/*
   Even or odd, in Genie
   valac even_or_odd.gs
*/

def parity(n:int):bool
    return ((n & 1) == 0)

def show_parity(n:int):void
    print "%d is %s", n, parity(n) ? "even" : "odd"

init
    show_parity(0)
    show_parity(1)
    show_parity(2)
    show_parity(-2)
    show_parity(-1)


package main

import (
    "fmt"
    "math/big"
)

func main() {
    test(-2)
    test(-1)
    test(0)
    test(1)
    test(2)
    testBig("-222222222222222222222222222222222222")
    testBig("-1")
    testBig("0")
    testBig("1")
    testBig("222222222222222222222222222222222222")
}

func test(n int) {
    fmt.Printf("Testing integer %3d:  ", n)
    // & 1 is a good way to test
    if n&1 == 0 {
        fmt.Print("even ")
    } else {
        fmt.Print(" odd ")
    }
    // Careful when using %: negative n % 2 returns -1.  So, the code below
    // works, but can be broken by someone thinking they can reverse the
    // test by testing n % 2 == 1.  The valid reverse test is n % 2 != 0.
    if n%2 == 0 {
        fmt.Println("even")
    } else {
        fmt.Println(" odd")
    }
}

func testBig(s string) {
    b, _ := new(big.Int).SetString(s, 10)
    fmt.Printf("Testing big integer %v:  ", b)
    // the Bit function is the only sensible test for big ints.
    if b.Bit(0) == 0 {
        fmt.Println("even")
    } else {
        fmt.Println("odd")
    }
}


def fib(i: Int): Int = i match {
  case 0 => 0
  case 1 => 1
  case _ => fib(i - 1) + fib(i - 2)
}


global function choose(integer n, k)
    atom res = 1
    for i=1 to k do
        res = (res*(n-i+1))/i
    end for
    return res
end function


<?php
$n=5;
$k=3;
function factorial($val){
    for($f=2;$val-1>1;$f*=$val--);
    return $f;
}
$binomial_coefficient=factorial($n)/(factorial($k)*factorial($n-$k));
echo $binomial_coefficient;
?>


binomial_it(N,K) = Res =>
   if K < 0 ; K > N then
     R = 0
   else
     R = 1,
     foreach(I in 0..K-1)
       R := R * (N-I) // (I+1)
     end
   end,
   Res = R.


      MODULE BRAIN	!It will suffer.
       INTEGER MSG,KBD
       CONTAINS		!A twisted interpreter.
        SUBROUTINE RUN(PROG,STORE)	!Code and data are separate!
         CHARACTER*(*) PROG	!So, this is the code.
         CHARACTER*(1) STORE(:)	!And this a work area.
         CHARACTER*1 C		!The code of the moment.
         INTEGER I,D		!Fingers to an instruction, and to data.
          D = 1		!First element of the store.
          I = 1		!First element of the prog.

          DO WHILE(I.LE.LEN(PROG))	!Off the end yet?
            C = PROG(I:I)			!Load the opcode fingered by I.
            I = I + 1				!Advance one. The classic.
            SELECT CASE(C)			!Now decode the instruction.
             CASE(">"); D = D + 1				!Move the data finger one place right.
             CASE("<"); D = D - 1				!Move the data finger one place left.
             CASE("+"); STORE(D) = CHAR(ICHAR(STORE(D)) + 1)	!Add one to the fingered datum.
             CASE("-"); STORE(D) = CHAR(ICHAR(STORE(D)) - 1)	!Subtract one.
             CASE("."); WRITE (MSG,1) STORE(D)			!Write a character.
             CASE(","); READ (KBD,1) STORE(D)			!Read a character.
             CASE("["); IF (ICHAR(STORE(D)).EQ.0) CALL SEEK(+1)	!Conditionally, surge forward.
             CASE("]"); IF (ICHAR(STORE(D)).NE.0) CALL SEEK(-1)	!Conditionally, retreat.
             CASE DEFAULT				!For all others,
		  						!Do nothing.
            END SELECT				!That was simple.
          END DO			!See what comes next.

    1     FORMAT (A1,$)	!One character, no advance to the next line.
         CONTAINS	!Now for an assistant.
          SUBROUTINE SEEK(WAY)	!Look for the BA that matches the AB.
           INTEGER WAY		!Which direction: ±1.
           CHARACTER*1 AB,BA	!The dancers.
           INTEGER INDEEP	!Nested brackets are allowed.
            INDEEP = 0		!None have been counted.
            I = I - 1		!Back to where C came from PROG.
            AB = PROG(I:I)	!The starter.
            BA = "[ ]"(WAY + 2:WAY + 2)	!The stopper.
    1       IF (I.GT.LEN(PROG)) STOP "Out of code!"	!Perhaps not!
            IF (PROG(I:I).EQ.AB) THEN		!A starter? (Even if backwards)
              INDEEP = INDEEP + 1			!Yep.
            ELSE IF (PROG(I:I).EQ.BA) THEN	!A stopper?
              INDEEP = INDEEP - 1			!Yep.
            END IF				!A case statement requires constants.
            IF (INDEEP.GT.0) THEN	!Are we out of it yet?
              I = I + WAY			!No. Move.
              IF (I.GT.0) GO TO 1		!And try again.
              STOP "Back to 0!"			!Perhaps not.
            END IF			!But if we are out of the nest,
            I = I + 1			!Advance to the following instruction, either WAY.
          END SUBROUTINE SEEK	!Seek, and one shall surely find.
        END SUBROUTINE RUN	!So much for that.
      END MODULE BRAIN	!Simple in itself.

      PROGRAM POKE	!A tester.
      USE BRAIN		!In a rather bad way.
      CHARACTER*1 STORE(30000)	!Probably rather more than is needed.
      CHARACTER*(*) HELLOWORLD	!Believe it or not...
      PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]"
     1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------"
     2 //".--------.>>+.>++.")
      KBD = 5		!Standard input.
      MSG = 6		!Standard output.
      STORE = CHAR(0)	!Scrub.

      CALL RUN(HELLOWORLD,STORE)	!Have a go.

      END	!Enough.


sub factorial
{
  my $n = shift;
  my $result = 1;
  for (my $i = 1; $i <= $n; ++$i)
  {
    $result *= $i;
  };
  $result;
}

# using a .. range
sub factorial {
    my $r = 1;
    $r *= $_ for 1..shift;
    $r;
}


def eulerStep = { xn, yn, h, dydx ->
    (yn + h * dydx(xn, yn)) as BigDecimal
}

Map eulerMapping = { x0, y0, h, dydx, stopCond = { xx, yy, hh, xx0 -> abs(xx - xx0) > (hh * 100)  }.rcurry(h, x0) ->
    Map yMap = [:]
    yMap[x0] = y0 as BigDecimal
    def x = x0
    while (!stopCond(x, yMap[x])) {
        yMap[x + h] = eulerStep(x, yMap[x], h, dydx)
        x += h
    }
    yMap
}
assert eulerMapping.maximumNumberOfParameters == 5


-- the solver
dsolveBy _ _ [] _ = error "empty solution interval"
dsolveBy method f mesh x0 = zip mesh results
  where results = scanl (method f) x0 intervals
        intervals = zip mesh (tail mesh)


with javascript_semantics
atom t0 = time()
atom ps = 2,  -- current prime sum
     cs = 4   -- current composite sum
integer psn = 1, npi = 1,  -- (see below)
        csn = 1, nci = 3, nc = 4, ncp = 5,
        found = 0
constant limit = iff(platform()=JS?10:11)
while found<limit do
    integer c = compare(ps,cs) -- {-1,0,+1}
    if c=0 then
        printf(1,"%,21d - %,10d%s prime sum, %,10d%s composite sum   (%s)\n",
                 {ps, psn, ord(psn), csn, ord(csn), elapsed(time()-t0)})
        found += 1
    end if
    if c<=0 then
        psn += 1    -- prime sum number
        npi += 1    -- next prime index
        ps += get_prime(npi)
    end if
    if c>=0 then
        csn += 1    -- composite sum number
        nc += 1     -- next composite?
        if nc=ncp then  -- "", erm no
            nci += 1    -- next prime index
            ncp = get_prime(nci)
            nc += 1 -- next composite (even!)
        end if
        cs += nc
    end if
end while


use Lingua::EN::Numbers:ver<2.8.2+>;

my $prime-sum =     [\+] (2..*).grep:  *.is-prime;
my $composite-sum = [\+] (2..*).grep: !*.is-prime;

my $c-index = 0;

for ^∞ -> $p-index {
    next if $prime-sum[$p-index] < $composite-sum[$c-index];
    printf( "%20s - %11s prime sum, %12s composite sum   %5.2f seconds\n",
      $prime-sum[$p-index].&comma, ordinal-digit($p-index + 1, :u, :c),
      ordinal-digit($c-index + 1, :u, :c), now - INIT now )
      and next if $prime-sum[$p-index] == $composite-sum[$c-index];
    ++$c-index;
    redo;
};


Module WeaselAlgorithm {
      Print "Evolutionary Algorithm"
      \\ Weasel Algorithm
      \\ Using dynamic array, which expand if no fitness change,
      \\ and reduce to minimum when fitness changed
      \\ Abandon strings when fitness change
      \\ Also lambda function Mutate$ change when topscore=10, to change only one character
      l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
      randomstring$=lambda$ l$ ->{
            res$=""
            For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
            =res$
      }
      m$="METHINKS IT IS LIKE A WEASEL"
      lm=len(m$)
      fitness=lambda m$, lm  (this$)-> {
            score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
      }
      Mutate$=lambda$ l$ (w$)-> {
            a=random(1,28) : insert a, 1 w$=mid$(l$, random(1,27),1)
            If random(3)=1 Then b=a:while b=a {b=random(1,28)} : insert b, 1 w$=mid$(l$, random(1,27),1)
            =w$
      }
      Mutate1$=lambda$ l$ (w$)-> {
            insert random(1,28), 1 w$=mid$(l$, random(1,27),1) : =w$
      }
      f$=randomstring$()
      topscore=0
      last=0
      Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
      Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
      count=0
      gen=30
      mut=0
      {
            last=0
            Dim a$(1 to gen)<<mutate$(f$)
            mut+=gen
            oldscore=topscore
            For i=1 to gen {
                  topscore=max.data(topscore, fitness(a$(i)))
                  If oldscore<topscore Then last=i:Exit
            }
            If last>0 Then {
                  f$=a$(last) : gen=30 : If topscore=10 Then mutate$=mutate1$
            } Else gen+=50
            Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
            count+=min(gen,i)
            If topscore<28 Then loop
      }
      Print
      Print "Results"
      Print "I found this:"; a$(i)
      Print "Total strings which evalute fitness:"; count
      Print "Done"
}
WeaselAlgorithm


divert(-1)

# Get a random number from 0 to one less than $1.
# (Note that this is not a very good RNG. Also it writes a file.)
#
# Usage: randnum(N)   (Produces a random integer in 0..N-1)
#
define(`randnum',
  `syscmd(`echo $RANDOM > __random_number__')eval(include(__random_number__) % ( $1 ))')

# The *target* specified in the Rosetta Code task.
define(`target',`METHINKS IT IS LIKE A WEASEL')

define(`alphabet',`ABCDEFGHIJKLMNOPQRSTUVWXYZ ')
define(`random_letter',`substr(alphabet,randnum(len(alphabet)),1)')

define(`create_primogenitor',`_$0(`')')
define(`_create_primogenitor',`ifelse(len(`$1'),len(target),`$1',
                                      `$0(`$1'random_letter)')')

# The *parent* specified in the Rosetta Code task.
define(`parent',`'create_primogenitor)

#
# Usage: mutate_letter(STRING,INDEX)
#
define(`mutate_letter',
  `substr(`$1',0,`$2')`'random_letter`'substr(`$1',incr(`$2'))')

#
# Usage: mutate_letter_at_rate(STRING,INDEX,MUTATION_RATE)
#
define(`mutate_letter_at_rate',
  `ifelse(eval(randnum(100) < ($3)),1,`mutate_letter(`$1',`$2')',`$1')')

# The *mutate* procedure specified in the Rosetta Code task. The
# mutation rate is given in percents.
#
# Usage: mutate(STRING,MUTATION_RATE)
#
define(`mutate',`_$0(`$1',`$2',len(`$1'))')
define(`_mutate',
  `ifelse($3,0,`$1',
          `$0(mutate_letter_at_rate(`$1',decr($3),`$2'),`$2',decr($3))')')

# The *fitness* procedure specified in the Rosetta Code
# task. "Fitness" here is simply how many letters match.
#
# Usage: fitness(STRING)
#
define(`fitness',`_$0(`$1',target,0)')
define(`_fitness',
  `ifelse(`$1',`',$3,
      `ifelse(`'substr(`$1',0,1),`'substr(`$2',0,1),
                  `$0(`'substr(`$1',1),`'substr(`$2',1),incr($3))',
                  `$0(`'substr(`$1',1),`'substr(`$2',1),$3)')')')

#
# Usage: have_child(PARENT,MUTATION_RATE)
#
# The result is either the parent or the child: whichever has the
# greater fitness. If they are equally fit, one is chosen arbitrarily.
# (Note that, in the current implementation, fitnesses are not
# memoized.)
#
define(`have_child',
`pushdef(`_child_',mutate(`$1',`$2'))`'dnl
ifelse(eval(fitness(`'_child_) < fitness(`$1')),1,`$1',`_child_')`'dnl
popdef(`_child_')')

#
# Usage: next_parent(PARENT,NUM_CHILDREN,MUTATION_RATE)
#
# Note that a string is discarded as soon as it is known it will not
# be in the next generation. If some strings have the same highest
# fitness, one of them is chosen arbitrarily.
#
define(`next_parent',`_$0(`$1',`$2',`$3',`$1')')
define(`_next_parent',
  `ifelse(`$2',0,`$1',
          `$0(`'have_child(`$4',`$3'),decr(`$2'),`$3',`$4')')')

define(`repeat_until_equal',
  `ifelse(`$1',`'target,`[$1]',
`pushdef(`_the_horta_',`'next_parent(`$1',`$2',`$3'))`'dnl
[_the_horta_]
$0(`'_the_horta_,`$2',`$3')`'dnl
popdef(`_the_horta_')')')

divert`'dnl
[parent]
repeat_until_equal(parent,10,10)


def isOdd = { int i -> (i & 1) as boolean }
def isEven = {int i -> ! isOdd(i) }


Prelude> even 5
False
Prelude> even 42
True
Prelude> odd 5
True
Prelude> odd 42
False


(define (fib-iter n)
  (do ((num 2 (+ num 1))
       (fib-prev 1 fib)
       (fib 1 (+ fib fib-prev)))
      ((>= num n) fib)))


binomial_coefficients:
   procedure options (main);
      declare (n, k) fixed;

   get (n, k);
   put (coefficient(n, k));

coefficient: procedure (n, k) returns (fixed decimal (15));
   declare (n, k) fixed;
   return (fact(n)/ (fact(n-k) * fact(k)) );
end coefficient;

fact: procedure (n) returns (fixed decimal (15));
   declare n fixed;
   declare i fixed, f fixed decimal (15);
   f = 1;
   do i = 1 to n;
      f = f * i;
   end;
   return (f);
end fact;
end binomial_coefficients;


function choose($n,$k) {
    if($k -le $n -and 0 -le $k) {
        $numerator = $denominator = 1
        0..($k-1) | foreach{
            $numerator *= ($n-$_)
            $denominator *= ($_ + 1)
        }
        $numerator/$denominator
    } else {
        "$k is greater than $n or lower than 0"
    }
}
choose 5 3
choose 2 1
choose 10 10
choose 10 2
choose 10 8


Procedure Factor(n)
  Protected Result=1
  While n>0
    Result*n
    n-1
  Wend
  ProcedureReturn Result
EndProcedure

Macro C(n,k)
  (Factor(n)/(Factor(k)*factor(n-k)))
EndMacro

If OpenConsole()
  Print("Enter value n: "): n=Val(Input())
  Print("Enter value k: "): k=Val(Input())
  PrintN("C(n,k)= "+str(C(n,k)))

  Print("Press ENTER to quit"): Input()
  CloseConsole()
EndIf


-- calculate factorial

chiz a = 5;
chiz n = 1;

ta a >= 2
{
    n *= a;
    a -= 1;
}

chaap n;


global function factorial(integer n)
atom res = 1
    while n>1 do
        res *= n
        n -= 1
    end while
    return res
end function


invocable "newton_cooling" # needed to use the 'proc' procedure

procedure euler (f, y0, a, b, h)
  t := a
  y := y0
  until (t >= b) do {
    write (right(t, 4) || " " || left(y, 7))
    t +:= h
    y +:= h * (proc(f) (t, y)) # 'proc' applies procedure named in f to (t, y)
  }
  write ("DONE")
end

procedure newton_cooling (time, T)
  return -0.07 * (T - 20)
end

procedure main ()
  # generate data for all three step sizes [2, 5, 10]
  every (step_size := ![2,5,10]) do
    euler ("newton_cooling", 100, 0, 100,  step_size)
end


NB.*euler a Approximates Y(t) in Y'(t)=f(t,Y) with Y(a)=Y0 and t=a..b and step size h.
euler=: adverb define
 'Y0 a b h'=. 4{. y
 t=. [email protected]>:&.(%&h) b - a
 Y=. (+ h * u)^:(<#t) Y0
 t,.Y
)

ncl=: _0.07 * -&20  NB. Newton's Cooling Law


func f(n) {

    var (
        p = 2, sp = p,
        c = 4, sc = c,
    )

    var res = []

    while (res.len < n) {
        if (sc == sp) {
            res << [sp, c.composite_count, p.prime_count]
            sc += c.next_composite!
        }
        while (sp < sc) {
            sp += p.next_prime!
        }
        while (sc < sp) {
            sc += c.next_composite!
        }
    }

    return res
}

f(8).each_2d {|n, ci, pi|
    printf("%12s = %-9s = %s\n", n, "P(#{pi})", "C(#{ci})")
}


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

var limit = 4 * 1e8
var c = Int.primeSieve(limit - 1, false)
var compSums = []
var primeSums = []
var csum = 0
var psum = 0
for (i in 2...limit) {
    if (c[i]) {
        csum = csum + i
        compSums.add(csum)
    } else {
        psum = psum + i
        primeSums.add(psum)
    }
}

for (i in 0...primeSums.count) {
    var ix
    if ((ix = Find.first(compSums, primeSums[i])) >= 0) {
        Fmt.print("$,21d - $,12r prime sum, $,12r composite sum", primeSums[i], i+1, ix+1)
    }
}


func IsPrime(N);        \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

int Cnt, N, M, SumP, SumC, NumP, NumC;
[Cnt:= 0;
N:= 1;  M:= 1;
NumP:= 2;  NumC:= 4;
SumP:= 2;  SumC:= 4;
Format(8, 0);
Text(0, "     sum     prime  composit
");
loop    [if SumC > SumP then
            [repeat NumP:= NumP+1 until IsPrime(NumP);
            SumP:= SumP + NumP;
            N:= N+1;
            ];
        if SumP > SumC then
            [repeat NumC:= NumC+1 until not IsPrime(NumC);
            SumC:= SumC + NumC;
            M:= M+1;
            ];
        if SumP = SumC then
            [RlOut(0, float(SumP));
            RlOut(0, float(N));
            RlOut(0, float(M));  CrLf(0);
            Cnt:= Cnt+1;
            if Cnt >= 6 then quit;
            repeat NumC:= NumC+1 until not IsPrime(NumC);
            SumC:= SumC + NumC;
            M:= M+1;
            ];
        ];
]


target = "METHINKS IT IS LIKE A WEASEL";
alphabet = Append[CharacterRange["A", "Z"], " "];
fitness = HammingDistance[target, #] &;
mutate[str_String, rate_ : 0.01] := StringReplace[
  str,
  _ /; RandomReal[] < rate :> RandomChoice[alphabet]
]

mutationRate = 0.02; c = 100;
NestWhileList[
   [email protected][
      Thread[mutate[ConstantArray[#, c], mutationRate]],
      fitness
   ] &,
   mutate[target, 1],
   [email protected]# > 0 &
] // ListAnimate


%This class impliments a string that mutates to a target
classdef EvolutionaryAlgorithm

    properties

        target;
        parent;
        children = {};
        validAlphabet;

        %Constants
        numChildrenPerIteration;
        maxIterations;
        mutationRate;

    end

    methods

        %Class constructor
        function family = EvolutionaryAlgorithm(target,mutationRate,numChildren,maxIterations)

            family.validAlphabet = char([32 (65:90)]); %Space char and A-Z
            family.target = target;
            family.children = cell(numChildren,1);
            family.numChildrenPerIteration = numChildren;
            family.maxIterations = maxIterations;
            family.mutationRate = mutationRate;
            initialize(family);

        end %class constructor

        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
        %Helper functions and class get/set functions
        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

        %setAlphabet() - sets the valid alphabet for the current instance
        %of the EvolutionaryAlgorithm class.
        function setAlphabet(family,alphabet)

            if(ischar(alphabet))
                family.validAlphabet = alphabet;

                %Makes change permanent
                assignin('caller',inputname(1),family);
            else
                error 'New alphabet must be a string or character array';
            end

        end

        %setTarget() - sets the target for the current instance
        %of the EvolutionaryAlgorithm class.
        function setTarget(family,target)

            if(ischar(target))
                family.target = target;

                %Makes change permanent
                assignin('caller',inputname(1),family);
            else
                error 'New target must be a string or character array';
            end

        end

        %setMutationRate() - sets the mutation rate for the current instance
        %of the EvolutionaryAlgorithm class.
        function setMutationRate(family,mutationRate)

            if(isnumeric(mutationRate))
                family.mutationRate = mutationRate;

                %Makes change permanent
                assignin('caller',inputname(1),family);
            else
                error 'New mutation rate must be a double precision number';
            end

        end

        %setMaxIterations() - sets the maximum number of iterations during
        %evolution for the current instance of the EvolutionaryAlgorithm class.
        function setMaxIterations(family,maxIterations)

            if(isnumeric(maxIterations))
                family.maxIterations = maxIterations;

                %Makes change permanent
                assignin('caller',inputname(1),family);
            else
                error 'New maximum amount of iterations must be a double precision number';
            end

        end

        %display() - overrides the built-in MATLAB display() function, to
        %display the important class variables
        function display(family)
            disp([sprintf('Target: %s\n',family.target)...
                  sprintf('Parent: %s\n',family.parent)...
                  sprintf('Valid Alphabet: %s\n',family.validAlphabet)...
                  sprintf('Number of Children: %d\n',family.numChildrenPerIteration)...
                  sprintf('Mutation Rate [0,1]: %d\n',family.mutationRate)...
                  sprintf('Maximum Iterations: %d\n',family.maxIterations)]);
        end

        %disp() - overrides the built-in MATLAB disp() function, to
        %display the important class variables
        function disp(family)
            display(family);
        end

        %randAlphabetElement() - Generates a random character from the
        %valid alphabet for the current instance of the class.
        function elements = randAlphabetElements(family,numChars)

            %Sample the valid alphabet randomly from the uniform
            %distribution
            N = length(family.validAlphabet);
            choices = ceil(N*rand(1,numChars));

            elements = family.validAlphabet(choices);

        end

        %initialize() - Sets the parent to a random string of length equal
        %to the length of the target
        function parent = initialize(family)

            family.parent = randAlphabetElements(family,length(family.target));
            parent = family.parent;

            %Makes changes to the instance of EvolutionaryAlgorithm permanent
            assignin('caller',inputname(1),family);

        end %initialize

        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
        %Functions required by task specification
        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

        %mutate() - generates children from the parent and mutates them
        function mutate(family)

            sizeParent = length(family.parent);

            %Generate mutatant children sequentially
            for child = (1:family.numChildrenPerIteration)

                parentCopy = family.parent;

                for charIndex = (1:sizeParent)
                    if (rand(1) < family.mutationRate)
                        parentCopy(charIndex) = randAlphabetElements(family,1);
                    end
                end

                family.children{child} = parentCopy;

            end

            %Makes changes to the instance of EvolutionaryAlgorithm permanent
            assignin('caller',inputname(1),family);

        end %mutate

        %fitness() - Computes the Hamming distance between the target
        %string and the string input as the familyMember argument
        function theFitness = fitness(family,familyMember)

            if not(ischar(familyMember))
                error 'The second argument must be a string';
            end

            theFitness = sum(family.target == familyMember);
        end

        %evolve() - evolves the family until the target is reached or it
        %exceeds the maximum amount of iterations
        function [iteration,mostFitFitness] = evolve(family)

            iteration = 0;
            mostFitFitness = 0;
            targetFitness = fitness(family,family.target);

            disp(['Target fitness is ' num2str(targetFitness)]);

            while (mostFitFitness < targetFitness) && (iteration < family.maxIterations)

                iteration = iteration + 1;

                mutate(family);

                parentFitness = fitness(family,family.parent);
                mostFit = family.parent;
                mostFitFitness = parentFitness;

                for child = (1:family.numChildrenPerIteration)

                    childFitness = fitness(family,family.children{child});
                    if childFitness > mostFitFitness
                        mostFit = family.children{child};
                        mostFitFitness = childFitness;
                    end

                end

                family.parent = mostFit;
                disp([num2str(iteration) ': ' mostFit ' - Fitness: ' num2str(mostFitFitness)]);

            end

            %Makes changes to the instance of EvolutionaryAlgorithm permanent
            assignin('caller',inputname(1),family);

        end %evolve

    end %methods
end %classdef


|=  [email protected]
?:  =((mod n 2) 0)
  "even"
"odd"


procedure isEven(n)
    return n%2 = 0
end


    clear
    n=46
    f1=0; f2=1
    printf("fibo(%d)=%d\n",0,f1)
    printf("fibo(%d)=%d\n",1,f2)
    for i=2:n
        f3=f1+f2
        printf("fibo(%d)=%d\n",i,f3)
        f1=f2
        f2=f3
    end


def binomialCoeff(n, k):
    result = 1
    for i in range(1, k+1):
        result = result * (n-i+1) / i
    return result

if __name__ == "__main__":
    print(binomialCoeff(5, 3))


  [ tuck - over
   1 swap times
     [ over i + 1+ * ]
   nip swap times
      [ i 1+ / ] ]     is binomial ( n n --> )

  5 3 binomial echo


#lang racket
(require math)
(binomial 10 5)


' Intérprete de brainfuck
' FB 1.05.0 Win64
'

Const BF_error_memoria_saturada As Integer = 2
Const BF_error_memoria_insuficiente As Integer = 4
Const BF_error_codigo_saturado As Integer = 8
Const BF_error_desbordamiento_codigo As Integer = 16

Dim BFcodigo As String = ">++++++++++[>+++>+++++++>++++++++++>+++++++++++>++++++++++++>++++++++++++++++[<]>-]>>>>>>+.<<<<++.>>+.---.<---.<<++.>>>+.>---.<+.<+++.>+.<<<+."
Dim codigo_error As Integer

Function EjecutarBF (BFcodigo As String, tammem As Uinteger) As Integer
    Dim As String memoria = String(tammem, 0)
    Dim As Uinteger puntero_instrucciones, puntero_datos
    Dim As Integer nivel_de_alcance

    For puntero_instrucciones = 0 To Len(BFcodigo)
        Select Case Chr(BFcodigo[puntero_instrucciones])
        Case ">"
            puntero_datos += 1
            If (puntero_datos > tammem - 1) Then Return BF_error_memoria_saturada
        Case "<"
            puntero_datos -= 1
            If (puntero_datos > tammem - 1) Then Return BF_error_memoria_insuficiente
        Case "+"
            memoria[puntero_datos] += 1
        Case "-"
            memoria[puntero_datos] -= 1
        Case "."
            Print Chr(memoria[puntero_datos]);
        Case ","
            memoria[puntero_datos] = Asc(Input(1))
        Case "["
            If (memoria[puntero_datos] = 0) Then
                Dim nivel_antiguo As Uinteger = nivel_de_alcance
                nivel_de_alcance += 1
                Do Until (nivel_de_alcance = nivel_antiguo)
                    puntero_instrucciones += 1
                    If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_codigo_saturado
                    Select Case Chr(BFcodigo[puntero_instrucciones])
                    Case "["
                        nivel_de_alcance += 1
                    Case "]"
                        nivel_de_alcance -= 1
                    End Select
                Loop
            Else
                nivel_de_alcance += 1
            End If
            Continue For
        Case "]"
            If (memoria[puntero_datos] = 0) Then
                nivel_de_alcance -= 1
                Continue For
            Else
                Dim nivel_antiguo As Integer = nivel_de_alcance
                nivel_de_alcance -= 1
                Do Until (nivel_de_alcance = nivel_antiguo)
                    puntero_instrucciones -= 1
                    If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_desbordamiento_codigo
                    Select Case Chr(BFcodigo[puntero_instrucciones])
                    Case "["
                        nivel_de_alcance += 1
                    Case "]"
                        nivel_de_alcance -= 1
                    End Select
                Loop
            End If
            Continue For
        Case Else
            Continue For
        End Select
    Next puntero_instrucciones
    Return -1
End Function

Cls
codigo_error = EjecutarBF(BFcodigo, 1024)
If codigo_error Then
    Sleep
Else
    Print "codigo de error: " & codigo_error
End If
End


/# recursive #/
def factorial
    dup 1 > if
        dup 1 - factorial *
    else
        drop 1
    endif
enddef

/# iterative #/
def factorial2
    1 swap for * endfor
enddef

0 22 2 tolist for
    "Factorial(" print dup print ") = " print factorial2 print nl
endfor


<?php
function factorial($n) {
  if ($n < 0) {
    return 0;
  }

  $factorial = 1;
  for ($i = $n; $i >= 1; $i--) {
    $factorial = $factorial * $i;
  }

  return $factorial;
}
?>


public class Euler {
  private static void euler (Callable f, double y0, int a, int b, int h) {
    int t = a;
    double y = y0;
    while (t < b) {
      System.out.println ("" + t + " " + y);
      t += h;
      y += h * f.compute (t, y);
    }
    System.out.println ("DONE");
  }

  public static void main (String[] args) {
    Callable cooling = new Cooling ();
    int[] steps = {2, 5, 10};
    for (int stepSize : steps) {
      System.out.println ("Step size: " + stepSize);
      euler (cooling, 100.0, 0, 100, stepSize);
    }
  }
}

// interface used so we can plug in alternative functions to Euler
interface Callable {
  public double compute (int time, double t);
}

// class to implement the newton cooling equation
class Cooling implements Callable {
  public double compute (int time, double t) {
    return -0.07 * (t - 20);
  }
}


// Function that takes differential-equation, initial condition,
// ending x, and step size as parameters
function eulersMethod(f, x1, y1, x2, h) {
	// Header
	console.log("\tX\t|\tY\t");
	console.log("------------------------------------");

	// Initial Variables
	var x=x1, y=y1;

	// While we're not done yet
	// Both sides of the OR let you do Euler's Method backwards
	while ((x<x2 && x1<x2) || (x>x2 && x1>x2)) {
		// Print what we have
		console.log("\t" + x + "\t|\t" + y);

		// Calculate the next values
		y += h*f(x, y)
		x += h;
	}

	return y;
}

function cooling(x, y) {
	return -0.07 * (y-20);
}

eulersMethod(cooling, 0, 100, 100, 10);


import Nanoquery.Util

target = "METHINKS IT IS LIKE A WEASEL"
tbl    = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
copies = 30
chance = 0.09
rand   = new(Random)

// returns a random string of the specified length
def rand_string(length)
	global tbl
	global rand

	ret = ""

	for i in range(1, length)
		ret += tbl[rand.getInt(len(tbl))]
	end

	return ret
end

// gets the fitness of a given string
def fitness(string)
	global target
	fit = 0

	for i in range(0, len(string) - 1)
		if string[i] != target[i]
			fit -= 1
		end
	end

	return fit
end

// mutates the specified string with a chance of 0.09 by default
def mutate(string)
	global chance
	global rand
	global tbl
	mutated = string

	for i in range(0, len(mutated) - 1)
		if rand.getFloat() <= chance
			mutated[i] = tbl[rand.getInt(len(tbl))]
		end
	end

	return mutated
end

// a function to find the index of the string with the best fitness
def most_fit(strlist)
	global target

	best_score = -(len(target) + 1)
	best_index = 0

	for j in range(0, len(strlist) - 1)
		fit = fitness(strlist[j])
		if fit > best_score
			best_index = j
			best_score = fit
		end
	end

	return {best_index, best_score}
end

parent = rand_string(len(target)); iter = 1
while parent != target
	children = {}

	for i in range(1, 30)
		children.append(mutate(parent))
	end

	fit = most_fit(children)
	parent = children[fit[0]]
	print format("iter %d, score %d: %s\n", iter, fit[1], parent)

	iter += 1
end


import random

const
  Target = "METHINKS IT IS LIKE A WEASEL"
  Alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ"
  P = 0.05
  C = 100

proc negFitness(trial: string): int =
  for i in 0 .. trial.high:
    if Target[i] != trial[i]:
      inc result

proc mutate(parent: string): string =
  for c in parent:
    result.add (if rand(1.0) < P: sample(Alphabet) else: c)

randomize()

var parent = ""
for _ in 1..Target.len:
  parent.add sample(Alphabet)

var i = 0
while parent != Target:
  var copies = newSeq[string](C)
  for i in 0 .. copies.high:
    copies[i] = parent.mutate()

  var best = copies[0]
  for i in 1 .. copies.high:
    if negFitness(copies[i]) < negFitness(best):
      best = copies[i]
  parent = best

  echo i, " ", parent
  inc i


public static boolean isEven(int i){
    return (i & 1) == 0;
}


#!/bin/sed -f

# First we need to convert each number into the right number of ticks
# Start by marking digits
s/[0-9]/<&/g

# We have to do the digits manually.
s/0//g; s/1/|/g; s/2/||/g; s/3/|||/g; s/4/||||/g; s/5/|||||/g
s/6/||||||/g; s/7/|||||||/g; s/8/||||||||/g; s/9/|||||||||/g

# Multiply by ten for each digit from the front.
:tens
s/|</<||||||||||/g
t tens

# Done with digit markers
s/<//g

# Now the actual work.
:split
# Convert each stretch of n >= 2 ticks into two of n-1, with a mark between
s/|\(|\+\)/\1-\1/g
# Convert the previous mark and the first tick after it to a different mark
# giving us n-1+n-2 marks.
s/-|/+/g
# Jump back unless we're done.
t split
# Get rid of the pluses, we're done with them.
s/+//g

# Convert back to digits
:back
s/||||||||||/</g
s/<\([0-9]*\)$/<0\1/g
s/|||||||||/9/g;
s/|||||||||/9/g; s/||||||||/8/g; s/|||||||/7/g; s/||||||/6/g;
s/|||||/5/g; s/||||/4/g; s/|||/3/g; s/||/2/g; s/|/1/g;
s/</|/g
t back
s/^$/0/


/*REXX program calculates   binomial coefficients  (also known as  combinations).       */
numeric digits 100000                            /*be able to handle gihugeic numbers.  */
parse arg n k .                                  /*obtain  N  and  K   from the C.L.    */
say 'combinations('n","k')='  comb(n,k)          /*display the number of combinations.  */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
comb: procedure;  parse arg x,y;         return !(x) % (!(x-y) * !(y))
!:    procedure;  !=1;           do j=2  to arg(1);  !=!*j;  end  /*j*/;          return !


numer = 0
binomial(5,3)
see "(5,3) binomial = " + numer + nl

func binomial n, k
     if k > n return nil ok
     if k > n/2 k = n - k ok
     numer = 1
     for i = 1 to k
         numer = numer * ( n - i + 1 ) / i
     next
     return numer


class Integer
  # binomial coefficient: n C k
  def choose(k)
    # n!/(n-k)!
    pTop = (self-k+1 .. self).inject(1, &:*)
    # k!
    pBottom = (2 .. k).inject(1, &:*)
    pTop / pBottom
  end
end

p 5.choose(3)
p 60.choose(30)


print "binomial (5,1) = "; binomial(5, 1)
print "binomial (5,2) = "; binomial(5, 2)
print "binomial (5,3) = "; binomial(5, 3)
print "binomial (5,4) = "; binomial(5,4)
print "binomial (5,5) = "; binomial(5,5)
end

function binomial(n,k)
 coeff = 1
 for i = n - k + 1 to n
   coeff = coeff * i
 next i
 for i = 1 to k
   coeff = coeff / i
 next i
binomial = coeff
end function


argc 3 < { ."Usage: furor brainfuck.upu brainfuckpgmfile\n" }{
2 argv getfile // dup #s print free
sto bfpgm
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
tick sto startingtick
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem free // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g @bfpgm~ !{ rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero p zero m // Indexregiszterek lenullázása (inicializálás)
((( @p @bfpgm~ < )
§jumpingtable "+-<>[].,"
@[]bfpgm @p // Az épp aktuális brainfuck utasítás kódja
switch // Ugrás a megfelelő brainfuck funkció rutinjára
____: inc p (<) // default action
_3c_: @m !{ rts } dec m goto §____ // <
_3e_: @m @bfmem~ >= { rts } inc m goto §____ // >
_2b_: #c @[++]bfmem @m #g    goto §____ // +
_2d_: #c @[--]bfmem @m #g    goto §____ // -
_2c_: @bfmem @m getchar [^]  goto §____
_2e_: @[]bfmem @m printchar  goto §____
_5b_: @[]bfmem @m then §____
          zero d @p ++ @bfpgm~ {||
          {} []@bfpgm '[ == { inc d {<} }
          {} []@bfpgm '] == { @d !{ {+} sto p {>} } dec d }
|} (<)
_5d_: zero d 1 @p {|| {-} []@bfpgm '] == { inc d {<} }
      {-} []@bfpgm '[ == { @d !{ {} !sum p {>} } dec d }
|} (<)
)) rts
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „p” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „m” /* index a brainfuck memóriaterületre */ }
{ „d” /* munkaváltozó */ }
// ========================================
jumpingtable:
// +    -     <     >     [     ]     .     ,
§_2b_ §_2d_ §_3c_ §_3e_ §_5b_ §_5d_ §_2e_ §_2c_


# Here . and , print and read an integer, not a character
Brainfuck := function(prog)
  local pointer, stack, leftcells, rightcells, instr, stackptr, len,
    output, input, jump, i, j, set, get;
  input := InputTextUser();
  output := OutputTextUser();
  instr := 1;
  pointer := 0;
  leftcells := [ ];
  rightcells := [ ];
  stack := [ ];
  stackptr := 0;
  len := Length(prog);
  jump := [ ];

  get := function()
    local p;
    if pointer >= 0 then
      p := pointer + 1;
      if IsBound(rightcells[p]) then
        return rightcells[p];
      else
        return 0;
      fi;
    else
      p := -pointer;
      if IsBound(leftcells[p]) then
        return leftcells[p];
      else
        return 0;
      fi;
    fi;
  end;

  set := function(value)
    local p;
    if pointer >= 0 then
      p := pointer + 1;
      if value = 0 then
        Unbind(rightcells[p]);
      else
        rightcells[p] := value;
      fi;
    else
      p := -pointer;
      if value = 0 then
        Unbind(leftcells[p]);
      else
        leftcells[p] := value;
      fi;
    fi;
  end;

  # find jumps for faster execution
  for i in [1 .. len] do
    if prog[i] = '[' then
      stackptr := stackptr + 1;
      stack[stackptr] := i;
    elif prog[i] = ']' then
      j := stack[stackptr];
      stackptr := stackptr - 1;
      jump[i] := j;
      jump[j] := i;
    fi;
  od;

  while instr <= len do
    c := prog[instr];
    if c = '<' then
      pointer := pointer - 1;
    elif c = '>' then
      pointer := pointer + 1;
    elif c = '+' then
      set(get() + 1);
    elif c = '-' then
      set(get() - 1);
    elif c = '.' then
      WriteLine(output, String(get()));
    elif c = ',' then
      set(Int(Chomp(ReadLine(input))));
    elif c = '[' then
      if get() = 0 then
        instr := jump[instr];
      fi;
    elif c = ']' then
      if get() <> 0 then
        instr := jump[instr];
      fi;
    fi;
    instr := instr + 1;
  od;
  CloseStream(input);
  CloseStream(output);
  # for debugging purposes, return last state
  return [leftcells, rightcells, pointer];
end;

# An addition
Brainfuck("+++.<+++++.[->+<]>.");
# 3
# 5
# 8


(de fact (N)
   (if (=0 N)
      1
      (* N (fact (dec N))) ) )


# euler_method takes a filter (df), initial condition
# (x1,y1), ending x (x2), and step size as parameters;
# it emits the y values at each iteration.
# df must take [x,y] as its input.
def euler_method(df; x1; y1; x2; h):
  h as $h
  | [x1, y1]
  | recurse( if ((.[0] < x2 and x1 < x2) or
                 (.[0] > x2 and x1 > x2)) then
  		[ (.[0] + $h), (.[1] + $h*df) ]
             else empty
             end )
  | .[1] ;

# We could now solve the task by writing for each step-size, $h
# euler_method(-0.07 * (.[1]-20); 0; 100; 100; $h)
# but for clarity, we shall define a function named "cooling":

# [x,y] is input
def cooling: -0.07 * (.[1]-20);

# The following solves the task:
# (2,5,10) | [., [ euler_method(cooling; 0; 100; 100; .) ] ]


euler(f::Function, T::Number, t0::Int, t1::Int, h::Int) = collect(begin T += h * f(T); T end for t in t0:h:t1)

# Prints a series of arbitrary values in a tabular form, left aligned in cells with a given width
tabular(width, cells...) = println(join(map(s -> rpad(s, width), cells)))

# prints the table according to the task description for h=5 and 10 sec
for h in (5, 10)
    print("Step $h:\n\n")
    tabular(15, "Time", "Euler", "Analytic")
    t = 0
    for T in euler(y -> -0.07 * (y - 20.0), 100.0, 0, 100, h)
        tabular(15, t, round(T,digits=6), round(20.0 + 80.0 * exp(-0.07t), digits=6))
        t += h
    end
    println()
end


// version 1.1.2

typealias Deriv = (Double) -> Double  // only one parameter needed here

const val FMT = " %7.3f"

fun euler(f: Deriv, y: Double, step: Int, end: Int) {
    var yy = y
    print(" Step %2d: ".format(step))
    for (t in 0..end step step) {
        if (t % 10 == 0) print(FMT.format(yy))
        yy += step * f(yy)
    }
    println()
}

fun analytic() {
    print("    Time: ")
    for (t in 0..100 step 10) print(" %7d".format(t))
    print("\nAnalytic: ")
    for (t in 0..100 step 10)
        print(FMT.format(20.0 + 80.0 * Math.exp(-0.07 * t)))
    println()
}

fun cooling(temp: Double) = -0.07 * (temp - 20.0)

fun main(args: Array<String>) {
    analytic()
    for (i in listOf(2, 5, 10))
        euler(::cooling, 100.0, i, 100)
}


bundle Default {
  class Evolutionary {
    target : static : String;
    possibilities : static : Char[];
    C : static : Int;
    minMutateRate : static : Float;
    perfectFitness : static : Int;
    parent : static : String ;
    rand : static : Float;

    function : Init() ~ Nil {
      target := "METHINKS IT IS LIKE A WEASEL";
      possibilities := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "->ToCharArray();
      C := 100;
      minMutateRate := 0.09;
      perfectFitness := target->Size();
    }

    function : fitness(trial : String) ~ Int {
        retVal := 0;

        each(i : trial) {
          if(trial->Get(i) = target->Get(i)) {
            retVal += 1;
          };
        };

        return retVal;
      }

      function : newMutateRate() ~ Float {
        x : Float := perfectFitness - fitness(parent);
        y : Float := perfectFitness->As(Float) * (1.01 - minMutateRate);

         return x / y;
      }

      function : mutate(parent : String, rate : Float) ~ String {
        retVal := "";

        each(i : parent) {
          rand := Float->Random();
          if(rand <= rate) {
            rand *= 1000.0;
            intRand := rand->As(Int);
            index : Int := intRand % possibilities->Size();
            retVal->Append(possibilities[index]);
          }
          else {
            retVal->Append(parent->Get(i));
          };
      };

        return retVal;
      }

      function : Main(args : String[]) ~ Nil {
        Init();
        parent := mutate(target, 1.0);

        iter := 0;
        while(target->Equals(parent) <> true) {
          rate := newMutateRate();
          iter += 1;

          if(iter % 100 = 0){
            IO.Console->Instance()->Print(iter)->Print(": ")->PrintLine(parent);
          };

          bestSpawn : String;
          bestFit := 0;

          for(i := 0; i < C; i += 1;) {
            spawn := mutate(parent, rate);
            fitness := fitness(spawn);

            if(fitness > bestFit) {
              bestSpawn := spawn;
              bestFit := fitness;
            };
          };

          if(bestFit > fitness(parent)) {
            parent := bestSpawn;
          };
        };
        parent->PrintLine();
      }
    }
  }
}


function isEven( i ) {
  return (i & 1) === 0;
}


def is_even: type == "number" and floor == 0 and . % 2 == 0;


const func integer: fib (in integer: number) is func
  result
    var integer: result is 1;
  begin
    if number > 2 then
      result := fib(pred(number)) + fib(number - 2);
    elsif number = 0 then
      result := 0;
    end if;
  end func;


fn fact(n:u32) -> u64 {
  let mut f:u64 = n as u64;
  for i in 2..n {
    f *= i as u64;
  }
  return f;
}

fn choose(n: u32, k: u32)  -> u64 {
   let mut num:u64 = n as u64;
   for i in 1..k {
     num *= (n-i) as u64;
   }
   return num / fact(k);
}

fn main() {
  println!("{}", choose(5,3));
}


object Binomial {
   def main(args: Array[String]): Unit = {
      val n=5
      val k=3
      val result=binomialCoefficient(n,k)
      println("The Binomial Coefficient of %d and %d equals %d.".format(n, k, result))
   }

   def binomialCoefficient(n:Int, k:Int)=fact(n) / (fact(k) * fact(n-k))
   def fact(n:Int):Int=if (n==0) 1 else n*fact(n-1)
}


(define (factorial n)
  (define (*factorial n acc)
    (if (zero? n)
        acc
        (*factorial (- n 1) (* acc n))))
  (*factorial n 1))

(define (choose n k)
  (/ (factorial n) (* (factorial k) (factorial (- n k)))))

(display (choose 5 3))
(newline)


push 1
not
in(number)
duplicate
not        // label a
pointer    // pointer 1
duplicate
push 1
subtract
push 1
pointer
push 1
noop
pointer
duplicate  // the next op is back at label a

push 1     // this part continues from pointer 1
noop
push 2     // label b
push 1
rot 1 2
duplicate
not
pointer    // pointer 2
multiply
push 3
pointer
push 3
pointer
push 3
push 3
pointer
pointer    // back at label b

pop        // continues from pointer 2
out(number)
exit


A factorial is a number.

To run:
  Start up.
  Demonstrate input.
  Write "Bye-bye!" to the console.
  Wait for 1 second.
  Shut down.

To demonstrate input:
  Write "Enter a number: " to the console without advancing.
  Read a string from the console.
  If the string is empty, exit.
  Convert the string to a number.
  If the number is negative, repeat.
  Compute a factorial of the number.
  Write "Factorial of the number: " then the factorial then the return byte to the console.
  Repeat.

To decide if a string is empty:
  If the string's length is 0, say yes.
  Say no.

To compute a factorial of a number:
  If the number is 0, put 1 into the factorial; exit.
  Compute another factorial of the number minus 1.  \ recursion
  Put the other factorial times the number into the factorial.


T0 = 100
TR = 20
k = 0.07
delta_t = { 2, 5, 10 }
n = 100

NewtonCooling = function( t ) return -k * ( t - TR ) end

function Euler( f, y0, n, h )
    local y = y0
    for x = 0, n, h do
	print( "", x, y )
 	y = y + h * f( y )
    end
end

for i = 1, #delta_t do
    print( "delta_t = ", delta_t[i] )
    Euler( NewtonCooling, T0, n, delta_t[i] )
end


let target = "METHINKS IT IS LIKE A WEASEL"
let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
let tlen = String.length target
let clen = String.length charset
let () = Random.self_init()

let parent =
  let s = String.create tlen in
  for i = 0 to tlen-1 do
    s.[i] <- charset.[Random.int clen]
  done;
  s

let fitness ~trial =
  let rec aux i d =
    if i >= tlen then d else
      aux (i+1) (if target.[i] = trial.[i] then d+1 else d) in
  aux 0 0

let mutate parent rate =
  let s = String.copy parent in
  for i = 0 to tlen-1 do
    if Random.float 1.0 > rate then
      s.[i] <- charset.[Random.int clen]
  done;
  s, fitness s

let () =
  let i = ref 0 in
  while parent <> target do
    let pfit = fitness parent in
    let rate = float pfit /. float tlen in
    let tries = Array.init 200 (fun _ -> mutate parent rate) in
    let min_by (a, fa) (b, fb) = if fa > fb then a, fa else b, fb in
    let best, f = Array.fold_left min_by (parent, pfit) tries in
    if !i mod 100 = 0 then
      Printf.printf "%5d - '%s'  (fitness:%2d)\n%!" !i best f;
    String.blit best 0 parent 0 tlen;
    incr i
  done;
  Printf.printf "%5d - '%s'\n" !i parent


#!/usr/bin/env jsish
/* Even or Odd, in Jsish */
function isEven(n:number):boolean { return (n & 1) === 0; }

provide('isEven', 1);

if (Interp.conf('unitTest')) {
;    isEven(0);
;    isEven(1);
;    isEven(2);
;    isEven(-13);
}

/*
=!EXPECTSTART!=
isEven(0) ==> true
isEven(1) ==> false
isEven(2) ==> true
isEven(-13) ==> false
=!EXPECTEND!=
*/


fibonacci(n) :=
		n when n < 2
	else
		fibonacci(n - 1) + fibonacci(n - 2);


$ include "seed7_05.s7i";

const proc: main is func
  local
    var integer: n is 0;
    var integer: k is 0;
  begin
    for n range 0 to 66 do
      for k range 0 to n do
         write(n ! k <& " ");
      end for;
      writeln;
    end for;
  end func;


choose(n, k) := product(k + 1 ... n) / product(1 ... n - k);


func binomial(n,k) {
    n! / ((n-k)! * k!)
}

say binomial(400, 200)


Transcript showCR: (5 binco:3).
Transcript showCR: (400 binco:200)


class BrainfuckProgram {

    def program = '', memory = [:]
    def instructionPointer = 0, dataPointer = 0

    def execute() {
        while (instructionPointer < program.size())
            switch(program[instructionPointer++]) {
            case '>': dataPointer++; break;
            case '<': dataPointer--; break;
            case '+': memory[dataPointer] = memoryValue + 1; break
            case '-': memory[dataPointer] = memoryValue - 1; break
            case ',': memory[dataPointer] = System.in.read(); break
            case '.': print String.valueOf(Character.toChars(memoryValue)); break
            case '[': handleLoopStart(); break
            case ']': handleLoopEnd(); break
            }
    }

    private getMemoryValue() { memory[dataPointer] ?: 0 }

    private handleLoopStart() {
        if (memoryValue) return

        int depth = 1
        while (instructionPointer < program.size())
            switch(program[instructionPointer++]) {
            case '[': depth++; break
            case ']': if (!(--depth)) return
            }
        throw new IllegalStateException('Could not find matching end bracket')
    }

    private handleLoopEnd() {
        int depth = 0
        while (instructionPointer >= 0) {
            switch(program[--instructionPointer]) {
            case ']': depth++; break
            case '[': if (!(--depth)) return; break
            }
        }
        throw new IllegalStateException('Could not find matching start bracket')
    }
}


factorial: procedure (N) returns (fixed decimal (30));
   declare N fixed binary nonassignable;
   declare i fixed decimal (10);
   declare F fixed decimal (30);

   if N < 0 then signal error;
   F = 1;
   do i = 2 to N;
      F = F * i;
   end;
   return (F);
end factorial;


with(Student[NumericalAnalysis]);
k := 0.07:
TR := 20:
Euler(diff(T(t), t) = -k*(T(t) - TR), T(0) = 100, t = 100, numsteps = 50); # step size = 2
Euler(diff(T(t), t) = -k*(T(t) - TR), T(0) = 100, t = 100, numsteps = 20); # step size = 5
Euler(diff(T(t), t) = -k*(T(t) - TR), T(0) = 100, t = 100, numsteps = 10); # step size = 10


euler[step_, val_] := NDSolve[
    {T'[t] == -0.07 (T[t] - 20), T[0] == 100},
    T, {t, 0, 100},
    Method -> "ExplicitEuler",
    StartingStepSize -> step
][[1, 1, 2]][val]


euler_method(f, y0, a, b, h):= block(
  [t: a, y: y0, tg: [a], yg: [y0]],
  unless t>=b do (
    t: t + h,
    y: y + f(t, y)*h,
    tg: endcons(t, tg),
    yg: endcons(y, yg)
    ),
  [tg, yg]
  );

/* initial temperature */
T0: 100;

/* environment of temperature */
Tr: 20;

/* the cooling constant */
k: 0.07;

/* end of integration */
tmax: 100;

/* analytical solution */
Tref(t):= Tr + (T0 - Tr)*exp(-k*t);

/* cooling rate */
dT(t, T):= -k*(T-Tr);

/* get numerical solution */
h: 10;
[tg, yg]: euler_method('dT, T0, 0, tmax,  h);

/* plot analytical and numerical solution */
plot2d([Tref, [discrete, tg, yg]], ['t, 0, tmax],
  [legend, "analytical", concat("h = ", h)],
  [xlabel, "t / seconds"],
  [ylabel, "Temperature / C"]);


global target;
target = split("METHINKS IT IS LIKE A WEASEL", "");
charset = ["A":"Z", " "];
p = ones(length(charset), 1) ./ length(charset);
parent = discrete_rnd(charset, p, length(target), 1);
mutaterate = 0.1;

C = 1000;

function r = fitness(parent, target)
  r = sum(parent == target) ./ length(target);
endfunction

function r = mutate(parent, mutaterate, charset)
  r = parent;
  p = unifrnd(0, 1, length(parent), 1);
  nmutants = sum( p < mutaterate );
  if (nmutants)
    s = discrete_rnd(charset, ones(length(charset), 1) ./ length(charset),nmutants,1);
    r( p < mutaterate ) = s;
  endif
endfunction

function r = evolve(parent, mutatefunc, fitnessfunc, C, mutaterate, charset)
  global target;
  children = [];
  for i = 1:C
    children = [children, mutatefunc(parent, mutaterate, charset)];
  endfor
  children = [parent, children];
  fitval = [];
  for i = 1:columns(children)
    fitval = [fitval, fitnessfunc(children(:,i), target)];
  endfor
  [m, im] = max(fitval);
  r = children(:, im);
endfunction

function printgen(p, t, i)
  printf("%3d %5.2f %s\n", i, fitness(p, t), p');
endfunction

i = 0;

while( !all(parent == target) )
  i++;
  parent = evolve(parent, @mutate, @fitness, C, mutaterate, charset);
  if ( mod(i, 1) == 0 )
    printgen(parent, target, i);
  endif
endwhile
disp(parent');


oddp: {:[x!2;1;0]} /Returns 1 if arg. is odd
evenp: {~oddp[x]}  /Returns 1 if arg. is even

Examples:
   oddp 32
0
   evenp 32
1


( -5 5 ) [
    dup print " " print 2 mod ( ["Odd"] ["Even"] ) if print nl
] for

" " input


// version 1.0.5-2

fun main(args: Array<String>) {
    while (true) {
        print("Enter an integer or 0 to finish : ")
        val n = readLine()!!.toInt()
        when {
            n == 0     -> return
            n % 2 == 0 -> println("Your number is even")
            else       -> println("Your number is odd")
        }
    }
}


$ Print out the first ten Fibonacci numbers
$ This uses Set Builder Notation, it roughly means
$ 'collect fib(n) forall n in {0,1,2,3,4,5,6,7,8,9,10}'
print({fib(n) : n in {0..10}});

$ Iterative Fibonacci function
proc fib(n);
    A := 0; B := 1; C := n;
    for i in {0..n} loop
        C := A + B;
        A := B;
        B := C;
    end loop;
    return C;
end proc;


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

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

func binomial<T: BinaryInteger>(_ x: (n: T, k: T)) -> T {
  let nFac = factorial(x.n)
  let kFac = factorial(x.k)

  return nFac / (factorial(x.n - x.k) * kFac)
}

print("binomial(\(5), \(3)) = \(binomial((5, 3)))")
print("binomial(\(20), \(11)) = \(binomial((20, 11)))")


package require Tcl 8.5
proc binom {n k} {
    # Compute the top half of the division; this is n!/(n-k)!
    set pTop 1
    for {set i $n} {$i > $n - $k} {incr i -1} {
	set pTop [expr {$pTop * $i}]
    }

    # Compute the bottom half of the division; this is k!
    set pBottom 1
    for {set i $k} {$i > 1} {incr i -1} {
	set pBottom [expr {$pBottom * $i}]
    }

    # Integer arithmetic divide is correct here; the factors always cancel out
    return [expr {$pTop / $pBottom}]
}


10 REM BRAINFK INTERPRETER FOR GW-BASIC
20 INPUT "File to open? ",INFILE$
30 DIM TAPE(10000):  REM memory is 10000 long
40 DIM PRG$(5000):   REM programs can be 5000 symbols long
50 PRG$ = ""
60 OPEN(INFILE$) FOR INPUT AS #1
70 S = 0 : REM instruction pointer
80 WHILE NOT EOF(1)
90 LINE INPUT #1, LIN$
100 FOR P = 1 TO LEN(LIN$)
110 C$=MID$(LIN$,P,1)
120 IF C$="+" OR C$="-" OR C$="." OR C$="," OR C$ = "<" OR C$=">" OR C$="[" OR C$="]" THEN S=S+1:PRG$(S)=C$
130 NEXT P
140 WEND
150 PRLEN = S
160 REM ok, the program has been read in. now set up the variables
170 P = 0 : REM tape pointer
180 S = 1 : REM instruction pointer
190 K = 0 : REM bracket counter
200 WHILE S<=PRLEN: REM as long as there are still instructions to come
210 IF INKEY$="Q" THEN END
220 IF PRG$(S) = "+" THEN GOSUB 320
230 IF PRG$(S) = "-" THEN GOSUB 350
240 IF PRG$(S) = ">" THEN GOSUB 380
250 IF PRG$(S) = "<" THEN GOSUB 420
260 IF PRG$(S) = "." THEN GOSUB 460
270 IF PRG$(S) = "," THEN GOSUB 490
280 IF PRG$(S) = "[" THEN GOSUB 650 ELSE IF PRG$(S) = "]" THEN GOSUB 550
290 S = S + 1
300 WEND
310 END
320 REM the + instruction
330 TAPE(P) = TAPE(P) + 1
340 RETURN
350 REM the - instruction
360 TAPE(P) = TAPE(P)-1
370 RETURN
380 REM the > instruction
390 P = P + 1
400 IF P > 10000 THEN P = P - 10000 : REM circular tape, because why not?
410 RETURN
420 REM the < instruction
430 P = P - 1
440 IF P < 0 THEN P = P + 10000
450 RETURN
460 REM the . instruction
470 PRINT CHR$(TAPE(P));
480 RETURN
490 REM the , instruction
500 BEEP   :   REM use the beep as a signal that input is expected
510 G$ = INKEY$
520 IF G$ = "" THEN GOTO 510
530 TAPE(P) = ASC(G$)
540 RETURN
550 REM the ] instruction
560 IF TAPE(P)=0 THEN RETURN :  REM do nothing
570 K = 1 : REM otherwise it's some bracket counting
580 WHILE K > 0
590 S = S - 1
600 IF S = 0 THEN PRINT "Backtrack beyond start of program!" : END
610 IF PRG$(S) = "]" THEN K = K + 1
620 IF PRG$(S) = "[" THEN K = K - 1
630 WEND
640 RETURN
650 REM the [ instruction
660 IF TAPE(P)<> 0 THEN RETURN
670 K = 1
680 WHILE K>0
690 S = S + 1
700 IF S>PRLEN THEN PRINT "Advance beyond end of program!" : END
710 IF PRG$(S) = "]" THEN K = K - 1
720 IF PRG$(S) = "[" THEN K = K + 1
730 WEND
740 RETURN


DECLARE
  /*====================================================================================================
  -- For     :  https://rosettacode.org/
  -- --
  -- Task    : Factorial
  -- Method  : iterative
  -- Language: PL/SQL
  --
  -- 2020-12-30 by alvalongo
  ====================================================================================================*/
  --
  FUNCTION fnuFactorial(inuValue   INTEGER)
  RETURN NUMBER
  IS
    nuFactorial NUMBER;
  BEGIN
    IF inuValue IS NOT NULL THEN
       nuFactorial:=1;
       --
       IF inuValue>=1 THEN
          --
          FOR nuI IN 1..inuValue LOOP
              nuFactorial:=nuFactorial*nuI;
          END LOOP;
          --
       END IF;
       --
    END IF;
    --
    RETURN(nuFactorial);
  END fnuFactorial;
BEGIN
  FOR nuJ IN 0..100 LOOP
      DBMS_OUTPUT.Put_Line('Factorial('||nuJ||')='||fnuFactorial(nuJ));
  END LOOP;
END;


import strutils

proc euler(f: proc (x,y: float): float; y0, a, b, h: float) =
  var (t,y) = (a,y0)
  while t < b:
    echo formatFloat(t, ffDecimal, 3), " ", formatFloat(y, ffDecimal, 3)
    t += h
    y += h * f(t,y)

proc newtoncooling(time, temp: float): float =
  -0.07 * (temp - 20)

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


class EulerMethod {
  T0 : static : Float;
  TR : static : Float;
  k : static : Float;
  delta_t : static : Float[];
  n : static : Float;

  function : Main(args : String[]) ~ Nil {
    T0 := 100;
    TR := 20;
    k := 0.07;
    delta_t := [2.0, 5.0, 10.0];
    n := 100;

    f := NewtonCooling(Float) ~ Float;
    for(i := 0; i < delta_t->Size(); i+=1;) {
      IO.Console->Print("delta_t = ")->PrintLine(delta_t[i]);
      Euler(f, T0, n->As(Int), delta_t[i]);
    };
  }

  function : native : NewtonCooling(t : Float) ~ Float {
    return -1 * k * (t-TR);
  }

  function : native : Euler(f : (Float) ~ Float, y : Float, n : Int, h : Float) ~ Nil {
    for(x := 0; x<=n; x+=h;) {
      IO.Console->Print("\t")->Print(x)->Print("\t")->PrintLine(y);
      y += h * f(y);
    };
  }
}


 EULERCO  CSECT
         USING  EULERCO,R13
         B      80(R15)
         DC     17F'0'
         DC     CL8'EULERCO'
         STM    R14,R12,12(R13)
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R13,R15
         ZAP    X1,=P'1'
LOOPX1   ZAP    PT,MAXN            do x1=1 to maxn-4
         SP     PT,=P'4'
         CP     X1,PT
         BH     ELOOPX1
         ZAP    PT,X1
         AP     PT,=P'1'
         ZAP    X2,PT
LOOPX2   ZAP    PT,MAXN            do x2=x1+1 to maxn-3
         SP     PT,=P'3'
         CP     X2,PT
         BH     ELOOPX2
         ZAP    PT,X2
         AP     PT,=P'1'
         ZAP    X3,PT
LOOPX3   ZAP    PT,MAXN            do x3=x2+1 to maxn-2
         SP     PT,=P'2'
         CP     X3,PT
         BH     ELOOPX3
         ZAP    PT,X3
         AP     PT,=P'1'
         ZAP    X4,PT
LOOPX4   ZAP    PT,MAXN            do x4=x3+1 to maxn-1
         SP     PT,=P'1'
         CP     X4,PT
         BH     ELOOPX4
         ZAP    PT,X4
         AP     PT,=P'1'
         ZAP    X5,PT              x5=x4+1
         ZAP    SUMX,=P'0'         sumx=0
         ZAP    PT,X1              x1
         BAL    R14,POWER5
         AP     SUMX,PT
         ZAP    PT,X2              x2
         BAL    R14,POWER5
         AP     SUMX,PT
         ZAP    PT,X3              x3
         BAL    R14,POWER5
         AP     SUMX,PT
         ZAP    PT,X4              x4
         BAL    R14,POWER5
         AP     SUMX,PT            sumx=x1**5+x2**5+x3**5+x4**5
         ZAP    PT,X5              x5
         BAL    R14,POWER5
         ZAP    VALX,PT            valx=x5**5
LOOPX5   CP     X5,MAXN            while x5<=maxn & valx<=sumx
         BH     ELOOPX5
         CP     VALX,SUMX
         BH     ELOOPX5
         CP     VALX,SUMX          if valx=sumx
         BNE    NOTEQUAL
         MVI    BUF,C' '
         MVC    BUF+1(79),BUF      clear buffer
         MVC    WC,MASK
         ED     WC,X1              x1
         MVC    BUF+0(8),WC+8
         MVC    WC,MASK
         ED     WC,X2              x2
         MVC    BUF+8(8),WC+8
         MVC    WC,MASK
         ED     WC,X3              x3
         MVC    BUF+16(8),WC+8
         MVC    WC,MASK
         ED     WC,X4              x4
         MVC    BUF+24(8),WC+8
         MVC    WC,MASK
         ED     WC,X5              x5
         MVC    BUF+32(8),WC+8
         XPRNT  BUF,80             output x1,x2,x3,x4,x5
         B      ELOOPX1
NOTEQUAL ZAP    PT,X5
         AP     PT,=P'1'
         ZAP    X5,PT              x5=x5+1
         ZAP    PT,X5
         BAL    R14,POWER5
         ZAP    VALX,PT            valx=x5**5
         B      LOOPX5
ELOOPX5  AP     X4,=P'1'
         B      LOOPX4
ELOOPX4  AP     X3,=P'1'
         B      LOOPX3
ELOOPX3  AP     X2,=P'1'
         B      LOOPX2
ELOOPX2  AP     X1,=P'1'
         B      LOOPX1
ELOOPX1  L      R13,4(0,R13)
         LM     R14,R12,12(R13)
         XR     R15,R15
         BR     R14
POWER5   ZAP    PQ,PT              ^1
         MP     PQ,PT              ^2
         MP     PQ,PT              ^3
         MP     PQ,PT              ^4
         MP     PQ,PT              ^5
         ZAP    PT,PQ
         BR     R14
MAXN     DC     PL8'249'
X1       DS     PL8
X2       DS     PL8
X3       DS     PL8
X4       DS     PL8
X5       DS     PL8
SUMX     DS     PL8
VALX     DS     PL8
PT       DS     PL8
PQ       DS     PL8
WC       DS     CL17
MASK     DC     X'40',13X'20',X'212060'  CL17
BUF      DS     CL80
         YREGS
         END


; Prove Euler's sum of powers conjecture false by finding
; positive a,b,c,d,e such that a⁵+b⁵+c⁵+d⁵=e⁵.

; we're only looking for the first counterexample, which occurs with all
; integers less than this value
max_value      = $fa  ; decimal 250

; this header turns our code into a LOADable and RUNnable BASIC program
.include "basic_header.s"

; this contains the first 256 integers to the power of 5 broken up into
; 5 tables of one-byte values (power5byte0 with the LSBs through
; power5byte4 with the MSBs)
.include "power5table.s"

; this defines subroutines and macros for printing messages to
; the console, including `puts` for printing out a NUL-terminated string,
; puthex to display a one-byte value in hexadecimal, and putdec through
; putdec5 to display an N-byte value in decimal
.include "output.s"

; label strings for the result output
.feature string_escapes
success:   .asciiz "\r\rFOUND EXAMPLE:\r\r"
between:   .asciiz "^5 + "
penult:    .asciiz "^5 = "
eqend:     .asciiz "^5\r\r(SUM IS "

; the BASIC loader program prints the elapsed time at the end, so we include a
; label for that, too
tilabel:   .asciiz ")\r\rTIME:"

; ZP locations to store the integers to try
x0 = $f7
x1 = x0 + 1
x2 = x0 + 2
x3 = x0 + 3

; we use binary search to find integer roots; current bounds go here
low = x0 + 4
hi  = x0 + 5

; sum of powers of current candidate integers
sum: .res 5

; when we find a sum with an integer 5th root, we put it here
x4: .res 1

main: ; loop for x0 from 1 to max_value
       ldx #01
       stx x0

loop0: ; loop for x1 from x0+1 to max_value
       ldx x0
       inx
       stx x1

loop1: ; loop for x2 from x1+1 to max_value
       ldx x1
       inx
       stx x2

loop2: ; loop for x3 from x2+1 to max_value
       ldx x2
       inx
       stx x3

loop3: ; add up the fifth powers of the four numbers
       ; initialize to 0
       lda #00
       sta sum
       sta sum+1
       sta sum+2
       sta sum+3
       sta sum+4

       ; we use indexed addressing, taking advantage of the fact that the xn's
       ; are consecutive, so x0,1 = x1, etc.
       ldy #0
addloop:
       ldx x0,y
       lda sum
       clc
       adc power5byte0,x
       sta sum
       lda sum+1
       adc power5byte1,x
       sta sum+1
       lda sum+2
       adc power5byte2,x
       sta sum+2
       lda sum+3
       adc power5byte3,x
       sta sum+3
       lda sum+4
       adc power5byte4,x
       sta sum+4
       iny
       cpy #4
       bcc addloop
       ; now sum := x₀⁵+x₁⁵+x₂⁵+x₃⁵
       ; set initial bounds for binary search
       ldx x3
       inx
       stx low
       ldx #max_value
       dex
       stx hi

binsearch:
       ; compute midpoint
       lda low
       cmp hi
       beq notdone
       bcs done_search
notdone:
       ldx #0
       clc
       adc hi

       ; now a + carry bit = low+hi; rotating right will get the midpoint
       ror
       ; compare square of midpoint to sum
       tax
       lda sum+4
       cmp power5byte4,x
       bne notyet
       lda sum+3
       cmp power5byte3,x
       bne notyet
       lda sum+2
       cmp power5byte2,x
       bne notyet
       lda sum+1
       cmp power5byte1,x
       bne notyet
       lda sum
       cmp power5byte0,x
       beq found
notyet:
       bcc sum_lt_guess
       inx
       stx low
       bne endbin
       beq endbin
sum_lt_guess:
       dex
       stx hi
endbin:
       bne binsearch
       beq binsearch

done_search:
       inc x3
       lda x3
       cmp #max_value
       bcs end_loop3
       jmp loop3

end_loop3:
       inc x2
       lda x2
       cmp #max_value
       bcs end_loop2
       jmp loop2

end_loop2:
       inc x1
       lda x1
       cmp #max_value
       bcs end_loop1
       jmp loop1

end_loop1:
       inc x0
       lda x0
       cmp #max_value
       bcs end_loop0
       jmp loop0

end_loop0:
       ; should never get here, means we didn't find an example.
       brk

found: stx x4
       puts success
       putdec x0
       ldy #1

ploop: puts between
       putdec {x0,y}
       iny
       cpy #4
       bcc ploop
       puts penult
       putdec {x0,y}
       puts eqend
       putdec5 sum
       puts tilabel
       rts