def sin(x)  { return x.sin() }
def cos(x)  { return x.cos() }
def asin(x) { return x.asin() }
def acos(x) { return x.acos() }
def cube(x) { return x ** 3     }
def curt(x) { return x ** (1/3) }

def forward := [sin,  cos,  cube]
def reverse := [asin, acos, curt]


ClearAll[FiveNum]
FiveNum[x_List] := Quantile[x, Range[0, 1, 1/4]]
FiveNum[RandomVariate[NormalDistribution[], 10000]]


MODULE Fivenum;
FROM FormatString IMPORT FormatString;
FROM LongStr IMPORT RealToStr;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE WriteLongReal(v : LONGREAL);
VAR buf : ARRAY[0..63] OF CHAR;
BEGIN
    RealToStr(v, buf);
    WriteString(buf)
END WriteLongReal;

PROCEDURE WriteArray(arr : ARRAY OF LONGREAL);
VAR i : CARDINAL;
BEGIN
    WriteString("[");
    FOR i:=0 TO HIGH(arr) DO
        WriteLongReal(arr[i]);
        WriteString(", ")
    END;
    WriteString("]")
END WriteArray;

(* Assumes that the input is sorted *)
PROCEDURE Median(x : ARRAY OF LONGREAL; beg,end : CARDINAL) : LONGREAL;
VAR m,cnt : CARDINAL;
BEGIN
    cnt := end - beg + 1;
    m := cnt / 2;
    IF cnt MOD 2 = 1 THEN
        RETURN x[beg + m]
    END;
    RETURN (x[beg + m - 1] + x[beg + m]) / 2.0
END Median;

TYPE Summary = ARRAY[0..4] OF LONGREAL;
PROCEDURE Fivenum(input : ARRAY OF LONGREAL) : Summary;
    PROCEDURE Sort();
    VAR
        i,j : CARDINAL;
        t : LONGREAL;
    BEGIN
        FOR i:=0 TO HIGH(input) DO
            FOR j:=0 TO HIGH(input) DO
                IF (i#j) AND (input[i] < input[j]) THEN
                    t := input[i];
                    input[i] := input[j];
                    input[j] := t
                END
            END
        END
    END Sort;
VAR
    result : Summary;
    size,m,low : CARDINAL;
BEGIN
    size := HIGH(input);
    Sort();

    result[0] := input[0];
    result[2] := Median(input,0,size);
    result[4] := input[size];

    m := size / 2;
    IF (size MOD 2 = 1) THEN
        low := m
    ELSE
        low := m - 1
    END;
    result[1] := Median(input, 0, m);
    result[3] := Median(input, m+1, size);

    RETURN result;
END Fivenum;

TYPE
    A6 = ARRAY[0..5] OF LONGREAL;
    A11 = ARRAY[0..10] OF LONGREAL;
    A20 = ARRAY[0..19] OF LONGREAL;
VAR
    a6 : A6;
    a11 : A11;
    a20 : A20;
BEGIN
    a11 := A11{15.0, 6.0, 42.0, 41.0, 7.0, 36.0, 49.0, 40.0, 39.0, 47.0, 43.0};
    WriteArray(Fivenum(a11));
    WriteLn;
    WriteLn;

    a6 := A6{36.0, 40.0, 7.0, 39.0, 41.0, 15.0};
    WriteArray(Fivenum(a6));
    WriteLn;
    WriteLn;

    a20 := A20{
        0.14082834,  0.09748790,  1.73131507,  0.87636009, -1.95059594,  0.73438555,
        -0.03035726,  1.46675970, -0.74621349, -0.72588772,  0.63905160,  0.61501527,
        -0.98983780, -1.00447874, -0.62759469,  0.66206163,  1.04312009, -0.10305385,
        0.75775634,  0.32566578
    };
    WriteArray(Fivenum(a20));
    WriteLn;

    ReadChar
END Fivenum.


(for n 1 100
  (prn:if
    (multiple n 15) 'FizzBuzz
    (multiple n 5) 'Buzz
    (multiple n 3) 'Fizz
    n))


link graphics,printf

$define EDGE  0
$define EMPTY 1
$define TREE  2
$define FIRE  3

global Colours,Width,Height,ProbTree,ProbFire,ProbInitialTree,Forest,oldForest

procedure main()             # forest fire

    Height := 400            # Window height
    Width := 400             # Window width
    ProbInitialTree := .10   # intial probability of trees
    ProbTree := .01          # ongoing probability of trees
    ProbFire := ProbTree/50. # probability of fire
    Rounds := 500            # rounds to evolve

    setup_forest()
    every 1 to Rounds do {
       show_forest()
       evolve_forest()
       }
    printf("Forest fire %d x %d rounds=%d p.initial=%r p/f=%r/%r fps=%r\n",
           Width,Height,Rounds,ProbInitialTree,ProbTree,ProbFire,
           Rounds/(&time/1000.))  # stats
    WDone()
end

procedure setup_forest()     #: setup the forest

    Colours := table()       # define colours
    Colours[EDGE]  := "black"
    Colours[EMPTY] := "grey"
    Colours[TREE]  := "green"
    Colours[FIRE]  := "red"

    WOpen("label=Forest Fire", "bg=black",
          "size=" || Width+2 || "," || Height+2) | # add for border
             stop("Unable to open Window")
    every !(Forest := list(Height)) := list(Width,EMPTY)  # default
    every ( Forest[1,1 to Width]  | Forest[Height,1 to Width] |
            Forest[1 to Height,1] | Forest[1 to Height,Width] ) := EDGE
    every r := 2 to Height-1 & c := 2 to Width-1 do
       if probability(ProbInitialTree) then Forest[r,c] := TREE
end

procedure show_forest()      #: show Forest - drawn changes only
   every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do
      if /oldForest | oldForest[r,c] ~= Forest[r,c] then {
         WAttrib("fg=" || Colours[Forest[r,c]])
         DrawPoint(r,c)
      }
end

procedure evolve_forest()    #: evolve forest
    old := oldForest := list(*Forest)     # freeze copy
    every old[i := 1 to *Forest] := copy(Forest[i])  # deep copy

    every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do
       Forest[r,c] := case old[r,c] of {   # apply rules
          FIRE : EMPTY
          TREE : if probability(ProbFire) |
                  ( old[r-1, c-1 to c+1] |
                    old[r,c-1|c+1] |
                    old[r+1,c-1 to c+1] ) = FIRE then FIRE
          EMPTY: if probability(ProbTree) then TREE
          }
end

procedure probability(P)     #: succeed with probability P
if ?0 <= P then return
end


;; adapted from Racket
;; (compose f g h ... ) is a built-in defined as :
;; (define (compose f g) (λ (x) (f (g x))))

(define (cube x) (expt x 3))
(define (cube-root x) (expt x (// 1 3)))
(define funlist (list sin cos cube))
(define ifunlist (list asin acos cube-root))

(for ([f funlist] [i ifunlist])
  (writeln ((compose i f) 0.5)))
→
    0.5
    0.4999999999999999
    0.5


open number //sin,cos,asin,acos
open list //zipWith

cube x = x ** 3
croot x = x ** (1/3)

funclist = [sin, cos, cube]
funclisti = [asin, acos, croot]

zipWith (\f inversef -> (inversef << f) 0.5) funclist funclisti


/ * linux GAS */

.global _start

.data

Fizz: .ascii "Fizz\n"
Buzz: .ascii "Buzz\n"
FizzAndBuzz: .ascii "FizzBuzz\n"

numstr_buffer: .skip 3
newLine: .ascii "\n"

.text

_start:

  bl FizzBuzz

  mov r7, #1
  mov r0, #0
  svc #0

FizzBuzz:

  push {lr}
  mov r9, #100

  fizzbuzz_loop:

    mov r0, r9
    mov r1, #15
    bl divide
    cmp r1, #0
    ldreq r1, =FizzAndBuzz
    moveq r2, #9
    beq fizzbuzz_print

    mov r0, r9
    mov r1, #3
    bl divide
    cmp r1, #0
    ldreq r1, =Fizz
    moveq r2, #5
    beq fizzbuzz_print

    mov r0, r9
    mov r1, #5
    bl divide
    cmp r1, #0
    ldreq r1, =Buzz
    moveq r2, #5
    beq fizzbuzz_print

    mov r0, r9
    bl make_num
    mov r2, r1
    mov r1, r0

    fizzbuzz_print:

      mov r0, #1
      mov r7, #4
      svc #0

      sub r9, #1
      cmp r9, #0

    bgt fizzbuzz_loop

  pop {lr}
  mov pc, lr

make_num:

  push {lr}
  ldr r4, =numstr_buffer
  mov r5, #4
  mov r6, #1

  mov r1, #100
  bl divide

  cmp r0, #0
  subeq r5, #1
  movne r6, #0

  add r0, #48
  strb r0, [r4, #0]

  mov r0, r1
  mov r1, #10
  bl divide

  cmp r0, #0
  movne r6, #0
  cmp r6, #1
  subeq r5, #1

  add r0, #48
  strb r0, [r4, #1]

  add r1, #48
  strb r1, [r4, #2]

  mov r2, #4
  sub r0, r2, r5
  add r0, r4, r0
  mov r1, r5

  pop {lr}
  mov pc, lr

divide:
  udiv r2, r0, r1
  mul r3, r1, r2
  sub r1, r0, r3
  mov r0, r2
  mov pc, lr


NB. states: 0 empty, 1 tree, _1 fire
dims =:10 10

  tessellate=: 0,0,~0,.0,.~ 3 3 >./@,;._3 ]
  mask=: tessellate dims$1
  chance=: 1 :'(> ? bind (dims$0)) bind (mask*m)'

start=: 0.5 chance
grow =: 0.01 chance
fire =: 0.001 chance

  spread=: [: tessellate 0&>

  step=: grow [`]@.(|@])"0 >.&0 * _1 ^ fire +. spread

  run=:3 :0
    forest=. start''
    for.i.y do.
      smoutput ' #o' {~ forest=. step forest
    end.
  )


@caversion 1;

dimensions 2;

state EMPTY, TREE, BURNING;

// an empty cell grows a tree with a chance of p = 5 %
rule{EMPTY} [0.05] : -> TREE;

// a burning cell turns to a burned cell
rule{BURNING}: -> EMPTY;

// a tree starts burning if there is at least one neighbor burning
rule{TREE} : BURNING{1,} -> BURNING;

// a tree is hit by lightning with a change of f = 0.006 %
rule{TREE} [0.00006] : -> BURNING;


import system'routines;
import system'math;
import extensions'routines;
import extensions'math;

extension op
{
    compose(f,g)
        = f(g(self));
}

public program()
{
   var fs := new object[]{ mssgconst sin<mathOp>[1], mssgconst cos<mathOp>[1], (x => power(x, 3.0r)) };
   var gs := new object[]{ mssgconst arcsin<mathOp>[1], mssgconst arccos<mathOp>[1], (x => power(x, 1.0r / 3)) };

   fs.zipBy(gs, (f,g => 0.5r.compose(f,g)))
     .forEach:printingLn
}


defmodule First_class_functions do
  def task(val) do
    as = [&:math.sin/1, &:math.cos/1, fn x -> x * x * x end]
    bs = [&:math.asin/1, &:math.acos/1, fn x -> :math.pow(x, 1/3) end]
    Enum.zip(as, bs)
    |> Enum.each(fn {a,b} -> IO.puts compose([a,b], val) end)
  end

  defp compose(funs, x) do
    Enum.reduce(funs, x, fn f,acc -> f.(acc) end)
  end
end

First_class_functions.task(0.5)


-module( first_class_functions ).

-export( [task/0] ).

task() ->
	As = [fun math:sin/1, fun math:cos/1, fun cube/1],
	Bs = [fun math:asin/1, fun math:acos/1, fun square_inverse/1],
	[io:fwrite( "Value: 1.5 Result: ~p~n", [functional_composition([A, B], 1.5)]) || {A, B} <- lists:zip(As, Bs)].

functional_composition( Funs, X ) -> lists:foldl( fun(F, Acc) -> F(Acc) end, X, Funs ).

square( X ) -> math:pow( X, 2 ).

square_inverse( X ) -> math:sqrt( X ).


loop 1..100 [x][
	case []
		when? [0=x%15] -> print "FizzBuzz"
		when? [0=x%3]  -> print "Fizz"
		when? [0=x%5]  -> print "Buzz"
		else  		   -> print x
]


import java.util.Arrays;
import java.util.LinkedList;
import java.util.List;

public class Fire {
	private static final char BURNING = 'w'; //w looks like fire, right?
	private static final char TREE = 'T';
	private static final char EMPTY = '.';
	private static final double F = 0.2;
	private static final double P = 0.4;
	private static final double TREE_PROB = 0.5;

	private static List<String> process(List<String> land){
		List<String> newLand = new LinkedList<String>();
		for(int i = 0; i < land.size(); i++){
			String rowAbove, thisRow = land.get(i), rowBelow;
			if(i == 0){//first row
				rowAbove = null;
				rowBelow = land.get(i + 1);
			}else if(i == land.size() - 1){//last row
				rowBelow = null;
				rowAbove = land.get(i - 1);
			}else{//middle
				rowBelow = land.get(i + 1);
				rowAbove = land.get(i - 1);
			}
			newLand.add(processRows(rowAbove, thisRow, rowBelow));
		}
		return newLand;
	}

	private static String processRows(String rowAbove, String thisRow,
			String rowBelow){
		String newRow = "";
		for(int i = 0; i < thisRow.length();i++){
			switch(thisRow.charAt(i)){
			case BURNING:
				newRow+= EMPTY;
				break;
			case EMPTY:
				newRow+= Math.random() < P ? TREE : EMPTY;
				break;
			case TREE:
				String neighbors = "";
				if(i == 0){//first char
					neighbors+= rowAbove == null ? "" : rowAbove.substring(i, i + 2);
					neighbors+= thisRow.charAt(i + 1);
					neighbors+= rowBelow == null ? "" : rowBelow.substring(i, i + 2);
					if(neighbors.contains(Character.toString(BURNING))){
						newRow+= BURNING;
						break;
					}
				}else if(i == thisRow.length() - 1){//last char
					neighbors+= rowAbove == null ? "" : rowAbove.substring(i - 1, i + 1);
					neighbors+= thisRow.charAt(i - 1);
					neighbors+= rowBelow == null ? "" : rowBelow.substring(i - 1, i + 1);
					if(neighbors.contains(Character.toString(BURNING))){
						newRow+= BURNING;
						break;
					}
				}else{//middle
					neighbors+= rowAbove == null ? "" : rowAbove.substring(i - 1, i + 2);
					neighbors+= thisRow.charAt(i + 1);
					neighbors+= thisRow.charAt(i - 1);
					neighbors+= rowBelow == null ? "" : rowBelow.substring(i - 1, i + 2);
					if(neighbors.contains(Character.toString(BURNING))){
						newRow+= BURNING;
						break;
					}
				}
				newRow+= Math.random() < F ? BURNING : TREE;
			}
		}
		return newRow;
	}

	public static List<String> populate(int width, int height){
		List<String> land = new LinkedList<String>();
		for(;height > 0; height--){//height is just a copy anyway
			StringBuilder line = new StringBuilder(width);
			for(int i = width; i > 0; i--){
				line.append((Math.random() < TREE_PROB) ? TREE : EMPTY);
			}
			land.add(line.toString());
		}
		return land;
	}

	//process the land n times
	public static void processN(List<String> land, int n){
		for(int i = 0;i < n; i++){
			land = process(land);
		}
	}

	//process the land n times and print each step along the way
	public static void processNPrint(List<String> land, int n){
		for(int i = 0;i < n; i++){
			land = process(land);
			print(land);
		}
	}

	//print the land
	public static void print(List<String> land){
		for(String row: land){
			System.out.println(row);
		}
		System.out.println();
	}

	public static void main(String[] args){
		List<String> land = Arrays.asList(".TTT.T.T.TTTT.T",
				"T.T.T.TT..T.T..",
				"TT.TTTT...T.TT.",
				"TTT..TTTTT.T..T",
				".T.TTT....TT.TT",
				"...T..TTT.TT.T.",
				".TT.TT...TT..TT",
				".TT.T.T..T.T.T.",
				"..TTT.TT.T..T..",
				".T....T.....TTT",
				"T..TTT..T..T...",
				"TTT....TTTTTT.T",
				"......TwTTT...T",
				"..T....TTTTTTTT",
				".T.T.T....TT...");
		print(land);
		processNPrint(land, 10);

		System.out.println("Random land test:");

		land = populate(10, 10);
		print(land);
		processNPrint(land, 10);
	}
}


open System

let cube x = x ** 3.0
let croot x = x ** (1.0/3.0)

let funclist = [Math.Sin; Math.Cos; cube]
let funclisti = [Math.Asin; Math.Acos; croot]
let composed = List.map2 (<<) funclist funclisti

let main() = for f in composed do printfn "%f" (f 0.5)

main()


USING: assocs combinators kernel math.functions prettyprint sequences ;
IN: rosettacode.first-class-functions

CONSTANT: A { [ sin ] [ cos ] [ 3 ^ ] }
CONSTANT: B { [ asin ] [ acos ] [ 1/3 ^ ] }

: compose-all ( seq1 seq2 -- seq ) [ compose ] 2map ;

: test-fcf ( -- )
    0.5 A B compose-all
    [ call( x -- y ) ] with map . ;


class FirstClassFns
{
  static |Obj -> Obj| compose (|Obj -> Obj| fn1, |Obj -> Obj| fn2)
  {
    return |Obj x -> Obj| { fn2 (fn1 (x)) }
  }

  public static Void main ()
  {
    cube := |Float a -> Float| { a * a * a }
    cbrt := |Float a -> Float| { a.pow(1/3f) }

    |Float->Float|[] fns := [Float#sin.func, Float#cos.func, cube]
    |Float->Float|[] inv := [Float#asin.func, Float#acos.func, cbrt]
    |Float->Float|[] composed := fns.map |fn, i| { compose(fn, inv[i]) }

    composed.each |fn| { echo (fn(0.5f)) }
  }
}


for(int number = 1; number <= 100; ++number) {
    if (number % 15 == 0) {
        write("FizzBuzz");
    } else {
      if (number % 3 == 0) {
        write("Fizz");
    } else {
        if (number % 5 == 0) {
        write("Buzz");
    } else {
        write(number);
           }
        }
    }
}


"use strict"

const _ = require('lodash');

const WIDTH_ARGUMENT_POSITION  = 2;
const HEIGHT_ARGUMENT_POSITION = 3;
const TREE_PROBABILITY         = 0.5;
const NEW_TREE_PROBABILITY     = 0.01;
const BURN_PROBABILITY         = 0.0001;
const CONSOLE_RED              = '\x1b[31m';
const CONSOLE_GREEN            = '\x1b[32m';
const CONSOLE_COLOR_CLOSE      = '\x1b[91m';
const CONSOLE_CLEAR            = '\u001B[2J\u001B[0;0f';
const NEIGHBOURS               = [
    [-1, -1],
    [-1,  0],
    [-1,  1],
    [ 0, -1],
    [ 0,  1],
    [ 1, -1],
    [ 1,  0],
    [ 1,  1]
];
const PRINT_DECODE             = {
    ' ': ' ',
    'T': `${CONSOLE_GREEN}T${CONSOLE_COLOR_CLOSE}`,
    'B': `${CONSOLE_RED}T${CONSOLE_COLOR_CLOSE}`,
};
const CONDITIONS = {
    'T': (forest, y, x) => Math.random() < BURN_PROBABILITY || burningNeighbour(forest, y, x) ? 'B' : 'T',
    ' ':  () => Math.random() < NEW_TREE_PROBABILITY ? 'T' : ' ',
    'B':  () => ' '
};

const WIDTH  = process.argv[WIDTH_ARGUMENT_POSITION]  || 20;
const HEIGHT = process.argv[HEIGHT_ARGUMENT_POSITION] || 10;

const update = forest => {
    return _.map(forest, (c, ci) => {
        return _.map(c, (r, ri) => {
            return CONDITIONS[r](forest, ci, ri);
        });
    });
}

const printForest = forest => {
    process.stdout.write(CONSOLE_CLEAR);
    _.each(forest, c => {
        _.each(c, r => {
            process.stdout.write(PRINT_DECODE[r]);
        });
        process.stdout.write('\n');
    })
}

const burningNeighbour = (forest, y, x) => {
    return _(NEIGHBOURS)
           .map(n => _.isUndefined(forest[y + n[0]]) ? null : forest[y + n[0]][x + n[1]])
           .any(_.partial(_.isEqual, 'B'));
};

let forest = _.times(HEIGHT, () => _.times(WIDTH, () => Math.random() < TREE_PROBABILITY ? 'T' : ' '));

setInterval(() => {
    forest = update(forest);
    printForest(forest)
}, 20);


: compose ( xt1 xt2 -- xt3 )
  >r >r :noname
     r> compile,
     r> compile,
     postpone ;
;

: cube  fdup fdup f* f* ;
: cuberoot  1e 3e f/ f** ;

: table  create does> swap cells + @ ;

table fn      ' fsin ,  ' fcos ,  ' cube ,
table inverse ' fasin , ' facos , ' cuberoot ,

: main
  3 0 do
    i fn i inverse compose  ( xt )
    0.5e execute f.
  loop ;

main    \ 0.5 0.5 0.5


' FB 1.05.0 Win64

#Include "crt/math.bi"  '' include math functions in C runtime library

' Declare function pointer type
' This implicitly assumes default StdCall calling convention on Windows
Type Class2Func As Function(As Double) As Double

' A couple of functions with the above prototype
Function functionA(v As Double) As Double
  Return v*v*v  '' cube of v
End Function

Function functionB(v As Double) As Double
  Return Exp(Log(v)/3)  '' same as cube root of v which would normally be v ^ (1.0/3.0) in FB
End Function

' A function taking a function as an argument
Function function1(f2 As Class2Func, val_ As Double) As Double
  Return f2(val_)
End Function

' A function returning a function
Function whichFunc(idx As Long) As Class2Func
   Return IIf(idx < 4, @functionA, @functionB)
End Function

' Additional function needed to treat CDecl function pointer as StdCall
' Get compiler warning otherwise
Function cl2(f As Function CDecl(As Double) As Double) As Class2Func
  Return CPtr(Class2Func, f)
End Function

' A list of functions
' Using C Runtime library versions of trig functions as it doesn't appear
' to be possible to apply address operator (@) to FB's built-in versions
Dim funcListA(0 To 3) As Class2Func = {@functionA, cl2(@sin_),  cl2(@cos_), cl2(@tan_)}
Dim funcListB(0 To 3) As Class2Func = {@functionB, cl2(@asin_), cl2(@acos_), cl2(@atan_)}

' Composing Functions
Function invokeComposed(f1 As Class2Func, f2 As Class2Func, val_ As double) As Double
   Return f1(f2(val_))
End Function

Type Composition
  As Class2Func f1, f2
End Type

Function compose(f1 As Class2Func, f2 As Class2Func) As Composition Ptr
  Dim comp As Composition Ptr = Allocate(SizeOf(Composition))
  comp->f1 = f1
  comp->f2 = f2
  Return comp
End Function

Function callComposed(comp As Composition Ptr, val_ As Double ) As Double
  Return comp->f1(comp->f2(val_))
End Function

Dim ix As Integer
Dim c As Composition Ptr

Print "function1(functionA, 3.0) = "; CSng(function1(whichFunc(0), 3.0))
Print
For ix = 0 To 3
  c = compose(funcListA(ix), funcListB(ix))
  Print "Composition"; ix; "(0.9) = "; CSng(callComposed(c, 0.9))
Next

Deallocate(c)
Print
Print "Press any key to quit"
Sleep


#lang racket/base
(require math/private/statistics/quickselect)

;; racket's quantile uses "Method 1" of https://en.wikipedia.org/wiki/Quartile
;; Tukey (fivenum) uses "Method 2", so we will need a specialist median
(define (fivenum! data-v)
  (define (tukey-median start end)
    (define-values (n/2 parity) (quotient/remainder (- end start) 2))
    (define mid (+ start n/2))
    (if (zero? parity)
        (/ (+ (data-kth-value! (+ mid (sub1 parity))) (data-kth-value! mid)) 2)
        (data-kth-value! mid)))

  (define n-data (let ((l (vector-length data-v)))
                   (if (zero? l)
                       (raise-argument-error 'data-v "nonempty (Vectorof Real)" data-v)
                       l)))

  (define (data-kth-value! n) (kth-value! data-v n <))

  (define subset-size (let-values (((n/2 parity) (quotient/remainder n-data 2))) (+ n/2 parity)))

  (vector (data-kth-value! 0)
          (tukey-median 0 subset-size)
          (tukey-median 0 n-data)
          (tukey-median (- n-data subset-size) n-data)
          (data-kth-value! (sub1 n-data))))

(define (fivenum data-seq)
  (fivenum! (if (and (vector? data-seq) (not (immutable? data-seq)))
                data-seq
                (for/vector ((datum data-seq)) datum))))

(module+ test
  (require rackunit
           racket/vector)
  (check-equal? #(14 14 14 14 14) (fivenum #(14)) "Minimal case")
  (check-equal? #(8 11 14 17 20) (fivenum #(8 14 20)) "3-value case")
  (check-equal? #(8 11 15 18 20) (fivenum #(8 14 16 20)) "4-value case")

  (define x1-seq #(36 40 7 39 41 15))
  (define x1-v (vector-copy x1-seq))
  (check-equal? x1-seq x1-v "before fivenum! sequence and vector were not `equal?`")
  (check-equal? #(7 15 #e37.5 40 41) (fivenum! x1-v) "Test against Go results x1")
  (check-not-equal? x1-seq x1-v "fivenum! did not mutate mutable input vectors")

  (check-equal? #(6 #e25.5 40 #e42.5 49) (fivenum #(15 6 42 41 7 36 49 40 39 47 43)) "Test against Go results x2")

  (check-equal? #(-1.95059594 -0.676741205 0.23324706 0.746070945 1.73131507)
                (fivenum (vector 0.14082834  0.09748790  1.73131507  0.87636009 -1.95059594  0.73438555
                                 -0.03035726  1.46675970 -0.74621349 -0.72588772  0.63905160  0.61501527
                                 -0.98983780 -1.00447874 -0.62759469  0.66206163  1.04312009 -0.10305385
                                 0.75775634  0.32566578))
                "Test against Go results x3"))


using Printf

@enum State empty tree fire

function evolution(nepoch::Int=100, init::Matrix{State}=fill(tree, 30, 50))
    # Single evolution
    function evolve!(forest::Matrix{State}; f::Float64=0.12, p::Float64=0.5)
        dir = [-1 -1; -1 0; -1 1; 0 -1; 0 1; 1 -1; 1 0; 1 1]
        # A tree will burn if at least one neighbor is burning
        for i in 1:size(forest, 1), j in 1:size(forest, 2)
            for k in 1:size(dir, 1)
                if checkbounds(Bool, forest, i + dir[k, 1], j + dir[k, 2]) &&
                    get(forest, i + dir[k, 1], j + dir[k, 2]) == fire
                    forest[i, j] = fire
                    break
                end
            end
        end
        for i in LinearIndices(forest)
            # A burning cell turns into an empty cell
            if forest[i] == fire forest[i] = empty end
            # A tree ignites with probability f even if no neighbor is burning
            if forest[i] == tree && rand() < f forest[i] = fire end
            # An empty space fills with a tree with probability p
            if forest[i] == empty && rand() < p forest[i] = tree end
        end
    end

    # Print functions
    function printforest(f::Matrix{State})
        for i in 1:size(f, 1)
            for j in 1:size(f, 2)
                print(f[i, j] == empty ? ' ' : f[i, j] == tree ? '🌲' : '🔥')
            end
            println()
        end
    end
    function printstats(f::Matrix{State})
        tot = length(f)
        nt  = count(x -> x in (tree, fire), f)
        nb  = count(x -> x == fire, f)
        @printf("\n%6i cell(s), %6i tree(s), %6i currently burning (%6.2f%%, %6.2f%%)\n",
                tot, nt, nb, nt / tot * 100, nb / nt * 100)
    end

    # Main
    printforest(init)
    printstats(init)
    for i in 1:nepoch
        # println("\33[2J")
        evolve!(init)
        # printforest(init)
        # printstats(init)
        # sleep(1)
    end
    printforest(init)
    printstats(init)
end

evolution()


-- ForestFire automaton implementation
-- Rules: at each step:
-- 1) a burning tree disappears
-- 2) a non-burning tree starts burning if any of its neighbours is
-- 3) an empty spot may generate a tree with prob P
-- 4) a non-burning tree may ignite with prob F

local socket = require 'socket' -- needed for socket.sleep
local curses = require 'curses'

local p_spawn, p_ignite = 0.005, 0.0002
local naptime = 0.03 -- seconds
local forest_x, forest_y = 60, 30

local forest = (function (x, y)
	local wrl = {}
	for i = 1, y do
		wrl[i] = {}
		for j = 1, x do
			local rand = math.random()
			wrl[i][j] = (rand < 0.5) and 1 or 0
		end
	end
	return wrl
end)(forest_x, forest_y)

math.randomseed(os.time())

forest.step = function (self)
	for i = 1, #self do
		for j = 1, #self[i] do
			if self[i][j] == 0 then
				if math.random() < p_spawn then self[i][j] = 1 end
			elseif self[i][j] == 1 then
				if self:ignite(i, j) or math.random() < p_ignite then self[i][j] = 2 end
			elseif self[i][j] == 2 then self[i][j] = 0
			else error("Error: forest[" .. i .. "][" .. j .. "] is " .. self[i][j] .. "!")
			end
		end
	end
end

forest.draw = function (self)
	for i = 1, #self do
		for j = 1, #self[i] do
			if self[i][j] == 0 then win:mvaddch(i,j," ")
			elseif self[i][j] == 1 then
				win:attron(curses.color_pair(1))
				win:mvaddch(i,j,"Y")
				win:attroff(curses.color_pair(1))
			elseif self[i][j] == 2 then
				win:attron(curses.color_pair(2))
				win:mvaddch(i,j,"#")
				win:attroff(curses.color_pair(2))
			else error("self[" .. i .. "][" .. j .. "] is " .. self[i][j] .. "!")
			end
		end
	end
end

forest.ignite = function (self, i, j)
	for k = i - 1, i + 1 do
		if k < 1 or k > #self then goto continue1 end
		for l = j - 1, j + 1 do
			if 	l < 1 or
				l > #self[i] or
				math.abs((k - i) + (l - j)) ~= 1
			then
				goto continue2
			end
			if self[k][l] == 2 then return true end
			::continue2::
		end
		::continue1::
	end
	return false
end

local it = 1
curses.initscr()
curses.start_color()
curses.echo(false)
curses.init_pair(1, curses.COLOR_GREEN, curses.COLOR_BLACK)
curses.init_pair(2, curses.COLOR_RED, curses.COLOR_BLACK)
win = curses.newwin(forest_y + 2, forest_x, 0, 0)
win:clear()
win:mvaddstr(forest_y + 1, 0, "p_spawn = " .. p_spawn .. ", p_ignite = " .. p_ignite)
repeat
	forest:draw()
	win:move(forest_y, 0)
	win:clrtoeol()
	win:addstr("Iteration: " .. it .. ", nap = " .. naptime*1000 .. "ms")
	win:refresh()
	forest:step()
	it = it + 1
	socket.sleep(naptime)
until false


# Function composition
Composition := function(f, g)
  local h;
  h := function(x)
    return f(g(x));
  end;
  return h;
end;

# Apply each function in list u, to argument x
ApplyList := function(u, x)
  local i, n, v;
  n := Size(u);
  v := [ ];
  for i in [1 .. n] do
    v[i] := u[i](x);
  od;
  return v;
end;

# Inverse and Sqrt are in the built-in library. Note that Sqrt yields values in cyclotomic fields.
# For example,
#    gap> Sqrt(7);
#    E(28)^3-E(28)^11-E(28)^15+E(28)^19-E(28)^23+E(28)^27
# where E(n) is a primitive n-th root of unity
a := [ i -> i + 1, Inverse, Sqrt ];
# [ function( i ) ... end, <Operation "InverseImmutable">, <Operation "Sqrt"> ]
b := [ i -> i - 1, Inverse, x -> x*x ];
# [ function( i ) ... end, <Operation "InverseImmutable">, function( x ) ... end ]

# Compose each couple
z := ListN(a, b, Composition);

# Now a test
ApplyList(z, 3);
[ 3, 3, 3 ]


package main

import "math"
import "fmt"

// user-defined function, per task.  Other math functions used are built-in.
func cube(x float64) float64 { return math.Pow(x, 3) }

// ffType and compose function taken from Function composition task
type ffType func(float64) float64

func compose(f, g ffType) ffType {
    return func(x float64) float64 {
        return f(g(x))
    }
}

func main() {
    // collection A
    funclist := []ffType{math.Sin, math.Cos, cube}
    // collection B
    funclisti := []ffType{math.Asin, math.Acos, math.Cbrt}
    for i := 0; i < 3; i++ {
        // apply composition and show result
        fmt.Println(compose(funclisti[i], funclist[i])(.5))
    }
}


program fivenum(X)
rename X^ x
order x 1
dup
project x min, x median, x max, x count
set q1 = x_count / 4
set q1min = floor(q1)
set q1weight = q1 - q1min
set q3 = x_count * 3 / 4
set q3min = floor(q3)
set q3weight = q3 - q3min
swap
dup
select rownumber = q1min + 1 or rownumber = q1min + 2
extend w = q1weight * (rownumber - 1) - (rownumber-1-1) * (1-q1weight)
extend xw = x * w
project xw sum
rename xw_sum x_quarter1
swap
select rownumber = q3min + 1 or rownumber = q3min + 2
extend w = q3weight * (rownumber - 1) - (rownumber-1-1) * (1-q3weight)
extend xw = x * w
project xw sum
rename xw_sum x_quarter3
join cross
join cross
project x_min, x_quarter1, x_median, x_quarter3, x_max
print
end program

relation a
insert 3
insert 4
insert 18
insert 12
insert 17
insert 5
insert 6
insert 11
insert 8
run fivenum("a")


/*REXX program computes the five─number summary  (LO─value, p25, medium, p75, HI─value).*/
parse arg x
if x=''  then x= 15 6 42 41 7 36 49 40 39 47 43  /*Not specified?  Then use the defaults*/
say 'input numbers: '     space(x)               /*display the original list of numbers.*/
call 5num                                        /*invoke the  five─number  function.   */
say ' five─numbers: '     result                 /*display "     "     "    results.    */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bSort: procedure expose @.;  parse arg n;  m=n-1 /*N:  the number of  @  array elements.*/
         do m=m  for m  by -1  until ok;   ok= 1 /*keep sorting the  @  array 'til done.*/
           do j=1  for m;      k= j + 1;         /*set  K  to the next item in  @ array.*/
           if @.j<[email protected].k  then iterate             /*Is  @.J  in numerical order?   Good. */
           parse value @.j @.k 0 with @.k @.j ok /*swap two elements and  flag as ¬done.*/
           end   /*j*/
         end     /*m*/;          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
med:   arg s,e;  $=e-s+1;  m=s+$%2;  if $//2  then return @.m;  _=m-1;  return (@.[email protected].m)/2
/*──────────────────────────────────────────────────────────────────────────────────────*/
5num:  #= words(x);                  if #==0  then return  '***error***  array is empty.'
       parse var x . 1 LO . 1 HI .               /*assume values for LO and HI (for now)*/
       q2= # % 2;                                er= '***error***  element'
                     do j=1  for #;     @.j= word(x, j)
                     if \datatype(@.j, 'N')  then return  er   j   "isn't numeric: "   @.j
                     LO= min(LO, @.j);  HI= max(HI, @.j)
                     end   /*j*/                 /* [↑] traipse thru array, find min,max*/
       call bSort #                              /*use a bubble sort (easiest to code). */
       if #//2  then p25= q2                     /*calculate the second quartile number.*/
                else p25= q2 - 1                 /*    "      "     "       "       "   */
       return LO  med(1, p25)   med(1, #)   med(q2, #)   HI  /*return list of 5 numbers.*/


evolve[nbhd_List, k_] := 0 /; nbhd[[2, 2]] == 2    (*burning->empty*)
evolve[nbhd_List, k_] := 2 /; nbhd[[2, 2]] == 1 && [email protected] == 2     (*near_burning&nonempty->burning*)
evolve[nbhd_List, k_] := RandomChoice[{f, 1 - f} -> {2, nbhd[[2, 2]]}] /; nbhd[[2, 2]] == 1 && [email protected] < 2   (*spontaneously combusting tree*)
evolve[nbhd_List, k_] := RandomChoice[{p, 1 - p} -> {1, nbhd[[2, 2]]}] /; nbhd[[2, 2]] == 0  (*random tree growth*)

r = 100; c = 100; p = 10^-2; f = 10^-4;
init = RandomInteger[BernoulliDistribution[0.05], {r, c}];
MatrixPlot[CellularAutomaton[{evolve, {}, {1, 1}}, {init, 0}, {{{300}}}], ColorRules -> {0 -> White, 1 -> Green, 2 -> Red}, Frame -> False]


function forest_fire(f,p,N,M)
% Forest fire
if nargin<4;
	M=200;
end
if nargin<3;
	N=200;
end
if nargin<2;
	p=.03;
end
if nargin<1;
	f=p*.0001;
end

% initialize;
F = (rand(M,N) < p)+1;  % tree with probability p
S = ones(3); S(2,2)=0;  % surrounding

textmap = ' T#';
colormap([.5,.5,.5;0,1,0;1,0,0]);
while(1)
	image(F); pause(.1)    % uncomment for graphical output
	% disp(textmap(F));	pause;		  % uncomment for textual output
	G = ((F==1).*((rand(M,N)<p)+1));  % grow tree
	G = G + (F==2) .* ((filter2(S,F==3)>0) + (rand(M,N)<f) + 2);  % burn tree if neighbor is burning or by chance f
	G = G + (F==3);						 % empty after burn
	F = G;
end;


def compose = { f, g -> { x -> f(g(x)) } }


cube :: Floating a => a -> a
cube x = x ** 3.0

croot :: Floating a => a -> a
croot x = x ** (1/3)

-- compose already exists in Haskell as the `.` operator
-- compose :: (a -> b) -> (b -> c) -> a -> c
-- compose f g = \x -> g (f x)

funclist :: Floating a => [a -> a]
funclist = [sin,  cos,  cube ]

invlist :: Floating a => [a -> a]
invlist  = [asin, acos, croot]

main :: IO ()
main = print $ zipWith (\f i -> f . i $ 0.5) funclist invlist


link compose
procedure main(arglist)

    fun := [sin,cos,cube]
    inv := [asin,acos,cuberoot]
    x := 0.5
    every i := 1 to *inv do
       write("f(",x,") := ", compose(inv[i],fun[i])(x))
end

procedure cube(x)
return x*x*x
end

procedure cuberoot(x)
return x ^ (1./3)
end


#include "share/atspre_staload.hats"

implement main0() = loop(1, 100) where {
  fun loop(from: int, to: int): void =
    if from > to then () else
    let
      val by3 = (from % 3 = 0)
      val by5 = (from % 5 = 0)
    in
      case+ (by3, by5) of
      | (true, true) => print_string("FizzBuzz")
      | (true, false) => print_string("Fizz")
      | (false, true) => print_string("Buzz")
      | (false, false) => print_int(from);
      print_newline();
      loop(from+1, to)
    end
}


import random, os, sequtils, strutils

randomize()

type State {.pure.} = enum Empty, Tree, Fire

const
  Disp: array[State, string] = ["  ", "\e[32m/\\\e[m", "\e[07;31m/\\\e[m"]
  TreeProb = 0.01
  BurnProb = 0.001

proc chance(prob: float): bool {.inline.} = rand(1.0) < prob

# Set the size
var w, h: int
if paramCount() >= 2:
  w = paramStr(1).parseInt
  h = paramStr(2).parseInt
if w <= 0: w = 30
if h <= 0: h = 30

iterator fields(a = (0, 0), b = (h-1, w-1)): tuple[y, x: int] =
  ## Iterate over fields in the universe
  for y in max(a[0], 0) .. min(b[0], h-1):
    for x in max(a[1], 0) .. min(b[1], w-1):
      yield (y, x)

# Initialize
var univ, univNew = newSeqWith(h, newSeq[State](w))

while true:

  # Show.
  stdout.write "\e[H"
  for y, x in fields():
    stdout.write Disp[univ[y][x]]
    if x == 0: stdout.write "\e[E"
  stdout.flushFile

  # Evolve.
  for y, x in fields():
    case univ[y][x]
    of Fire:
      univNew[y][x] = Empty
    of Empty:
      if chance(TreeProb): univNew[y][x] = Tree
    of Tree:
      for y1, x1 in fields((y-1, x-1), (y+1, x+1)):
        if univ[y1][x1] == Fire:
          univNew[y][x] = Fire
          break
      if chance(BurnProb): univNew[y][x] = Fire
  univ = univNew
  sleep 200


open Curses

let ignite_prob = 0.02
let sprout_prob = 0.01

type cell = Empty | Burning | Tree

let get w x y =
  try w.(x).(y)
  with Invalid_argument _ -> Empty

let neighborhood_burning w x y =
  try
    for _x = pred x to succ x do
      for _y = pred y to succ y do
        if get w _x _y = Burning then raise Exit
      done
    done
    ; false
  with Exit -> true

let evolves w x y =
  match w.(x).(y) with
  | Burning -> Empty
  | Tree ->
      if neighborhood_burning w x y
      then Burning
      else begin
        if (Random.float 1.0) < ignite_prob
        then Burning
        else Tree
      end
  | Empty ->
      if (Random.float 1.0) < sprout_prob
      then Tree
      else Empty

let step width height w =
  for x = 0 to pred width do
    for y = 0 to pred height do
      w.(x).(y) <- evolves w x y
    done
  done

let i = int_of_char
let repr = function
  | Empty -> i ' ' | Burning -> i '#' | Tree -> i 't'

let draw width height w =
  for x = 0 to pred width do
    for y = 0 to pred height do
      ignore(move y x);
      ignore(delch ());
      ignore(insch (repr w.(x).(y)));
    done;
  done;
  ignore(refresh ())

let () =
  Random.self_init ();
  let wnd = initscr () in
  ignore(cbreak ());
  ignore(noecho ());
  let height, width = getmaxyx wnd in
  let w = Array.make_matrix width height Empty in
  clear ();
  ignore(refresh ());
  while true do
    draw width height w;
    step width height w;
    Unix.sleep 1;
  done;
  endwin()


   sin=:  1&o.
   cos=:  2&o.
  cube=: ^&3
square=: *:
  unqo=: `:6
  unqcol=: `:0
  quot=: 1 :'{.u`'''''
  A=: sin`cos`cube`square
  B=: monad def'y unqo inv quot'"0 A
  BA=. A dyad def'x [email protected](y unqo) quot'"0 B


import java.util.ArrayList;

public class FirstClass{

	public interface Function<A,B>{
		B apply(A x);
	}

	public static <A,B,C> Function<A, C> compose(
			final Function<B, C> f, final Function<A, B> g) {
		return new Function<A, C>() {
			@Override public C apply(A x) {
				return f.apply(g.apply(x));
			}
		};
	}

	public static void main(String[] args){
		ArrayList<Function<Double, Double>> functions =
			new ArrayList<Function<Double,Double>>();

		functions.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return Math.cos(x);
					}
				});
		functions.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return Math.tan(x);
					}
				});
		functions.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return x * x;
					}
				});

		ArrayList<Function<Double, Double>> inverse = new ArrayList<Function<Double,Double>>();

		inverse.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return Math.acos(x);
					}
				});
		inverse.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return Math.atan(x);
					}
				});
		inverse.add(
				new Function<Double, Double>(){
					@Override public Double apply(Double x){
						return Math.sqrt(x);
					}
				});
		System.out.println("Compositions:");
		for(int i = 0; i < functions.size(); i++){
			System.out.println(compose(functions.get(i), inverse.get(i)).apply(0.5));
		}
		System.out.println("Hard-coded compositions:");
		System.out.println(Math.cos(Math.acos(0.5)));
		System.out.println(Math.tan(Math.atan(0.5)));
		System.out.println(Math.pow(Math.sqrt(0.5), 2));
	}
}


#[derive(Debug)]
struct FiveNum {
    minimum: f64,
    lower_quartile: f64,
    median: f64,
    upper_quartile: f64,
    maximum: f64,
}

fn median(samples: &[f64]) -> f64 {
    // input is already sorted
    let n = samples.len();
    let m = n / 2;
    if n % 2 == 0 {
        (samples[m] + samples[m - 1]) / 2.0
    } else {
        samples[m]
    }
}

fn fivenum(samples: &[f64]) -> FiveNum {
    let mut xs = samples.to_vec();
    xs.sort_by(|x, y| x.partial_cmp(y).unwrap());

    let m = xs.len() / 2;

    FiveNum {
        minimum: xs[0],
        lower_quartile: median(&xs[0..(m + (xs.len() % 2))]),
        median: median(&xs),
        upper_quartile: median(&xs[m..]),
        maximum: xs[xs.len() - 1],
    }
}
fn main() {
    let inputs = vec![
        vec![15., 6., 42., 41., 7., 36., 49., 40., 39., 47., 43.],
        vec![36., 40., 7., 39., 41., 15.],
        vec![
            0.14082834,
            0.09748790,
            1.73131507,
            0.87636009,
            -1.95059594,
            0.73438555,
            -0.03035726,
            1.46675970,
            -0.74621349,
            -0.72588772,
            0.63905160,
            0.61501527,
            -0.98983780,
            -1.00447874,
            -0.62759469,
            0.66206163,
            1.04312009,
            -0.10305385,
            0.75775634,
            0.32566578,
        ],
    ];

    for input in inputs {
        let result = fivenum(&input);
        println!("Fivenum",);
        println!("  Minumum: {}", result.minimum);
        println!("  Lower quartile: {}", result.lower_quartile);
        println!("  Median: {}", result.median);
        println!("  Upper quartile: {}", result.upper_quartile);
        println!("  Maximum: {}", result.maximum);
    }
}


/* build a dataset */
data test;
do i=1 to 10000;
	x=rannor(12345);
	output;
end;
keep x;
run;

/* compute the five numbers */
proc means data=test min p25 median p75 max;
var x;
run;


import java.util

object Fivenum extends App {

  val xl = Array(
    Array(15.0, 6.0, 42.0, 41.0, 7.0, 36.0, 49.0, 40.0, 39.0, 47.0, 43.0),
    Array(36.0, 40.0, 7.0, 39.0, 41.0, 15.0),
    Array(0.14082834, 0.09748790, 1.73131507, 0.87636009, -1.95059594, 0.73438555,
      -0.03035726, 1.46675970, -0.74621349, -0.72588772, 0.63905160, 0.61501527, -0.98983780,
      -1.00447874, -0.62759469, 0.66206163, 1.04312009, -0.10305385, 0.75775634, 0.32566578)
  )

  for (x <- xl) println(f"${util.Arrays.toString(fivenum(x))}%s\n\n")

  def fivenum(x: Array[Double]): Array[Double] = {
    require(x.forall(!_.isNaN), "Unable to deal with arrays containing NaN")

    def median(x: Array[Double], start: Int, endInclusive: Int): Double = {
      val size = endInclusive - start + 1
      require(size > 0, "Array slice cannot be empty")
      val m = start + size / 2
      if (size % 2 == 1) x(m) else (x(m - 1) + x(m)) / 2.0
    }

    val result = new Array[Double](5)
    util.Arrays.sort(x)
    result(0) = x(0)
    result(2) = median(x, 0, x.length - 1)
    result(4) = x(x.length - 1)
    val m = x.length / 2
    val lowerEnd = if (x.length % 2 == 1) m else m - 1
    result(1) = median(x, 0, lowerEnd)
    result(3) = median(x, m, x.length - 1)
    result
  }

}


Loop, 100
{
  If (Mod(A_Index, 15) = 0)
    output .= "FizzBuzz`n"
  Else If (Mod(A_Index, 3) = 0)
    output .= "Fizz`n"
  Else If (Mod(A_Index, 5) = 0)
    output .= "Buzz`n"
  Else
    output .= A_Index "`n"
}
FileDelete, output.txt
FileAppend, %output%, output.txt
Run, cmd /k type output.txt


(import (lib gl))
(import (otus random!))

(define WIDTH 170)
(define HEIGHT 96)

; probabilities
(define p 20)
(define f 1000)

(gl:set-window-title "Drossel and Schwabl 'forest-fire'")
(import (OpenGL version-1-0))

   (glShadeModel GL_SMOOTH)
   (glClearColor 0.11 0.11 0.11 1)
   (glOrtho 0 WIDTH 0 HEIGHT 0 1)

(gl:set-userdata (make-vector (map (lambda (-) (make-vector (map (lambda (-) (rand! 2)) (iota WIDTH)))) (iota HEIGHT))))

(gl:set-renderer (lambda (mouse)
   (let ((forest (gl:get-userdata))
         (step (make-vector (map (lambda (-) (make-vector (repeat 0 WIDTH))) (iota HEIGHT)))))
      (glClear GL_COLOR_BUFFER_BIT)

      (glPointSize (/ 854 WIDTH))
      (glBegin GL_POINTS)
         (for-each (lambda (y)
               (for-each (lambda (x)
                     (case (ref (ref forest y) x)
                        (0 ; An empty space fills with a tree with probability "p"
                           (if (zero? (rand! p))
                              (set-ref! (ref step y) x 1)))
                        (1
                           (glColor3f 0.2 0.7 0.2)
                           (glVertex2f x y)
                           ; A tree will burn if at least one neighbor is burning
                           ; A tree ignites with probability "f" even if no neighbor is burning
                           (if (or (eq? (ref (ref forest (- y 1)) (- x 1)) 2)  (eq? (ref (ref forest (- y 1))    x)    2)  (eq? (ref (ref forest (- y 1)) (+ x 1)) 2)
                                   (eq? (ref (ref forest    y   ) (- x 1)) 2)                                              (eq? (ref (ref forest    y   ) (+ x 1)) 2)
                                   (eq? (ref (ref forest (+ y 1)) (- x 1)) 2)  (eq? (ref (ref forest (+ y 1))    x)    2)  (eq? (ref (ref forest (+ y 1)) (+ x 1)) 2)
                                   (zero? (rand! f)))
                              (set-ref! (ref step y) x 2)
                              (set-ref! (ref step y) x 1)))
                        (2
                           (glColor3f 0.7 0.7 0.1)
                           (glVertex2f x y))
                           ; A burning cell turns into an empty cell
                           (set-ref! (ref step y) x 0)))
                  (iota WIDTH)))
            (iota HEIGHT))
      (glEnd)
      (gl:set-userdata step))))


// Functions as values of a variable
var cube = function (x) {
  return Math.pow(x, 3);
};
var cuberoot = function (x) {
  return Math.pow(x, 1 / 3);
};

// Higher order function
var compose = function (f, g) {
  return function (x) {
    return f(g(x));
  };
};

// Storing functions in a array
var fun = [Math.sin, Math.cos, cube];
var inv = [Math.asin, Math.acos, cuberoot];

for (var i = 0; i < 3; i++) {
  // Applying the composition to 0.5
  console.log(compose(inv[i], fun[i])(0.5));
}


#!/usr/bin/julia

function compose(f::Function, g::Function)
  return x -> f(g(x))
end

value = 0.5
for pair in [(sin, asin), (cos, acos), (x -> x^3, x -> x^(1/3))]
  func, inverse = pair
  println(compose(func, inverse)(value))
end


clear
set seed 17760704
qui set obs 10000
gen x=rnormal()


For $i = 1 To 100
	If Mod($i, 15) = 0 Then
		MsgBox(0, "FizzBuzz", "FizzBuzz")
	ElseIf Mod($i, 5) = 0 Then
		MsgBox(0, "FizzBuzz", "Buzz")
	ElseIf Mod($i, 3) = 0 Then
		MsgBox(0, "FizzBuzz", "Fizz")
	Else
		MsgBox(0, "FizzBuzz", $i)
	EndIf
Next


// version 1.0.6

fun compose(f: (Double) -> Double,  g: (Double) -> Double ): (Double) -> Double  = { f(g(it)) }

fun cube(d: Double) = d * d * d

fun main(args: Array<String>) {
    val listA = listOf(Math::sin, Math::cos, ::cube)
    val listB = listOf(Math::asin, Math::acos, Math::cbrt)
    val x = 0.5
    for (i in 0..2) println(compose(listA[i], listB[i])(x))
}


{def cube {lambda {:x} {pow :x 3}}}
{def cuberoot {lambda {:x} {pow :x {/ 1 3}}}}
{def compose {lambda {:f :g :x} {:f {:g :x}}}}
{def fun sin cos cube}
{def inv asin acos cuberoot}
{def display {lambda {:i}
  {br}{compose {nth :i {fun}}
               {nth :i {inv}} 0.5}}}
{map display {serie 0 2}}

Output:
0.5
0.49999999999999994
0.5000000000000001


Option Base 1
Private Function median(tbl As Variant, lo As Integer, hi As Integer)
    Dim l As Integer: l = hi - lo + 1
    Dim m As Integer: m = lo + WorksheetFunction.Floor_Precise(l / 2)
    If l Mod 2 = 1 Then
        median = tbl(m)
    Else
        median = (tbl(m - 1) + tbl(m)) / 2
    End if
End Function
Private Function fivenum(tbl As Variant) As Variant
    Sort tbl, UBound(tbl)
    Dim l As Integer: l = UBound(tbl)
    Dim m As Integer: m = WorksheetFunction.Floor_Precise(l / 2) + l Mod 2
    Dim r(5) As String
    r(1) = CStr(tbl(1))
    r(2) = CStr(median(tbl, 1, m))
    r(3) = CStr(median(tbl, 1, l))
    r(4) = CStr(median(tbl, m + 1, l))
    r(5) = CStr(tbl(l))
    fivenum = r
End Function
Public Sub main()
    Dim x1 As Variant, x2 As Variant, x3 As Variant
    x1 = [{15, 6, 42, 41, 7, 36, 49, 40, 39, 47, 43}]
    x2 = [{36, 40, 7, 39, 41, 15}]
    x3 = [{0.14082834, 0.09748790, 1.73131507, 0.87636009, -1.95059594, 0.73438555, -0.03035726, 1.46675970, -0.74621349, -0.72588772, 0.63905160, 0.61501527, -0.98983780, -1.00447874, -0.62759469, 0.66206163, 1.04312009, -0.10305385, 0.75775634, 0.32566578}]
    Debug.Print Join(fivenum(x1), " | ")
    Debug.Print Join(fivenum(x2), " | ")
    Debug.Print Join(fivenum(x3), " | ")
End Sub


Imports System.Runtime.CompilerServices
Imports System.Text

Module Module1

    <Extension()>
    Function AsString(Of T)(c As ICollection(Of T), Optional format As String = "{0}") As String
        Dim sb As New StringBuilder("[")
        Dim it = c.GetEnumerator()
        If it.MoveNext() Then
            sb.AppendFormat(format, it.Current)
        End If
        While it.MoveNext()
            sb.Append(", ")
            sb.AppendFormat(format, it.Current)
        End While
        Return sb.Append("]").ToString()
    End Function

    Function Median(x As Double(), start As Integer, endInclusive As Integer) As Double
        Dim size = endInclusive - start + 1
        If size <= 0 Then
            Throw New ArgumentException("Array slice cannot be empty")
        End If
        Dim m = start + size \ 2
        Return If(size Mod 2 = 1, x(m), (x(m - 1) + x(m)) / 2.0)
    End Function

    Function Fivenum(x As Double()) As Double()
        For Each d In x
            If Double.IsNaN(d) Then
                Throw New ArgumentException("Unable to deal with arrays containing NaN")
            End If
        Next

        Array.Sort(x)
        Dim result(4) As Double

        result(0) = x.First()
        result(2) = Median(x, 0, x.Length - 1)
        result(4) = x.Last()

        Dim m = x.Length \ 2
        Dim lowerEnd = If(x.Length Mod 2 = 1, m, m - 1)

        result(1) = Median(x, 0, lowerEnd)
        result(3) = Median(x, m, x.Length - 1)

        Return result
    End Function

    Sub Main()
        Dim x1 = {
            New Double() {15.0, 6.0, 42.0, 41.0, 7.0, 36.0, 49.0, 40.0, 39.0, 47.0, 43.0},
            New Double() {36.0, 40.0, 7.0, 39.0, 41.0, 15.0},
            New Double() {
                     0.14082834, 0.0974879, 1.73131507, 0.87636009, -1.95059594, 0.73438555,
                    -0.03035726, 1.4667597, -0.74621349, -0.72588772, 0.6390516, 0.61501527,
                    -0.9898378, -1.00447874, -0.62759469, 0.66206163, 1.04312009, -0.10305385,
                     0.75775634, 0.32566578
            }
        }
        For Each x In x1
            Dim result = Fivenum(x)
            Console.WriteLine(result.AsString("{0:F8}"))
        Next
    End Sub

End Module


For each i from 1 to 100 do [
    Print:
        if i mod 15 = 0 then ["FizzBuzz"]
        else if i mod 3 = 0 then ["Fizz"]
        else if i mod 5 = 0 then ["Buzz"]
        else [“i”]
        ++ "\n";
];


#!/usr/bin/lasso9

define cube(x::decimal) => {
	return #x -> pow(3.0)
}

define cuberoot(x::decimal) => {
	return #x -> pow(1.0/3.0)
}

define compose(f, g, v) => {
	return {
		return #f -> detach -> invoke(#g -> detach -> invoke(#1))
	} -> detach -> invoke(#v)
}

local(functions = array({return #1 -> sin}, {return #1 -> cos}, {return cube(#1)}))
local(inverse = array({return #1 -> asin}, {return #1 -> acos}, {return cuberoot(#1)}))

loop(3)
	stdoutnl(
		compose(
			#functions -> get(loop_count),
			#inverse -> get(loop_count),
			0.5
		)
	)

/loop


-- sin, cos and sqrt are built-in, square, asin and acos are user-defined
A = [#sin, #cos, #square]
B = [#asin, #acos, #sqrt]

testValue = 0.5

repeat with i = 1 to 3
  -- for implementation details of compose() see https://www.rosettacode.org/wiki/Function_composition#Lingo
  f = compose(A[i], B[i])
  res = call(f, _movie, testValue)
  put res = testValue
end repeat


function compose(f,g) return function(...) return f(g(...)) end end

fn = {math.sin, math.cos, function(x) return x^3 end}
inv = {math.asin, math.acos, function(x) return x^(1/3) end}

for i, v in ipairs(fn) do
  local f = compose(v, inv[i])
  print(f(0.5))
end


For(I,1,100)
!If I^3??I^5
 Disp "FIZZBUZZ",i
Else!If I^3
 Disp "FIZZ",i
Else!If I^5
 Disp "BUZZ",i
Else
 Disp I▶Dec,i
End
.Pause to allow the user to actually read the output
Pause 1000
End


--
-- demo\rosetta\Forest_fire.exw
-- ============================
--
--  A burning cell turns into an empty cell
--  A tree will burn if at least one neighbor is burning
--  A tree ignites with probability F even if no neighbor is burning
--  An empty space fills with a tree with probability P
--
--  Draws bigger "pixels" when it feels the need to.
--
with javascript_semantics
include pGUI.e
Ihandle dlg, canvas, hTimer
cdCanvas cddbuffer, cdcanvas

constant TITLE = "Forest Fire",
         P = 0.03,      -- probability of new tree growing
         F = 0.00003    -- probability of new fire starting

enum EMPTY,TREE,FIRE    -- (1,2,3)
constant colours = {CD_BLACK,CD_GREEN,CD_YELLOW}

sequence f = {}     -- the forest

function randomf()
    return rand(1000000)/1000000    -- returns 0.000001..1.000000
end function

function redraw_cb(Ihandle /*ih*/)
    integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE"),
            -- limit to 40K cells, otherwise it gets too slow.
            -- n here is the cell size in pixels (min of 1x1)
            -- Note you still get some setTimeout violations
            -- in js even with the limit reduced to just 5K..
            n = ceil(sqrt(width*height/40000)),
            w = floor(width/n)+2, -- (see cx below)
            h = floor(height/n)+2

    cdCanvasActivate(cddbuffer)
    if length(f)!=w
    or length(f[1])!=h then
        f = sq_rand(repeat(repeat(2,h),w))  -- (EMPTY or TREE)
    end if
    sequence fn = deep_copy(f)
    --
    -- There is a "dead border" of 1 cell all around the edge of f (& fn) which
    -- we never display or update. If we have got this right/an exact fit, then
    -- w*n should be exactly 2n too wide, whereas in the worst case there is an
    -- (2n-1) pixel border, which we split between left and right, ditto cy.
    --
    integer cx = n+floor((width-w*n)/2)
    for x=2 to w-1 do
        integer cy = n+floor((height-h*n)/2)
        for y=2 to h-1 do
            integer fnxy
            switch f[x,y] do
                case EMPTY:
                    fnxy = EMPTY+(randomf()<P)  -- (EMPTY or TREE)
                case TREE:
                    fnxy = TREE
                    if f[x-1,y-1]=FIRE or f[x,y-1]=FIRE or f[x+1,y-1]=FIRE
                    or f[x-1,y  ]=FIRE or (randomf()<F) or f[x+1,y  ]=FIRE
                    or f[x-1,y+1]=FIRE or f[x,y+1]=FIRE or f[x+1,y+1]=FIRE then
                        fnxy = FIRE
                    end if
                case FIRE:
                    fnxy = EMPTY
            end switch
            fn[x,y] = fnxy
            cdCanvasSetForeground(cddbuffer,colours[fnxy])
            cdCanvasBox(cddbuffer, cx, cx+n-1, cy, cy+n-1)
            cy += n
        end for
        cx += n
    end for
    f = fn
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    return IUP_DEFAULT
end function

function timer_cb(Ihandle /*ih*/)
    IupUpdate(canvas)
    return IUP_IGNORE
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=225x100")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas, `TITLE="%s", MINSIZE=245x140`, {TITLE})
        -- (above MINSIZE prevents the title from getting squished)
    IupShow(dlg)
    hTimer = IupTimer(Icallback("timer_cb"), 100)   -- (10 fps)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


Module CheckFirst {
      RAD = lambda -> number/180*pi
      ASIN = lambda RAD -> {
          Read x : x=Round(x,10)
            If x>=0 and X<1 Then {
                  =RAD(abs(2*Round(ATN(x/(1+SQRT(1-x**2))))))
            } Else.if x==1 Then {
                  =RAD(90)
            } Else error "asin exit limit"
      }
      ACOS=lambda ASIN (x) -> PI/2 - ASIN(x)
      POW3 = Lambda ->number**3
      POW3INV =Lambda ->number**(1/3)
      COSRAD =lambda ->Cos(number*180/pi)
      SINRAD=lambda ->Sin(number*180/pi)
      Composed=lambda (f1, f2) -> {
            =lambda f1, f2 (x)->{
                  =f1(f2(x))
            }
      }
      Dim Base 0, A(3), B(3), C(3)
      A(0)=ACOS, ASIN, POW3INV
      B(0)=COSRAD, SINRAD, POW3
      C(0)=Composed(ACOS, COSRAD), Composed(ASIN, SINRAD), Composed(POW3INV, POW3)
      Print $("0.00")
      For i=0 To 2 {
            Print A(i)(B(i)(.5)), C(i)(.5)
      }
}
CheckFirst


funcs = {Sin, Cos, #^3 &};
funcsi = {ArcSin, ArcCos, #^(1/3) &};
compositefuncs = Composition @@@ Transpose[{funcs, funcsi}];
Table[i[0.666], {i, compositefuncs}]


a: [sin, cos, lambda([x], x^3)]$
b: [asin, acos, lambda([x], x^(1/3))]$
compose(f, g) := buildq([f, g], lambda([x], f(g(x))))$
map(lambda([fun], fun(x)), map(compose, a, b));
[x, x, x]


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
fcn fiveNum(v){ // V is a GSL Vector, --> min, 1st qu, median, 3rd qu, max
   v.sort();
   return(v.min(),v.quantile(0.25),v.median(),v.quantile(0.75),v.max())
}


<?php

define('WIDTH',      10);
define('HEIGHT',     10);

define('GEN_CNT',    10);
define('PAUSE',  250000);

define('TREE_PROB',  50);
define('GROW_PROB',   5);
define('FIRE_PROB',   1);

define('BARE',      ' ');
define('TREE',      'A');
define('BURN',      '/');

$forest = makeNewForest();

for ($i = 0; $i < GEN_CNT; $i++) {
    displayForest($forest, $i);
    $forest = getNextForest($forest);
}

displayForest($forest, 'done');
exit;

function makeNewForest() {
    return mapForest([
        'func' => function(){
            return isProb(TREE_PROB) ? TREE : BARE;
        }
    ]);
}

function displayForest($forest, $generationNum) {
    system("clear");
    echo PHP_EOL . "Generation: $generationNum" . PHP_EOL;
    mapForest(['forest' => $forest, 'func' => function($f, $x, $y){
            echo $f[$y][$x] . ($x == WIDTH - 1 ? PHP_EOL : '');
        }
    ]);
    echo PHP_EOL;
    usleep(PAUSE);
}

function getNextForest($oldForest) {
    return mapForest(['forest' => $oldForest, 'func' => function($f, $x, $y){
            switch ($f[$y][$x]) {
                case BURN:
                    return BARE;
                case BARE:
                    return isProb(GROW_PROB) ? TREE : BARE;
                case TREE:
                    $caughtFire = isProb(FIRE_PROB);
                    $ablaze = $caughtFire ? true : getNumBurningNeighbors($f, $x, $y) > 0;
                return $ablaze ? BURN : TREE;
            }
        }
    ]);
}

function getNumBurningNeighbors($forest, $x, $y) {
    $burningNeighbors = mapForest([
        'forest' => $forest,
        'x1' => $x - 1, 'x2' => $x + 2,
        'y1' => $y - 1, 'y2' => $y + 2,
        'default' => 0,
        'func' => function($f, $x, $y){
            return $f[$y][$x] == BURN ? 1 : 0;
        }
    ]);

    $numOnFire = 0;
    foreach ($burningNeighbors as $row) {
        $numOnFire += array_sum($row);
    }
    return $numOnFire;
}

function mapForest($params) {
    $p = array_merge([
        'forest' => [],
        'func' => function(){echo "default\n";},
        'x1' => 0,
        'x2' => WIDTH,
        'y1' => 0,
        'y2' => HEIGHT,
        'default' => BARE
    ], $params);

    $newForest = [];
    for ($y = $p['y1']; $y < $p['y2']; $y++) {
        $newRow = [];
        for ($x = $p['x1']; $x < $p['x2']; $x++) {
            $inBounds = ($x >= 0 && $x < WIDTH && $y >= 0 && $y < HEIGHT);
            $newRow[] = ($inBounds ? $p['func']($p['forest'], $x, $y) : $p['default']);
        }
        $newForest[] = $newRow;
    }
    return $newForest;
}

function isProb($prob) {
    return rand(0, 100) < $prob;
}


:- module firstclass.

:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module exception, list, math, std_util.

main(!IO) :-
    Forward = [sin,  cos,  (func(X) = ln(X))],
    Reverse = [asin, acos, (func(X) = exp(X))],
    Results = map_corresponding(
        (func(F, R) = compose(R, F, 0.5)),
        Forward, Reverse),
    write_list(Results, ", ", write_float, !IO),
    write_string("\n", !IO).


('sin 'cos (3 pow)) =A
('asin 'acos (1 3 / pow)) =B

(A bool) (
  0.5 A first B first concat -> puts!
  A rest #A
  B rest #B
) while


using System;
using System.Console;
using System.Math;
using Nemerle.Collections.NCollectionsExtensions;

module FirstClassFunc
{
    Main() : void
    {
        def cube = fun (x) {x * x * x};
        def croot = fun (x) {Pow(x, 1.0/3.0)};
        def compose = fun(f, g) {fun (x) {f(g(x))}};
        def funcs = [Sin, Cos, cube];
        def ifuncs = [Asin, Acos, croot];
        WriteLine($[compose(f, g)(0.5) | (f, g) in ZipLazy(funcs, ifuncs)]);
    }
}


> (define (compose f g) (expand (lambda (x) (f (g x))) 'f 'g))
(lambda (f g) (expand (lambda (x) (f (g x))) 'f 'g))
> (define (cube x) (pow x 3))
(lambda (x) (pow x 3))
> (define (cube-root x) (pow x (div 1 3)))
(lambda (x) (pow x (div 1 3)))
> (define functions '(sin  cos  cube))
(sin cos cube)
> (define inverses  '(asin acos cube-root))
(asin acos cube-root)
> (map (fn (f g) ((compose f g) 0.5)) functions inverses)
(0.5 0.5 0.5)


main:
     { { iter 1 + dup

        15 %
            { "FizzBuzz" <<
                zap }
            { dup
            3 %
                { "Fizz" <<
                    zap }
                { dup
                5 %
                    { "Buzz" <<
                        zap}
                    { %d << }
                if }
            if }
        if

        "\n" << }

    100 times }


(load "@lib/simul.l")

(scl 3)

(de forestFire (Dim ProbT ProbP ProbF)
   (let Grid (grid Dim Dim)
      (for Col Grid
         (for This Col
            (=: tree (> ProbT (rand 0 1.0))) ) )
      (loop
         (disp Grid NIL
            '((This)
               (cond
                  ((: burn) "# ")
                  ((: tree) "T ")
                  (T ". ") ) ) )
         (wait 1000)
         (for Col Grid
            (for This Col
               (=: next
                  (cond
                     ((: burn) NIL)
                     ((: tree)
                        (if
                           (or
                              (find  # Neighbor burning?
                                 '((Dir) (get (Dir This) 'burn))
                                 (quote
                                    west east south north
                                    ((X) (south (west X)))
                                    ((X) (north (west X)))
                                    ((X) (south (east X)))
                                    ((X) (north (east X))) ) )
                              (> ProbF (rand 0 1.0)) )
                           'burn
                           'tree ) )
                     (T (and (> ProbP (rand 0 1.0)) 'tree)) ) ) ) )
         (for Col Grid
            (for This Col
               (if (: next)
                  (put This @ T)
                  (=: burn)
                  (=: tree) ) ) ) ) ) )


%!PS-Adobe-3.0
%%BoundingBox: 0 0 400 400

/size 400 def

/rand1 { rand 2147483647 div } def

/m { moveto } bind def
/l { rlineto} bind def
/drawforest {
        0 1 n 1 sub { /y exch def
        0 1 n 1 sub { /x exch def
                forest x get y get dup 0 eq { pop } {
                        1 eq { 0 1 0 } { 1 0 0 } ifelse setrgbcolor
                        x c mul y c mul m
                        c 0 l 0 c l c neg 0 l closepath fill
                } ifelse
        } for
        } for
} def

/r1n { dup 0 ge exch n lt and } def

/neighbors { /y exch def /x exch def /cnt 0 def
        [
        y 1 sub 1 y 1 add { /y1 exch def
                y1 r1n {
                        x 1 sub 1 x 1 add { /x1 exch def
                                x1 r1n { forest x1 get y1 get } if
                        } for
                } if
        } for]
} def

/iter {
        /nf [ n {[ n {0} repeat]} repeat ] def
        0 1 n 1 sub { /x exch def
        0 1 n 1 sub { /y exch def
                nf x get y
                forest x get y get dup
                0 eq { pop rand1 treeprob le {1}{0} ifelse
                } {
                        1 eq {  /fire false def
                                x y neighbors {
                                        -1 eq { /fire true def } if
                                } forall
                                fire {-1}{
                                        rand1 burnprob lt {-1}{1} ifelse
                                } ifelse
                        }{0} ifelse
                } ifelse
                put
        } for } for
        /forest nf def
} def

/n 200 def
/treeprob .05 def
/burnprob .0001 def
/c size n div def
/forest [ n {[ n { rand1 treeprob le {1}{0} ifelse } repeat]} repeat ] def

1000 { drawforest showpage iter } repeat
%%EOF


from math import nil  # Require qualifier to access functions.

type MF64 = proc(x: float64): float64

proc cube(x: float64) : float64 =
  math.pow(x, 3)

proc cuberoot(x: float64) : float64 =
  math.pow(x, 1/3)

proc compose[A](f: proc(x: A): A, g: proc(x: A): A) : (proc(x: A): A) =
  proc c(x: A): A =
    f(g(x))
  return c

proc sin(x: float64) : float64 =
  math.sin(x)

proc acos(x: float64) : float64 =
  math.arccos(x)

var fun = @[sin, math.cos, cube]
var inv = @[MF64 math.arcsin, acos, cuberoot]

for i in 0..2:
  echo compose(inv[i], fun[i])(0.5)


use Collection.Generic;

lambdas Func {
  Double : (FloatHolder) ~ FloatHolder
}

class FirstClass {
  function : Main(args : String[]) ~ Nil {
    vector := Vector->New()<Func2Holder <FloatHolder, FloatHolder> >;
    # store functions in collections
    vector->AddBack(Func2Holder->New(\Func->Double : (v)
      =>  v * v)<FloatHolder, FloatHolder>);
    # new function from preexisting function at run-time
    vector->AddBack(Func2Holder->New(\Func->Double : (v)
      => Float->SquareRoot(v->Get()))<FloatHolder, FloatHolder>);
    # process collection
    each(i : vector) {
      # return value of other functions and pass argument to other function
      Show(vector->Get(i)<Func2Holder>->Get()<FloatHolder, FloatHolder>);
    };
  }

  function : Show(func : (FloatHolder) ~ FloatHolder) ~ Nil {
    func(13.5)->Get()->PrintLine();
  }
}


'''
Forest-Fire Cellular automation
 See: http://en.wikipedia.org/wiki/Forest-fire_model
'''

L = 15
# d = 2 # Fixed
initial_trees = 0.55
p = 0.01
f = 0.001

try:
    raw_input
except:
    raw_input = input

import random

tree, burning, space = 'TB.'
hood = ((-1,-1), (-1,0), (-1,1),
        (0,-1),          (0, 1),
        (1,-1),  (1,0),  (1,1))

def initialise():
    grid = {(x,y): (tree if random.random()<= initial_trees else space)
            for x in range(L)
            for y in range(L) }
    return grid

def gprint(grid):
    txt = '\n'.join(''.join(grid[(x,y)] for x in range(L))
                    for y in range(L))
    print(txt)

def quickprint(grid):
    t = b = 0
    ll = L * L
    for x in range(L):
        for y in range(L):
            if grid[(x,y)] in (tree, burning):
                t += 1
                if grid[(x,y)] == burning:
                    b += 1
    print(('Of %6i cells, %6i are trees of which %6i are currently burning.'
          + ' (%6.3f%%, %6.3f%%)')
          % (ll, t, b, 100. * t / ll, 100. * b / ll))

def gnew(grid):
    newgrid = {}
    for x in range(L):
        for y in range(L):
            if grid[(x,y)] == burning:
                newgrid[(x,y)] = space
            elif grid[(x,y)] == space:
                newgrid[(x,y)] = tree if random.random()<= p else space
            elif grid[(x,y)] == tree:
                newgrid[(x,y)] = (burning
                                   if any(grid.get((x+dx,y+dy),space) == burning
                                            for dx,dy in hood)
                                        or random.random()<= f
                                   else tree)
    return newgrid

if __name__ == '__main__':
    grid = initialise()
    iter = 0
    while True:
        quickprint(grid)
        inp = raw_input('Print/Quit/<int>/<return> %6i: ' % iter).lower().strip()
        if inp:
            if inp[0] == 'p':
                gprint(grid)
            elif inp.isdigit():
                for i in range(int(inp)):
                    iter +=1
                    grid = gnew(grid)
                    quickprint(grid)
            elif inp[0] == 'q':
                break
        grid = gnew(grid)
        iter +=1


# let cube x = x ** 3. ;;
val cube : float -> float = <fun>

# let croot x = x ** (1. /. 3.) ;;
val croot : float -> float = <fun>

# let compose f g = fun x -> f (g x) ;;  (* we could have written "let compose f g x = f (g x)" but we show this for clarity *)
val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>

# let funclist = [sin; cos; cube] ;;
val funclist : (float -> float) list = [<fun>; <fun>; <fun>]

# let funclisti = [asin; acos; croot] ;;
val funclisti : (float -> float) list = [<fun>; <fun>; <fun>]

# List.map2 (fun f inversef -> (compose inversef f) 0.5) funclist funclisti ;;
- : float list = [0.5; 0.499999999999999889; 0.5]


function r = cube(x)
  r = x.^3;
endfunction

function r = croot(x)
  r = x.^(1/3);
endfunction

compose = @(f,g) @(x) f(g(x));

f1 = {@sin, @cos, @cube};
f2 = {@asin, @acos, @croot};

for i = 1:3
  disp(compose(f1{i}, f2{i})(.5))
endfor


#lang racket
(require 2htdp/universe)
(require 2htdp/image)

(define (initial-forest w p-tree)
  (for/vector #:length w ((rw w))
    (for/vector #:length w ((cl w))
      (if (< (random) p-tree) #\T #\_))))

(define (has-burning-neighbour? forest r# c# w)
  ;; note, this will check r# c#, too but it's not
  ;; worth checking that r=r# and c=c# each time in
  ;; this case
  (for*/first
      ((r (in-range (- r# 1) (+ r# 2)))
       #:when (< 0 r w)
       (c (in-range (- c# 1) (+ c# 2)))
       #:when (< 0 c w)
       #:when (equal? #\* (vector-ref (vector-ref forest r) c)))
    #t))

(define (fire-tick forest p-sprout f-combust w)
  (for/vector #:length w ((rw forest) (r# (in-naturals)))
    (for/vector #:length w ((cl rw) (c# (in-naturals)))
      (case cl
        ((#\_) (if (< (random) p-sprout) #\T #\_))
        ((#\*) #\_)
        ((#\T)
         (cond
           [(has-burning-neighbour? forest r# c# w) #\*]
           [(< (random) f-combust) #\*]
           [else #\T]))))))

(define (render-forest state)
  (for/fold
      ((scn (empty-scene
             (* (vector-length state) 8)
             (* (vector-length (vector-ref state 0)) 8)
             'black)))

    ((rw state) (r# (in-naturals)))
    (for/fold
        ((scn scn))
      ((cl rw) (c# (in-naturals)))
      (place-image (circle 4 'solid
                           (case cl
                             ((#\_) 'brown)
                             ((#\T) 'green)
                             ((#\*) 'red)))
                   (+ 4 (* c# 8)) (+ 4 (* r# 8)) scn))))

(define (forest-fire p-tree p-sprout f-combust w)
  (big-bang
   (initial-forest w p-tree) ;; initial state
   [on-tick (lambda (state)
              ;(displayln state)
              (fire-tick state p-sprout f-combust w))]
   [to-draw render-forest]))

(forest-fire 0 1/8 1/1024 50)


my $RED = "\e[1;31m";
my $YELLOW = "\e[1;33m";
my $GREEN = "\e[1;32m";
my $CLEAR = "\e[0m";

enum Cell-State <Empty Tree Heating Burning>;
my @pix = '  ', $GREEN ~ '木', $YELLOW ~ '木', $RED ~ '木';

class Forest {
    has Rat $.p = 0.01;
    has Rat $.f = 0.001;
    has Int $!height;
    has Int $!width;
    has @!coords;
    has @!spot;
    has @!neighbors;

    method BUILD (Int :$!height, Int :$!width) {
	@!coords = ^$!height X ^$!width;
	@!spot = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
        self!init-neighbors;
    }

    method !init-neighbors {
        for @!coords -> ($i, $j) {
            @!neighbors[$i][$j] = eager gather for
                    [-1,-1],[+0,-1],[+1,-1],
                    [-1,+0],        [+1,+0],
                    [-1,+1],[+0,+1],[+1,+1]
	    {
		take-rw @!spot[$i + .[0]][$j + .[1]] // next;
	    }
	}
    }

    method step {
	my @heat;
        for @!coords -> ($i, $j) {
            given @!spot[$i][$j] {
                when Empty   { $_ = Tree if rand < $!p }
                when Tree    { $_ = Heating if rand < $!f }
                when Heating { $_ = Burning; push @heat, ($i, $j); }
                when Burning { $_ = Empty }
            }
        }
	for @heat -> ($i,$j) {
	    $_ = Heating for @!neighbors[$i][$j].grep(Tree);
	}
    }

    method show {
        for ^$!height -> $i {
            say @pix[@!spot[$i].list].join;
        }
    }
}

my ($ROWS, $COLS) = qx/stty size/.words;

signal(SIGINT).act: { print "\e[H\e[2J"; exit }

sub MAIN (Int $height = $ROWS - 2, Int $width = +$COLS div 2 - 1) {
    my Forest $forest .= new(:$height, :$width);
    print "\e[2J";      # ANSI clear screen
    loop {
	print "\e[H";   # ANSI home
	say $++;
	$forest.show;
	$forest.step;
    }
}


: compose(f, g)   #[ g perform f perform ] ;

[ #cos, #sin, #[ 3 pow ] ] [ #acos, #asin, #[ 3 inv powf ] ] zipWith(#compose)
map(#[ 0.5 swap perform ]) conform(#[ 0.5 == ]) println


; creation of new function from preexisting functions at run-time
(define (compose f g) (lambda (x) (f (g x))))

; storing functions in collection
(define (quad x) (* x x x x))
(define (quad-root x) (sqrt (sqrt x)))

(define collection (tuple quad quad-root))

; use functions as arguments to other functions
; and use functions as return values of other functions
(define identity (compose (ref collection 2) (ref collection 1)))
(print (identity 11211776))


declare

  fun {Compose F G}
    fun {$ X}
      {F {G X}}
    end
  end

  fun {Cube X} {Number.pow X 3.0} end

  fun {CubeRoot X} {Number.pow X 1.0/3.0} end

in

  for
     F in [Float.sin  Float.cos  Cube]
     I in [Float.asin Float.acos CubeRoot]
  do
     {Show {{Compose I F} 0.5}}
  end


@echo off
for /L %%i in (1,1,100) do call :tester %%i
goto :eof

:tester
  set /a test = %1 %% 15
  if %test% NEQ 0 goto :NotFizzBuzz
  echo FizzBuzz
  goto :eof

:NotFizzBuzz
  set /a test = %1 %% 5
  if %test% NEQ 0 goto :NotBuzz
  echo Buzz
  goto :eof

:NotBuzz
  set /a test = %1 %% 3
  if %test% NEQ 0 goto :NotFizz
  echo Fizz
  goto :eof

:NotFizz
  echo %1


             ┌───────────────────────────elided version──────────────────────────┐
             ├─── original version has many more options & enhanced displays. ───┤
             └───────────────────────────────────────────────────────────────────┘


# Project : Forest fire

load "guilib.ring"
load "stdlib.ring"

paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Forest fire")
                  setgeometry(100,100,500,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,400,400)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,100,30)
                          settext("draw")
                          setclickevent("draw()")
                  }
                  show()
        }
        exec()
        }

func draw
        p1 = new qpicture()
               color = new qcolor() {
               setrgb(0,0,255,255)
        }
        pen = new qpen() {
                 setcolor(color)
                 setwidth(1)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

pregen = newlist(200,200)
newgen = newlist(200,200)

 for gen = 1 to 20
      see "gen = " + gen + nl
      for x = 1 to 199
           for y = 1 to 199
                 switch pregen[x][y]
                            on 0
                                 if random(9)/10 > 0.099
                                    newgen[x][y] = 1
                                    color = new qcolor()
                                    color.setrgb(0,128,0,255)
                                    pen.setcolor(color)
                                    setpen(pen)
                                    drawpoint(x,y)
                                 ok
                            on 2
                                 newgen[x][y] = 0
                                 color = new qcolor()
                                 color.setrgb(165,42,42,255)
                                 pen.setcolor(color)
                                 setpen(pen)
                                 drawpoint(x,y)
                            on 1
                                 if pregen[x][y] = 2 or pregen[x][y]   = 2 or pregen[x][y+1] = 2 or
                                    pregen[x][y]   = 2 or pregen[x][y+1]   = 2 or pregen[x+1][y] = 2 or
                                    pregen[x+1][y]   = 2 or pregen[x+1][y+1] = 2 or random(9)/10 > 0.0999
                                    color = new qcolor()
                                    color.setrgb(255,0,0,255)
                                    pen.setcolor(color)
                                    setpen(pen)
                                    drawpoint(x,y)
                                    newgen[x][y] = 2
                                 ok
                 off
                 pregen[x][y] = newgen[x][y]
           next
      next
next

        endpaint()
        }
        label1 { setpicture(p1) show() }
        return


use Math::Complex ':trig';

sub compose {
    my ($f, $g) = @_;

    sub {
        $f -> ($g -> (@_));
    };
}

my $cube  = sub { $_[0] ** (3)   };
my $croot = sub { $_[0] ** (1/3) };

my @flist1 = ( \&Math::Complex::sin, \&Math::Complex::cos, $cube  );
my @flist2 = ( \&asin,               \&acos,               $croot );

print join "\n", map {
    compose($flist1[$_], $flist2[$_]) -> (0.5)
} 0..2;


class Forest_Fire
  Neighborhood = [-1,0,1].product([-1,0,1]) - [0,0]
  States = {empty:" ", tree:"T", fire:"#"}

  def initialize(xsize, ysize=xsize, p=0.5, f=0.01)
    @xsize, @ysize, @p, @f = xsize, ysize, p, f
    @field = Array.new(xsize+1) {|i| Array.new(ysize+1, :empty)}
    @generation = 0
  end

  def evolve
    @generation += 1
    work = @field.map{|row| row.map{|cell| cell}}
    for i in 0[email protected]
      for j in 0[email protected]
        case [email protected][i][j]
        when :empty
          cell = :tree  if rand < @p
        when :tree
          cell = :fire  if fire?(i,j)
        else
          cell = :empty
        end
        work[i][j] = cell
      end
    end
    @field = work
  end

  def fire?(i,j)
    rand < @f or Neighborhood.any? {|di,dj| @field[i+di][j+dj] == :fire}
  end

  def display
    puts "Generation : #@generation"
    puts @xsize.times.map{|i| @ysize.times.map{|j| States[@field[i][j]]}.join}
  end
end

forest = Forest_Fire.new(10,30)
10.times do |i|
  forest.evolve
  forest.display
end


sequence ctable = {}

function compose(integer f, g)
    ctable = append(ctable,{f,g})
    integer cdx = length(ctable)
    return cdx
end function

function call_composite(integer cdx, atom x)
    integer {f,g} = ctable[cdx]
    return f(g(x))
end function

function plus1(atom x)
    return x+1
end function

function halve(atom x)
    return x/2
end function

constant m = compose(halve,plus1)

?call_composite(m,1)    -- displays 1
?call_composite(m,4)    -- displays 2.5


$compose = function ($f, $g) {
    return function ($x) use ($f, $g) {
        return $f($g($x));
    };
};

$fn  = array('sin', 'cos', function ($x) { return pow($x, 3); });
$inv = array('asin', 'acos', function ($x) { return pow($x, 1/3); });

for ($i = 0; $i < 3; $i++) {
    $f = $compose($inv[$i], $fn[$i]);
    echo $f(0.5), PHP_EOL;
}


*        Five weekends             31/05/2016
FIVEWEEK CSECT
         USING  FIVEWEEK,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         LM     R10,R11,=AL8(0)    nko=0; nok=0
         LH     R6,Y1              y=y1
LOOPY    CH     R6,Y2              do y=y1 to y2
         BH     ELOOPY
         MVI    YF,X'00'           yf=0
         LA     R7,1               im=1
LOOPIM   C      R7,=F'7'           do im=1 to 7
         BH     ELOOPIM
         LR     R1,R7              im
         SLA    R1,1               *2 (H)
         LH     R2,ML-2(R1)        ml(im)
         ST     R2,M               m=ml(im)
         MVC    D,=F'1'            d=1
         L      R4,M               m
         C      R4,=F'2'           if m<=2
         BH     MSUP2
         L      R8,M               m
         LA     R8,12(R8)          mw=m+12
         LR     R9,R6              y
         BCTR   R9,0               yw=y-1
         B      EMSUP2
MSUP2    L      R8,M               mw=m
         LR     R9,R6              yw=y
EMSUP2   LR     R4,R9              ym
         SRDA   R4,32              .
         D      R4,=F'100'         yw/100
         ST     R5,J               j=yw/100
         ST     R4,K               k=yw//100
         LR     R4,R8              mw
         LA     R4,1(R4)           mw+1
         MH     R4,=H'26'          (mw+1)*26
         SRDA   R4,32              .
         D      R4,=F'10'          (mw+1)*26/10
         LR     R2,R5              "
         A      R2,D               d
         A      R2,K               d+k
         L      R3,K               k
         SRA    R3,2               k/4
         AR     R2,R3              (mw+1)*26/10+k/4
         L      R3,J               j
         SRA    R3,2               j/4
         AR     R2,R3              (mw+1)*26/10+k/4+j/4
         LA     R5,5               5
         M      R4,J               5*j
         AR     R2,R5              (mw+1)*26/10+k/4+j/4
         SRDA   R2,32              .
         D      R2,=F'7'           (d+(mw+1)*26/10+k+k/4+j/4+5*j)/7
         C      R2,=F'6'           if dow=friday
         BNE    NOFRIDAY
         XDECO  R6,XDEC            y
         MVC    PG+0(4),XDEC+8     output y
         LR     R1,R7              im
         MH     R1,=H'3'           *3
         LA     R14,MN-3(R1)       @mn(im)
         MVC    PG+5(3),0(R14)     output mn(im)
         XPRNT  PG,8               print buffer
         LA     R11,1(R11)         nok=nok+1
         MVI    YF,X'01'           yf=1
NOFRIDAY LA     R7,1(R7)           im=im+1
         B      LOOPIM
ELOOPIM  L      R4,YF              yf
         CLI    YF,X'00'           if yf=0
         BNE    EYFNE0
         LA     R10,1(R10)         nko=nko+1
EYFNE0   LA     R6,1(R6)           y=y+1
         B      LOOPY
ELOOPY   XDECO  R11,XDEC           nok
         MVC    PG+0(4),XDEC+8     output nok
         MVC    PG+4(12),=C' occurrences'
         XPRNT  PG,80              print buffer
         XDECO  R10,XDEC           nko
         MVC    PG+0(4),XDEC+8     output nko
         MVC    PG+4(33),=C' years with no five weekend month'
         XPRNT  PG,80              print buffer
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
Y1       DC     H'1900'            year start
Y2       DC     H'2100'            year stop
ML       DC     H'1',H'3',H'5',H'7',H'8',H'10',H'12'
MN       DC     C'jan',C'mar',C'may',C'jul',C'aug',C'oct',C'dec'
YF       DS     X                  year flag
M        DS     F                  month
D        DS     F                  day
J        DS     F                  j=yw/100
K        DS     F                  j=mod(yw,100)
PG       DC     CL80'....-'        buffer
XDEC     DS     CL12               temp for XDECO
         YREGS
         END    FIVEWEEK


extern crate rand;
extern crate ansi_term;

#[derive(Copy, Clone, PartialEq)]
enum Tile {
    Empty,
    Tree,
    Burning,
    Heating,
}

impl fmt::Display for Tile {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        let output = match *self {
            Empty => Black.paint(" "),
            Tree => Green.bold().paint("T"),
            Burning => Red.bold().paint("B"),
            Heating => Yellow.bold().paint("T"),
        };
        write!(f, "{}", output)
    }
}

// This has been added to the nightly rust build as of March 24, 2016
// Remove when in stable branch!
trait Contains<T> {
    fn contains(&self, T) -> bool;
}

impl<T: PartialOrd> Contains<T> for std::ops::Range<T> {
    fn contains(&self, elt: T) -> bool {
        self.start <= elt && elt < self.end
    }
}

const NEW_TREE_PROB: f32 = 0.01;
const INITIAL_TREE_PROB: f32 = 0.5;
const FIRE_PROB: f32 = 0.001;

const FOREST_WIDTH: usize = 60;
const FOREST_HEIGHT: usize = 30;

const SLEEP_MILLIS: u64 = 25;

use std::fmt;
use std::io;
use std::io::prelude::*;
use std::io::BufWriter;
use std::io::Stdout;
use std::process::Command;
use std::time::Duration;
use rand::Rng;
use ansi_term::Colour::*;

use Tile::{Empty, Tree, Burning, Heating};

fn main() {
    let sleep_duration = Duration::from_millis(SLEEP_MILLIS);
    let mut forest = [[Tile::Empty; FOREST_WIDTH]; FOREST_HEIGHT];

    prepopulate_forest(&mut forest);
    print_forest(forest, 0);

    std::thread::sleep(sleep_duration);

    for generation in 1.. {

        for row in forest.iter_mut() {
            for tile in row.iter_mut() {
                update_tile(tile);
            }
        }

        for y in 0..FOREST_HEIGHT {
            for x in 0..FOREST_WIDTH {
                if forest[y][x] == Burning {
                    heat_neighbors(&mut forest, y, x);
                }
            }
        }

        print_forest(forest, generation);

        std::thread::sleep(sleep_duration);
    }
}

fn prepopulate_forest(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT]) {
    for row in forest.iter_mut() {
        for tile in row.iter_mut() {
            *tile = if prob_check(INITIAL_TREE_PROB) {
                Tree
            } else {
                Empty
            };
        }
    }
}

fn update_tile(tile: &mut Tile) {
    *tile = match *tile {
        Empty => {
            if prob_check(NEW_TREE_PROB) == true {
                Tree
            } else {
                Empty
            }
        }
        Tree => {
            if prob_check(FIRE_PROB) == true {
                Burning
            } else {
                Tree
            }
        }
        Burning => Empty,
        Heating => Burning,
    }
}

fn heat_neighbors(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], y: usize, x: usize) {
    let neighbors = [(-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 1), (1, -1), (1, 0), (1, 1)];

    for &(xoff, yoff) in neighbors.iter() {
        let nx: i32 = (x as i32) + xoff;
        let ny: i32 = (y as i32) + yoff;
        if (0..FOREST_WIDTH as i32).contains(nx) && (0..FOREST_HEIGHT as i32).contains(ny) &&
           forest[ny as usize][nx as usize] == Tree {
            forest[ny as usize][nx as usize] = Heating
        }
    }
}

fn prob_check(chance: f32) -> bool {
    let roll = rand::thread_rng().gen::<f32>();
    if chance - roll > 0.0 {
        true
    } else {
        false
    }
}

fn print_forest(forest: [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], generation: u32) {
    let mut writer = BufWriter::new(io::stdout());
    clear_screen(&mut writer);
    writeln!(writer, "Generation: {}", generation + 1).unwrap();
    for row in forest.iter() {
        for tree in row.iter() {
            write!(writer, "{}", tree).unwrap();
        }
        writer.write(b"\n").unwrap();
    }
}

fn clear_screen(writer: &mut BufWriter<Stdout>) {
    let output = Command::new("clear").output().unwrap();
    write!(writer, "{}", String::from_utf8_lossy(&output.stdout)).unwrap();
}


class FORESTFIRE is
  private attr fields:ARRAY{ARRAY{INT}};
  private attr swapu:INT;
  private attr rnd:RND;
  private attr verbose:BOOL;
  private attr generation:INT;
  readonly attr width, height:INT;
  const empty:INT := 0;
  const tree:INT := 1;
  const burning:INT := 2;

  attr prob_tree, prob_p, prob_f :FLT;

  create(w, h:INT, v:BOOL):SAME is
    res:FORESTFIRE := new;
    res.fields := #(2);
    res.fields[0] := #(w*h);
    res.fields[1] := #(w*h);
    res.width := w; res.height := h;
    res.swapu := 0;
    res.prob_tree := 0.55;
    res.prob_p := 0.001;
    res.prob_f := 0.00001;
    res.rnd := #RND;
    res.verbose := v;
    res.generation := 0;
    res.initfield;
    return res;
  end;

  -- to give variability
  seed(i:INT) is
    rnd.seed(i);
  end;

  create(w, h:INT):SAME is
    res ::= create(w, h, false);
    return res;
  end;

  initfield is
    n ::= 0;
    swapu := 0;
    if verbose and generation > 0 then
      #ERR + "Previous generation " + generation + "\n";
    end;
    generation := 0;
    loop i ::= 0.upto!(width-1);
      loop j ::= 0.upto!(height-1);
        if rnd.uniform > prob_tree.fltd then
          cset(i, j, empty);
        else
	  n := n + 1;
          cset(i, j, tree);
        end;
      end;
    end;
    if verbose then
      #ERR + #FMT("Field size is %dx%d (%d)", width, height, size) + "\n";
      #ERR + "There are " + n + " trees (" + (100.0*n.flt/size.flt) + "%)\n";
      #ERR + "prob_tree = " + prob_tree + "\n";
      #ERR + "prob_f = " + prob_f + "\n";
      #ERR + "prob_p = " + prob_p + "\n";
      #ERR + "ratio = " + prob_p/prob_f + "\n";
    end;
  end;

  field:ARRAY{INT} is
    return fields[swapu];
  end;

  ofield:ARRAY{INT} is
    return fields[swapu.bxor(1)];
  end;

  size:INT is
    return width*height;
  end;

  set(i, j, t:INT)
    pre bcheck(i, j)
  is
    ofield[j*width + i] := t;
  end;

  cset(i, j, t:INT)
    pre bcheck(i, j)
  is
    field[j*width + i] := t;
  end;

  private bcheck(i, j:INT):BOOL is
    if i.is_between(0, width-1) and j.is_between(0, height-1) then
      return true; -- is inside
    else
      return false; -- is outside
    end;
  end;

  get(i, j:INT):INT is
    if ~bcheck(i, j) then
      return empty;
    end;
    return field[j*width + i];
  end;

  oget(i, j:INT):INT is
    if ~bcheck(i, j) then
      return empty;
    end;
    return ofield[j*width + i];
  end;

  burning_neighbor(i, j:INT):BOOL is
    loop x ::= (-1).upto!(1);
      loop y ::= (-1).upto!(1);
        if x /= y then
          if get(i+x, j+y) = burning then return true; end;
        end;
      end;
    end;
    return false;
  end;

  evolve is
    bp ::= 0;
    loop i ::= 0.upto!(width-1);
      loop j ::= 0.upto!(height-1);
	case get(i, j)
        when burning then set(i, j, empty); bp := bp + 1;
        when empty then
          if rnd.uniform > prob_p.fltd then
            set(i, j, empty);
          else
            set(i, j, tree);
          end;
        when tree then
          if burning_neighbor(i, j) then
            set(i, j, burning);
          else
            if rnd.uniform > prob_f.fltd then
              set(i, j, tree);
            else
              set(i, j, burning);
            end;
          end;
        else
          #ERR + "corrupted field\n";
        end;
      end;
    end;
    generation := generation + 1;
    if verbose then
      if bp > 0 then
        #ERR + #FMT("Burning at gen %d: %d\n", generation-1, bp);
      end;
    end;
    swapu := swapu.bxor(1);
  end;

  str:STR is
    s ::= "";
    loop j ::= 0.upto!(height -1);
      loop i ::= 0.upto!(width -1);
        case get(i, j)
          when empty then s := s + ".";
          when tree then s := s + "Y";
          when burning then s := s + "*";
        end;
      end;
      s := s + "\n";
    end;
    s := s + "\n";
    return s;
  end;

end;

class MAIN is

  main is
    forestfire ::= #FORESTFIRE(74, 40);
    -- #FORESTFIRE(74, 40, true) to have some extra info
    -- (redirecting stderr to a file is a good idea!)

    #OUT + forestfire.str;
    -- evolve 1000 times
    loop i ::= 1000.times!;
      forestfire.evolve;
      -- ANSI clear screen sequence
      #OUT + 0x1b.char + "[H" + 0x1b.char + "[2J";
      #OUT + forestfire.str;
    end;
  end;

end;


(load "@lib/math.l")

(de compose (F G)
   (curry (F G) (X)
      (F (G X)) ) )

(de cube (X)
   (pow X 3.0) )

(de cubeRoot (X)
   (pow X 0.3333333) )

(mapc
   '((Fun Inv)
      (prinl (format ((compose Inv Fun) 0.5) *Scl)) )
   '(sin  cos  cube)
   '(asin acos cubeRoot) )


% PostScript has 'sin' and 'cos', but not these
/asin { dup dup 1. add exch 1. exch sub mul sqrt atan } def
/acos { dup dup 1. add exch 1. exch sub mul sqrt exch atan } def

/cube { 3 exp } def
/cuberoot { 1. 3. div exp } def

/compose { % f g -> { g f }
  [ 3 1 roll exch
  % procedures are not executed when encountered directly
  % insert an 'exec' after procedures, but not after operators
  1 index type /operatortype ne { /exec cvx exch } if
  dup type /operatortype ne { /exec cvx } if
  ] cvx
} def

/funcs [ /sin load /cos load /cube load ] def
/ifuncs [ /asin load /acos load /cuberoot load ] def

0 1 funcs length 1 sub { /i exch def
  ifuncs i get funcs i get compose
  .5 exch exec ==
} for


:- use_module(library(lambda)).

compose(F,G, FG) :-
	FG =  \X^Z^(call(G,X,Y), call(F,Y,Z)).

cube(X, Y) :-
	Y is X ** 3.

cube_root(X, Y) :-
	Y is X ** (1/3).

first_class :-
	L = [sin, cos, cube],
	IL = [asin, acos, cube_root],

	% we create the composed functions
	maplist(compose, L, IL, Lst),

	% we call the functions
	maplist(call, Lst, [0.5,0.5,0.5], R),

	% we display the results
	maplist(writeln, R).


;https://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week#Sakamoto.27s_methods
BYTE FUNC DayOfWeek(INT y BYTE m,d)	;1<=m<=12, y>1752
  BYTE ARRAY t=[0 3 2 5 0 3 5 1 4 6 2 4]
  BYTE res

  IF m<3 THEN
    y==-1
  FI
  res=(y+y/4-y/100+y/400+t(m-1)+d) MOD 7
RETURN (res)

PROC Main()
  BYTE ARRAY m31=[1 3 5 7 8 10 12]
  INT ARRAY years(250)
  BYTE ARRAY months(250)
  INT y
  BYTE i,m,mCount,yCount,found,c

  mCount=0 yCount=0 c=0
  FOR y=1900 TO 2100
  DO
    found=0
    FOR i=0 TO 6
    DO
      m=m31(i)
      IF DayOfWeek(y,m,1)=5 THEN
        years(mCount)=y
        months(mCount)=m
        found=1
        mCount==+1
      FI
    OD
    IF found=0 THEN
      yCount==+1
    FI
  OD
  Print("5-weekend months in 1900-2100: ") PrintBE(mCount)
  Print("non 5-weekend years in 1900-2100: ") PrintBE(yCount)
  PutE()

  FOR i=0 TO 4
  DO
    PrintI(years(i)) Put('/) PrintBE(months(i))
  OD
  PrintE("...")
  FOR i=mCount-5 TO mCount-1
  DO
    PrintI(years(i)) Put('/) PrintBE(months(i))
  OD
RETURN


with Ada.Text_IO;              use Ada.Text_IO;
with Ada.Calendar.Formatting;  use Ada.Calendar;

use Ada.Calendar.Formatting;

procedure Five_Weekends is
   Months : Natural := 0;
begin
   for Year in Year_Number range 1901..2100 loop
      for Month in Month_Number range 1..12 loop
         begin
            if Day_Of_Week (Formatting.Time_Of (Year, Month, 31)) = Sunday then
               Put_Line (Year_Number'Image (Year) & Month_Number'Image (Month));
               Months := Months + 1;
            end if;
         exception
            when Time_Error =>
               null;
         end;
      end loop;
   end loop;
   Put_Line ("Number of months:" & Integer'Image (Months));
end Five_Weekends;


import scala.util.Random

class Forest(matrix:Array[Array[Char]]){
  import Forest._
  val f=0.01;	 // auto combustion probability
  val p=0.1;	 // tree creation probability
  val rows=matrix.size
  val cols=matrix(0).size

  def evolve():Forest=new Forest(Array.tabulate(rows, cols){(y,x)=>
    matrix(y)(x) match {
      case EMPTY => if (Random.nextDouble<p) TREE else EMPTY
      case BURNING => EMPTY
      case TREE => if (neighbours(x, y).exists(_==BURNING)) BURNING
                  else if (Random.nextDouble<f) BURNING else TREE
    }
  })

  def neighbours(x:Int, y:Int)=matrix slice(y-1, y+2) map(_.slice(x-1, x+2)) flatten
  override def toString()=matrix map (_.mkString("")) mkString "\n"
}

object Forest{
  val TREE='T'
  val BURNING='#'
  val EMPTY='.'
  def apply(x:Int=30, y:Int=15)=new Forest(Array.tabulate(y, x)((y,x)=> if (Random.nextDouble<0.5) TREE else EMPTY))
}


>>> # Some built in functions and their inverses
>>> from math import sin, cos, acos, asin
>>> # Add a user defined function and its inverse
>>> cube = lambda x: x * x * x
>>> croot = lambda x: x ** (1/3.0)
>>> # First class functions allow run-time creation of functions from functions
>>> # return function compose(f,g)(x) == f(g(x))
>>> compose = lambda f1, f2: ( lambda x: f1(f2(x)) )
>>> # first class functions should be able to be members of collection types
>>> funclist = [sin, cos, cube]
>>> funclisti = [asin, acos, croot]
>>> # Apply functions from lists as easily as integers
>>> [compose(inversef, f)(.5) for f, inversef in zip(funclist, funclisti)]
[0.5, 0.4999999999999999, 0.5]
>>>


cube <- function(x) x^3
croot <- function(x) x^(1/3)
compose <- function(f, g) function(x){f(g(x))}

f1 <- c(sin, cos, cube)
f2 <- c(asin, acos, croot)

for(i in 1:3) {
  print(compose(f1[[i]], f2[[i]])(.5))
}


#lang racket

(define (compose f g) (λ (x) (f (g x))))
(define (cube x) (expt x 3))
(define (cube-root x) (expt x (/ 1 3)))
(define funlist (list sin cos cube))
(define ifunlist (list asin acos cube-root))

(for ([f funlist] [i ifunlist])
  (displayln ((compose i f) 0.5)))


five_weekends: BEGIN
  INT m, year, nfives := 0, not5 := 0;
  BOOL no5weekend;

  MODE MONTH = STRUCT(
    INT n,
    [3]CHAR name
  ) # MODE MONTH #;

  []MONTH month = (
    MONTH(13, "Jan"),
    MONTH(3,  "Mar"),
    MONTH(5,  "May"),
    MONTH(7,  "Jul"),
    MONTH(8,  "Aug"),
    MONTH(10, "Oct"),
    MONTH(12, "Dec")
  );

  FOR year FROM 1900 TO 2100 DO
    IF year = 1905 THEN printf($"..."l$) FI;
    no5weekend := TRUE;
    FOR m TO UPB month DO
      IF n OF month(m) = 13 THEN
        IF day_of_week(1, n OF month(m), year-1) = 6 THEN
          IF year<1905 OR year > 2096 THEN printf(($g, 5zl$, name OF month(m), year)) FI;
          nfives +:= 1;
          no5weekend := FALSE
        FI
      ELSE
        IF day_of_week(1, n OF month(m), year) = 6 THEN
          IF year<1905 OR year > 2096 THEN printf(($g, 5zl$, name OF month(m), year)) FI;
          nfives +:= 1;
          no5weekend := FALSE
        FI
      FI
    OD;
    IF no5weekend THEN not5 +:= 1 FI
  OD;

  printf(($g, g(0)l$, "Number of months with five weekends between 1900 and 2100 = ", nfives));
  printf(($g, g(0)l$, "Number of years between 1900 and 2100 with no five weekend months = ", not5));

# contains #

  PROC day_of_week = (INT d, m, y)INT: BEGIN
    INT j, k;
    j := y OVER 100;
    k := y MOD 100;
    (d + (m+1)*26 OVER 10 + k + k OVER 4 + j OVER 4 + 5*j) MOD 7
  END # function day_of_week #;
  SKIP
END # program five_weekends #


define w = `tput cols`.to_i-1
define h = `tput lines`.to_i-1
define r = "\033[H"

define red = "\033[31m"
define green = "\033[32m"
define yellow = "\033[33m"

define chars = [' ', green+'*', yellow+'&', red+'&']

define tree_prob = 0.05
define burn_prob = 0.0002

enum |Empty, Tree, Heating, Burning|

define dirs = [
    %n(-1 -1), %n(-1 0), %n(-1 1), %n(0 -1),
    %n(0   1), %n(1 -1), %n(1  0), %n(1  1),
]

var forest = h.of { w.of { 1.rand < tree_prob ? Tree : Empty } }

var range_h = h.range
var range_w = w.range

func iterate {
    var new = h.of{ w.of(0) }
    for i in range_h {
        for j in range_w {
            given (new[i][j] = forest[i][j]) {
              when (Tree) {
                1.rand < burn_prob && (new[i][j] = Heating; next)
                dirs.each { |pair|
                    var y = pair[0]+i
                    range_h.contains(y) || next
                    var x = pair[1]+j
                    range_w.contains(x) || next
                    forest[y][x] == Heating && (new[i][j] = Heating; break)
                }
              }
              when (Heating)            { new[i][j] = Burning }
              when (Burning)            { new[i][j] = Empty   }
              case (1.rand < tree_prob) { new[i][j] = Tree    }
            }
        }
    }
    forest = new
}

STDOUT.autoflush(true)

func init_forest {
    print r
    forest.each { |row|
        print chars[row]
        print "\033[E\033[1G"
    }
    iterate()
}

loop { init_forest() }