import scala.annotation.tailrec

case class LearnerParams(target:String,rate:Double,C:Int)

val chars =  ('A' to 'Z') ++ List(' ')
val randgen = new scala.util.Random
def randchar = {
   val charnum = randgen.nextInt(chars.size)
   chars(charnum)
}

class RichTraversable[T](t: Traversable[T]) {
    def maxBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.max(ord on fn)
    def minBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.min(ord on fn)
}

implicit def toRichTraversable[T](t: Traversable[T]) = new RichTraversable(t)

def fitness(candidate:String)(implicit params:LearnerParams) =
   (candidate zip params.target).map { case (a,b) => if (a==b) 1 else 0 }.sum

def mutate(initial:String)(implicit params:LearnerParams) =
   initial.map{ samechar => if(randgen.nextDouble < params.rate) randchar else samechar }

@tailrec
def evolve(generation:Int, initial:String)(implicit params:LearnerParams){
   import params._
   printf("Generation: %3d  %s\n",generation, initial)
   if(initial == target) return ()
   val candidates = for (number <- 1 to C) yield mutate(initial)
   val next = candidates.maxBy(fitness)
   evolve(generation+1,next)
}

implicit val params = LearnerParams("METHINKS IT IS LIKE A WEASEL",0.01,100)
val initial = (1 to params.target.size) map(x => randchar) mkString
evolve(0,initial)


let is_even d =
  (d mod 2) = 0

let is_odd d =
  (d mod 2) <> 0


(defn equilibrium [lst]
  (loop [acc '(), i 0, left 0, right (apply + lst), lst lst]
     (if (empty? lst)
	 (reverse acc)
	 (let [[x & xs] lst
	       right    (- right x)
	       acc      (if (= left right) (cons i acc) acc)]
	   (recur acc (inc i) (+ left x) right xs)))))


(defun dflt-on-nil (v dflt)
  (if v v dflt))

(defun eq-index (v)
  (do*
       ((stack nil)
        (i 0 (+ 1 i))
        (rest v (cdr rest))
        (lsum 0)
        (rsum (apply #'+ (cdr v))))
       ;; Reverse here is not strictly necessary
       ((null rest) (reverse stack))
    (if (eql lsum rsum) (push i stack))
    (setf lsum (+ lsum (car rest)))
    (setf rsum (- rsum (dflt-on-nil (cadr rest) 0)))))


fcn entropy(text){
   text.pump(Void,fcn(c,freq){ c=c.toAsc(); freq[c]=freq[c]+1; freq }
       .fp1((0).pump(256,List,(0.0).create.fp(0)).copy()))
   .filter()		      // remove all zero entries
   .apply('/(text.len()))     // (num of char)/len
   .apply(fcn(p){-p*p.log()}) // |p*ln(p)|
   .sum(0.0)/(2.0).log();     // sum * ln(e)/ln(2) to convert to log2
}

entropy(File("entropy.zkl").read().text).println();


def factorial(n: Int)={
  var res = 1
  for(i <- 1 to n)
    res *= i
  res
}


(define (factorial n)
  (if (<= n 0)
      1
      (* n (factorial (- n 1)))))


without js -- none such in a browser, that I know of
?getenv("PATH")


: (sys "TERM")
-> "xterm"

: (sys "SHELL")
-> "/bin/bash"


type Fruit =
  | Apple = 0
  | Banana = 1
  | Cherry = 2

let basket = [ Fruit.Apple ; Fruit.Banana ; Fruit.Cherry ]
Seq.iter (printfn "%A") basket


IN: scratchpad { "sun" "mon" "tue" "wed" "thur" "fri" "sat" } <enum>

--- Data stack:
T{ enum f ~array~ }
IN: scratchpad [ 1 swap at ] [ keys ] bi

--- Data stack:
"mon"
{ 0 1 2 3 4 5 6 }


// create an enumeration with named constants
enum class Fruits { apple, banana, orange }


0 CONSTANT apple
1 CONSTANT banana
2 CONSTANT cherry
...


enum, bind(c)
  enumerator :: one=1, two, three, four, five
  enumerator :: six, seven, nine=9
end enum


var eulers_sum_of_powers = function (iMaxN) {

    var aPow5 = [];
    var oPow5ToN = {};

    for (var iP = 0; iP <= iMaxN; iP++) {
        var iPow5 = Math.pow(iP, 5);
        aPow5.push(iPow5);
        oPow5ToN[iPow5] = iP;
    }

    for (var i0 = 1; i0 <= iMaxN; i0++) {
        for (var i1 = 1; i1 <= i0; i1++) {
            for (var i2 = 1; i2 <= i1; i2++) {
                for (var i3 = 1; i3 <= i2; i3++) {
                    var iPow5Sum = aPow5[i0] + aPow5[i1] + aPow5[i2] + aPow5[i3];
                    if (typeof oPow5ToN[iPow5Sum] != 'undefined') {
                        return {
                            i0: i0,
                            i1: i1,l
                            i2: i2,
                            i3: i3,
                            iSum: oPow5ToN[iPow5Sum]
                        };
                    }
                }
            }
        }
    }

};

var oResult = eulers_sum_of_powers(250);

console.log(oResult.i0 + '^5 + ' + oResult.i1 + '^5 + ' + oResult.i2 +
    '^5 + ' + oResult.i3 + '^5 = ' + oResult.iSum + '^5');


(import (scheme base)
        (scheme write)
        (srfi 27))     ; random numbers

(random-source-randomize! default-random-source)

(define target "METHINKS IT IS LIKE A WEASEL") ; target string
(define C 100) ; size of population
(define p 0.1) ; chance any char is mutated

;; return a random character in given range
(define (random-char)
  (string-ref "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
              (random-integer 27)))

;; compute distance of given string from target
(define (fitness str)
  (apply +
         (map (lambda (c1 c2) (if (char=? c1 c2) 0 1))
              (string->list str)
              (string->list target))))

;; mutate given parent string, returning a new string
(define (mutate str)
  (string-map (lambda (c)
                (if (< (random-real) p)
                  (random-char)
                  c))
              str))

;; create a population by mutating parent,
;; returning a list of variations
(define (make-population parent)
  (do ((pop '() (cons (mutate parent) pop)))
    ((= C (length pop)) pop)))

;; find the most fit candidate in given list
(define (find-best candidates)
  (define (select-best a b)
    (if (< (fitness a) (fitness b)) a b))
  ;
  (do ((best (car candidates) (select-best best (car rem)))
       (rem (cdr candidates) (cdr rem)))
    ((null? rem) best)))

;; create first parent from random characters
;; of same size as target string
(define (initial-parent)
  (do ((res '() (cons (random-char) res)))
    ((= (length res) (string-length target))
     (list->string res))))

;; run the search
(do ((parent (initial-parent) (find-best (cons parent (make-population parent))))) ; select best from parent and population
  ((string=? parent target)
   (display (string-append "Found: " parent "\n")))
  (display parent) (newline))


// Using the modulo operator
even: func (n: Int) -> Bool {
  (n % 2) == 0
}

// Using bitwise and
odd: func (n: Int) -> Bool {
  (n & 1) == 1
}


import std.stdio, std.algorithm, std.range, std.functional;

auto equilibrium(Range)(Range r) pure nothrow @safe /*@nogc*/ {
    return r.length.iota.filter!(i => r[0 .. i].sum == r[i + 1 .. $].sum);
}

void main() {
    [-7, 1, 5, 2, -4, 3, 0].equilibrium.writeln;
}


import extensions;
import system'routines;
import system'collections;
import extensions'routines;

class EquilibriumEnumerator : Enumerator
{
    int        left;
    int        right;
    int        index;
    Enumerator en;

    constructor new(Enumerator en)
    {
        this en := en;

        self.reset()
    }

    constructor new(Enumerable list)
        <= new(list.enumerator());

    constructor new(o)
        <= new(cast Enumerable(o));

    bool next()
    {
        index += 1;

        while(en.next())
        {
            var element := en.get();
            right -= element;
            bool found := (left == right);
            left += element;

            if (found)
            {
                ^ true
            };

            index += 1
        };

        ^ false
    }

    reset()
    {
        en.reset();

        left := 0;
        right := en.summarize();
        index := -1;

        en.reset();
    }

    get() = index;

    enumerable() => en;
}

public program()
{
    EquilibriumEnumerator.new(new int[]{ -7, 1, 5, 2, -4, 3, 0 })
        .forEach:printingLn
}


import Cocoa

func fibonacci(n: Int) -> Int {
    let square_root_of_5 = sqrt(5.0)
    let p = (1 + square_root_of_5) / 2
    let q = 1 / p
    return Int((pow(p,CDouble(n)) + pow(q,CDouble(n))) / square_root_of_5 + 0.5)
}

for i in 1...30 {
    println(fibonacci(i))
}


(off "Program")

(de compile (File)
   (let Stack NIL
      (setq "Program"
         (make
            (in File
               (while (char)
                  (case @
                     (">"
                        (link
                           '(setq Data
                              (or
                                 (cddr Data)
                                 (con (cdr Data) (cons 0 (cons Data))) ) ) ) )
                     ("<"
                        (link
                           '(setq Data
                              (or
                                 (cadr Data)
                                 (set (cdr Data) (cons 0 (cons NIL Data))) ) ) ) )
                     ("+" (link '(inc Data)))
                     ("-" (link '(dec Data)))
                     ("." (link '(prin (char (car Data)))))
                     ("," (link '(set Data (char (read)))))
                     ("["
                        (link
                           '(setq Code
                              ((if (=0 (car Data)) cdar cdr) Code) ) )
                        (push 'Stack (chain (cons))) )
                     ("]"
                        (unless Stack
                           (quit "Unbalanced ']'") )
                        (link
                           '(setq Code
                              ((if (n0 (car Data)) cdar cdr) Code) ) )
                        (let (There (pop 'Stack)  Here (cons There))
                           (chain (set There Here)) ) ) ) ) ) ) )
      (when Stack
         (quit "Unbalanced '['") ) ) )

(de execute ()
   (let Data (cons 0 (cons))              # Create initial cell
      (for (Code "Program"  Code)         # Run program
         (eval (pop 'Code)) )
      (while (cadr Data)                  # Find beginning of data
         (setq Data @) )
      (filter prog Data '(T NIL .)) ) )   # Return data space


100H:

/* CP/M BDOS CALLS */
BDOS: PROCEDURE (FN, ARG) BYTE;
    DECLARE FN BYTE, ARG ADDRESS;
    GO TO 5;
END BDOS;

READ$CHAR: PROCEDURE BYTE; RETURN BDOS(1, 0); END READ$CHAR;
WRITE$CHAR: PROCEDURE (CHAR); DECLARE CHAR BYTE;
    CHAR = BDOS(2, CHAR); END WRITE$CHAR;
PRINT: PROCEDURE (STRING); DECLARE STRING ADDRESS;
    STRING = BDOS(9, STRING); END PRINT;
OPEN$FILE: PROCEDURE (FCB) BYTE; DECLARE FCB ADDRESS;
    RETURN BDOS(15, FCB); END OPEN$FILE;
READ$FILE: PROCEDURE (FCB, ADDR) BYTE;
    DECLARE (FCB, ADDR) ADDRESS, FOO BYTE;
    FOO = BDOS(26, ADDR);
    RETURN BDOS(20, FCB);
END READ$FILE;
EXIT: PROCEDURE; MEMORY(0) = BDOS(0,0); END EXIT;

/* TOP OF AVAILABLE MEMORY IN CP/M */
DECLARE MTPTR ADDRESS INITIAL (6), MEM$TOP BASED MTPTR ADDRESS;

/* FILE GIVEN ON COMMAND LINE */
DECLARE FCB1 LITERALLY '5CH';

/* PRINT ERROR AND EXIT */
ERROR: PROCEDURE (STRING);
    DECLARE STRING ADDRESS;
    CALL PRINT(STRING);
    CALL EXIT;
END ERROR;

/* OPEN FILE */
IF OPEN$FILE(FCB1) = 0FFH THEN
    CALL ERROR(.'CANNOT OPEN INPUT FILE$');

/* READ FILE BLOCK BY BLOCK */
DECLARE MP ADDRESS, M BASED MP BYTE;
MEMORY(0) = 26;
MP = .MEMORY + 1;
DO WHILE READ$FILE(FCB1, MP) <> 1;
    MP = MP + 128;
END;
M = 26; /* TERMINATE WITH EOF */
MP = MP + 1;

/* CLEAR THE REST OF MEMORY */
DECLARE X ADDRESS;
DO X = 0 TO MEM$TOP-MP-1;
    M(X) = 0;
END;

/* BRAINF*** I/O WITH CR/LF TRANSLATION */
BF$WRITE: PROCEDURE (CHAR);
    DECLARE CHAR BYTE;
    IF CHAR = 10 THEN CALL WRITE$CHAR(13);
    CALL WRITE$CHAR(CHAR);
END BF$WRITE;

BF$READ: PROCEDURE BYTE;
    DECLARE EOF$REACHED BYTE INITIAL (0), CH BYTE;
    IF EOF$REACHED THEN RETURN 0;
    CH = READ$CHAR;
    IF CH = 13 THEN RETURN 10;
    ELSE IF CH = 26 THEN DO;
        EOF$REACHED = 1;
        RETURN 0;
    END;
    ELSE RETURN CH;
END BF$READ;

/* EXECUTE COMMANDS */
DECLARE IP ADDRESS, I BASED IP BYTE;
DECLARE EOF$REACHED BYTE INITIAL (0), DEPTH ADDRESS;
DECLARE BRACKET$ERR DATA ('MISMATCHED BRACKETS$');
DECLARE B$OPEN LITERALLY '91', B$CLOSE LITERALLY '93';
IP = .MEMORY + 1;
DO WHILE I <> 26;
    IF      I = '+' THEN M = M + 1;
    ELSE IF I = '-' THEN M = M - 1;
    ELSE IF I = '>' THEN MP = MP + 1;
    ELSE IF I = '<' THEN MP = MP - 1;
    ELSE IF I = '.' THEN CALL BF$WRITE(M);
    ELSE IF I = ',' THEN M = BF$READ;
    ELSE IF I = B$OPEN AND M = 0 THEN DO;
        DEPTH = 1;
        DO WHILE DEPTH > 0;
            IP = IP + 1;
            IF I = B$OPEN THEN DEPTH = DEPTH + 1;
            ELSE IF I = B$CLOSE THEN DEPTH = DEPTH - 1;
            ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
        END;
    END;
    ELSE IF I = B$CLOSE AND M <> 0 THEN DO;
        DEPTH = 1;
        DO WHILE DEPTH > 0;
            IP = IP - 1;
            IF I = B$OPEN THEN DEPTH = DEPTH - 1;
            ELSE IF I = B$CLOSE THEN DEPTH = DEPTH + 1;
            ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
        END;
    END;
    IP = IP + 1;
END;

CALL EXIT;
EOF


const func bigInteger: factorial (in bigInteger: n) is func
  result
    var bigInteger: fact is 1_;
  local
    var bigInteger: i is 0_;
  begin
    for i range 1_ to n do
      fact *:= i;
    end for;
  end func;


' FB 1.05.0 Win64

Enum Animals
  Cat
  Dog
  Zebra
End Enum

Enum Dogs
  Bulldog = 1
  Terrier = 2
  WolfHound = 4
End Enum

Print Cat, Dog, Zebra
Print Bulldog, Terrier, WolfHound
Sleep


window 1, @"Enumerations", (0,0,480,270)

begin enum 1
_apple
_banana
_cherry
end enum

begin enum
_appleExplicit  = 10
_bananaExplicit = 15
_cherryExplicit = 30
end enum

print "_apple = ";  _apple
print "_banana = "; _banana
print "_cherry = "; _cherry
print
print "_appleExplicit = ";  _appleExplicit
print "_bananaExplicit = "; _bananaExplicit
print "_cherryExplicit = "; _cherryExplicit

HandleEvents


enum Fruit { apple, banana, cherry }

enum ValuedFruit {
    apple(1), banana(2), cherry(3);
    def value
    ValuedFruit(val) {value = val}
    String toString() { super.toString() + "(${value})" }
}

println Fruit.values()
println ValuedFruit.values()


# Search for y in 1 .. maxn (inclusive) for a solution to SIGMA (xi ^ 5) = y^5
# and for each solution with x0<=x1<=...<x3, print [x0, x1, x3, x3, y]
#
def sum_of_powers_conjecture(maxn):
  def p5: . as $in | (.*.) | ((.*.) * $in);
  def fifth: log / 5 | exp;

  # return the fifth root if . is a power of 5
  def integral_fifth_root: fifth | if . == floor then . else false end;

  (maxn | p5) as $uber
  | range(1; maxn) as $x0
  | ($x0 | p5) as $s0
  | if $s0 < $uber then range($x0; ($uber - $s0 | fifth) + 1) as $x1
    | ($s0 + ($x1 | p5)) as $s1
    | if $s1 < $uber then range($x1; ($uber - $s1 | fifth) + 1) as $x2
      | ($s1 + ($x2 | p5)) as $s2
        | if $s2 < $uber then range($x2; ($uber - $s2 | fifth) + 1) as $x3
          | ($s2 + ($x3 | p5)) as $sumx
	  | ($sumx | integral_fifth_root)
	  | if . then [$x0,$x1,$x2,$x3,.] else empty end
	  else empty
	  end
      else empty
      end
    else empty
    end ;


const lim = 250
const pwr = 5
const p = [i^pwr for i in 1:lim]

x = zeros(Int, pwr-1)
y = 0

for a in combinations(1:lim, pwr-1)
    b = searchsorted(p, sum(p[a]))
    0 < length(b) || continue
    x = a
    y = b[1]
    break
end

if y == 0
    println("No solution found for power = ", pwr, " and limit = ", lim, ".")
else
    s = [@sprintf("%d^%d", i, pwr) for i in x]
    s = join(s, " + ")
    println("A solution is ", s, " = ", @sprintf("%d^%d", y, pwr), ".")
end


fun main(args: Array<String>) {
    val p5 = LongArray(250){ it.toLong() * it * it * it * it }
    var sum: Long
    var y: Int
    var found = false
    loop@ for (x0 in 0 .. 249)
        for (x1 in 0 .. x0 - 1)
            for (x2 in 0 .. x1 - 1)
                for (x3 in 0 .. x2 - 1) {
                    sum = p5[x0] + p5[x1] + p5[x2] + p5[x3]
                    y = p5.binarySearch(sum)
                    if (y >= 0) {
                        println("$x0^5 + $x1^5 + $x2^5 + $x3^5 = $y^5")
                        found = true
                        break@loop
                    }
                }
    if (!found) println("No solution was found")
}


$ include "seed7_05.s7i";

const string: table is "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";

const func integer: unfitness (in string: a, in string: b) is func
  result
    var integer: sum is 0;
  local
    var integer: index is 0;
  begin
    for index range 1 to length(a) do
      sum +:= ord(a[index] <> b[index]);
    end for;
  end func;

const proc: mutate (in string: a, inout string: b) is func
  local
    var integer: index is 0;
  begin
    b := a;
    for index range 1 to length(a) do
      if rand(1, 15) = 1 then
        b @:= [index] table[rand(1, 27)];
      end if;
    end for;
  end func;

const proc: main is func
  local
     const string: target is "METHINKS IT IS LIKE A WEASEL";
     const integer: OFFSPRING is 30;
     var integer: index is 0;
     var integer: unfit is 0;
     var integer: best is 0;
     var integer: bestIndex is 0;
     var integer: generation is 1;
     var string: parent is " " mult length(target);
     var array string: children is OFFSPRING times " " mult length(target);
  begin
    for index range 1 to length(target) do
      parent @:= [index] table[rand(1, 27)];
    end for;
    repeat
      for index range 1 to OFFSPRING do
        mutate(parent, children[index]);
      end for;
      best := succ(length(parent));
      bestIndex := 0;
      for index range 1 to OFFSPRING do
        unfit := unfitness(target, children[index]);
        if unfit < best then
          best := unfit;
          bestIndex := index;
        end if;
      end for;
      if bestIndex <> 0 then
        parent := children[bestIndex];
      end if;
      writeln("generation " <& generation <& ": score " <& best <& ": " <& parent);
      incr(generation);
    until best = 0;
  end func;


import <Utilities/Sequence.sl>;

AllowedChars := " ABCDEFGHIJKLMNOPQRSTUVWXYZ";

initializeParent(randChars(1)) := AllowedChars[randChars];

Fitness(target(1), current(1)) :=
	let
		fit[i] := true when target[i] = current[i];
	in
		size(fit);

Mutate(letter(0), rate(0), randRate(0), randChar(0)) :=
		letter when randRate > rate
	else
		AllowedChars[randChar];

evolve(target(1), parent(1), C(0), P(0), rateRands(2), charRands(2)) :=
	let
		mutations[i] := Mutate(parent, P, rateRands[i], charRands[i]) foreach i within 1 ... C;
		fitnesses := Fitness(target, mutations);
	in
		mutations[firstIndexOf(fitnesses, vectorMax(fitnesses))];


with javascript_semantics
include mpfr.e
mpz z = mpz_init()
printf(1," i    odd  even  &&1  rmdr(2)\n")
for i=-5 to 5 do
    mpz_set_si(z,i)
    printf(1,"%2d: %5t %5t %3d %5d\n",{i,odd(i),even(i),i&&1,remainder(i,2)})
end for


defmodule Equilibrium do
  def index(list) do
    last = length(list)
    Enum.filter(0..last-1, fn i ->
      Enum.sum(Enum.slice(list, 0, i)) == Enum.sum(Enum.slice(list, i+1..last))
    end)
  end
end


PROGRAM EQUILIBRIUM

DIM LISTA[6]

PROCEDURE EQ(LISTA[]->RES$)
   LOCAL I%,R,S,E$
   FOR I%=0 TO UBOUND(LISTA,1) DO
      S+=LISTA[I%]
   END FOR
   FOR I%=0 TO UBOUND(LISTA,1) DO
      IF R=S-R-LISTA[I%] THEN E$+=STR$(I%)+"," END IF
      R+=LISTA[I%]
   END FOR
   RES$=LEFT$(E$,LEN(E$)-1)
END PROCEDURE

BEGIN
   LISTA[]=(-7,1,5,2,-4,3,0)
   EQ(LISTA[]->RES$)
   PRINT("Equilibrium indices are";RES$)
END PROGRAM


function equilibrium(sequence s)
    integer lower_sum, higher_sum
    sequence indices
    lower_sum = 0
    higher_sum = 0
    for i = 1 to length(s) do
        higher_sum += s[i]
    end for
    indices = {}
    for i = 1 to length(s) do
        higher_sum -= s[i]
        if lower_sum = higher_sum then
            indices &= i
        end if
        lower_sum += s[i]
    end for
    return indices
end function

? equilibrium({-7,1,5,2,-4,3,0})


templates nthFibonacci
  when <=0|=1> do $ !
  otherwise ($ - 1 -> #) + ($ - 2 -> #) !
end nthFibonacci


-- Code based on
-- https://github.com/allisio/pointless/blob/master/lib/examples/brainfuck.ptls

output =
  iterate(run, vm)
  |> takeUntil(isFinished)
  |> map(vm => vm.outVal)
  |> filter(notEq(None))
  |> map(char)
  |> printElems

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

vm = VM {
  ip = 0
  dp = 0
  data = zeroArray(1000)
  inVals = map(ord, readLines)
  outVal = None
}

----------------------------------------------------------
-- "hello.bf" contains brainf*** hello world code

ops = toArray(readFile("hello.bf"))

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

run(vm) = vm |> clearOutput |> eval |> advance

advance(vm)     = vm with $.ip += 1
isFinished(vm)  = vm.ip >= length(ops)
clearOutput(vm) = vm with $.outVal = None

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

jumps = getJumps(0, [], {})

getJumps(i, stack, jumps) = cond {
  case (i == length(ops)) jumps

  case (ops[i] == "[")
    getJumps(i + 1, [i] ++ stack, jumps)

  case (ops[i] == "]")
    getJumps(i + 1, tail(stack), jumps with {
      $[i] = head(stack)
      $[head(stack)] = i
    })

  else getJumps(i + 1, stack, jumps)
}

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

eval(vm) = cond {
  case (op == ">") vm with $.dp += 1
  case (op == "<") vm with $.dp -= 1
  case (op == "+") vm with $.data[vm.dp] += 1
  case (op == "-") vm with $.data[vm.dp] -= 1
  case (op == ".") vm with $.outVal = byte

  case (op == ",") vm with {
    $.data[vm.dp] = head(vm.inVals)
    $.inVals = tail(vm.inVals)
  }

  case (op == "[")
    if byte != 0 then vm
    else (vm with $.ip = jumps[vm.ip])

  case (op == "]")
    if byte == 0 then vm
    else (vm with $.ip = jumps[vm.ip])

  else vm

} where {
  op = ops[vm.ip]
  byte = vm.data[vm.dp]
}


# Where `code` is a string.
bf = (code) :
   tape = (0)
   tape_pos = 0
   brackets = ()
   i = -1
   while (++i < code length) :
      if (code(i) == ">"): if (++tape_pos == tape length): tape append(0)..
      elsif (code(i) == "<"): tape_pos--.
      elsif (code(i) == "+"): tape(tape_pos) = tape(tape_pos) + 1.
      elsif (code(i) == "-"): tape(tape_pos) = tape(tape_pos) - 1.
      elsif (code(i) == "."): tape(tape_pos) chr print.
      elsif (code(i) == ","): tape(tape_pos) = read at(0) ord.
      elsif (code(i) == "["): brackets push(i).
      elsif (code(i) == "]") :
         if (tape(tape_pos) == 0): brackets pop.
         else: i = brackets(-1).
      .
   .
.


/*REXX program shows how to get an environmental variable under Windows*/

x=value('TEMP',,'SYSTEM')


' ------- Major environment variables -------------------------------------------
'DefaultDir$    - The folder path where program files are read/written by default
'Platform$      - The operating system on which Run BASIC is being hosted
'UserInfo$      - This is information about the user's web browser
'UrlKeys$       - Contains informational parameters from the URL submitted when the user connected
'UserAddress$   - Contains the IP address of the user
'ProjectsRoot$  - The folder path where Run BASIC keeps programming projects
'ResourcesRoot$ - The folder path where Run BASIC keeps web-servable files
'Err$           - A description of the last runtime error
'Err            - A numeric code for the last runtime error (errors that have no code use zero)
'EventKey$      - The id of the object that generated the last user event
'RowIndex       - The numeric index of the table or database accessor link that generated the last user event

print "User Info is   : ";UserInfo$
print "Platform is    : ";Platform$
print "Url Keys is    : ";UrlKeys$
print "User Address is: ";UserAddress$
print "Event Key is   : ";EventKey$
print "Default Dir is : ";DefaultDir$


use std::env;

fn main() {
    println!("{:?}", env::var("HOME"));
    println!();
    for (k, v) in env::vars().filter(|(k, _)| k.starts_with('P')) {
        println!("{}: {}", k, v);
    }
}


$ include "seed7_05.s7i";

const proc: main is func
  begin
    writeln(getenv("HOME"));
  end func;


Environment variables at: 'PATH'.
"==> '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games'"


data Fruit = Apple | Banana | Cherry deriving Enum


enum FRUIT {
  APPLE,
  BANANA,
  CHERRY
}


  fruits := [ "apple", "banana", "cherry", "apple" ]  # a list keeps ordered data
  fruits := set("apple", "banana", "cherry")          # a set keeps unique data
  fruits := table()                                   # table keeps an unique data with values
  fruits["apple"]  := 1
  fruits["banana"] := 2
  fruits["cherry"] := 3


Fruit is a kind of value. The fruits are apple, banana, and cherry.


   enum =: cocreate''
   ( (;:'apple banana cherry') ,L:0 '__enum' ) =: i. 3
   cherry__enum
2


-- Fast table search (only works if table values are in order)
function binarySearch (t, n)
    local start, stop, mid = 1, #t
    while start < stop do
        mid = math.floor((start + stop) / 2)
        if n == t[mid] then
            return mid
        elseif n < t[mid] then
            stop = mid - 1
        else
            start = mid + 1
        end
    end
    return nil
end

-- Test Euler's sum of powers conjecture
function euler (limit)
    local pow5, sum = {}
    for i = 1, limit do pow5[i] = i^5 end
    for x0 = 1, limit do
        for x1 = 1, x0 do
            for x2 = 1, x1 do
                for x3 = 1, x2 do
                    sum = pow5[x0] + pow5[x1] + pow5[x2] + pow5[x3]
                    if binarySearch(pow5, sum) then
                        print(x0 .. "^5 + " .. x1 .. "^5 + " .. x2 .. "^5 + " .. x3 .. "^5 = " .. sum^(1/5) .. "^5")
                        return true
                    end
                end
            end
        end
    end
    return false
end

-- Main procedure
if euler(249) then
    print("Time taken: " .. os.clock() .. " seconds")
else
    print("Looks like he was right after all...")
end


define target = "METHINKS IT IS LIKE A WEASEL"
define mutate_chance = 0.08
define alphabet = [('A'..'Z')..., ' ']
define C = 100

func fitness(str) { str.chars ~Z== target.chars -> count(true) }
func mutate(str)  { str.gsub(/(.)/, {|s1| 1.rand < mutate_chance ? alphabet.pick : s1 }) }

for (
    var (i, parent) = (0, alphabet.rand(target.len).join);
    parent != target;
    parent = C.of{ mutate(parent) }.max_by(fitness)
) { printf("%6d: '%s'\n", i++, parent) }


-5 5 2 tolist for
    dup print " " print 2 mod if "Odd" else "Even" endif print nl
endfor


// using bitwise and to check least significant digit
echo (2 & 1) ? 'odd' : 'even';
echo (3 & 1) ? 'odd' : 'even';

// using modulo
echo (3 % 2) ? 'odd' : 'even';
echo (4 % 2) ? 'odd' : 'even';


% Bitwise and
is_even_bitwise(I) = cond(I /\ 1 == 0, true, false).

% Modulo
is_even_mod(I) = cond(I mod 2 == 0, true, false).

% Remainder
is_even_rem(I) = cond(I rem 2 == 0, true, false).

yes_or_no(B) = YN =>
    B = true, YN = "Yes";
    B = false, YN = "No".

main :-
    foreach (I in 2..3)
        printf("%d is even? %s\n", I, yes_or_no(is_even_bitwise(I))),
        printf("%d is even? %s\n", I, yes_or_no(is_even_mod(I))),
        printf("%d is even? %s\n", I, yes_or_no(is_even_rem(I)))
    end.


USE: math.vectors
: accum-left ( seq id quot -- seq ) accumulate nip ; inline
: accum-right ( seq id quot -- seq ) [ <reversed> ] 2dip accum-left <reversed> ; inline
: equilibrium-indices ( seq -- inds )
  0 [ + ] [ accum-left ] [ accum-right ] 3bi [ = ] 2map
  V{ } swap dup length iota [ [ suffix ] curry [ ] if ] 2each ;


program Equilibrium
  implicit none

  integer :: array(7) = (/ -7, 1, 5, 2, -4, 3, 0 /)

  call equil_index(array)

contains

subroutine equil_index(a)
  integer, intent(in) :: a(:)
  integer :: i

  do i = 1, size(a)
    if(sum(a(1:i-1)) == sum(a(i+1:size(a)))) write(*,*) i
  end do

end subroutine
end program


' FB 1.05.0 Win64

Sub equilibriumIndices (a() As Integer, b() As Integer)
  If UBound(a) = -1 Then Return  '' empty array

  Dim sum As Integer = 0
  Dim count As Integer = 0
  For i As Integer = LBound(a) To UBound(a) : sum += a(i) : Next
  Dim sumLeft As Integer = 0, sumRight As Integer = 0

  For i As Integer = LBound(a) To UBound(a)
     sumRight = sum - sumLeft - a(i)
     If sumLeft = sumRight Then
       Redim Preserve b(0 To Count)
       b(count) = i
       count += 1
     End If
     sumLeft += a(i)
  Next
End Sub

Dim a(0 To 6) As Integer = { -7, 1, 5, 2, -4, 3, 0 }
Dim b() As Integer
equilibriumIndices a(), b()
If UBound(b) = -1 Then
  Print "There are no equilibrium indices"
ElseIf UBound(b) = LBound(b) Then
  Print "The only equilibrium index is : "; b(LBound(b))
Else
  Print "The equilibrium indices are : "
  For i As Integer = LBound(b) To UBound(b) : Print b(i); " "; : Next
End If

Print
Print "Press any key to quit"
Sleep


proc fibiter n {
    if {$n < 2} {return $n}
    set prev 1
    set fib 1
    for {set i 2} {$i < $n} {incr i} {
        lassign [list $fib [incr fib $prev]] prev fib
    }
    return $fib
}


/******************************************
 Starting point, call with program in atom.
*******************************************/
brain(Program) :-
	atom_chars(Program, Instructions),
	process_bf_chars(Instructions).

brain_from_file(File) :- % or from file...
	read_file_to_codes(File, Codes, []),
	maplist(char_code, Instructions, Codes),
	process_bf_chars(Instructions).

process_bf_chars(Instructions)	:-
	phrase(bf_to_pl(Code), Instructions, []),
	Code = [C|_],
	instruction(C, Code, mem([], [0])), !.

/********************************************
 DCG to parse the bf program into prolog form
*********************************************/
bf_to_pl([]) --> [].
bf_to_pl([loop(Ins)|Next]) --> loop_start, bf_to_pl(Ins), loop_end, bf_to_pl(Next).
bf_to_pl([Ins|Next]) --> bf_code(Ins), bf_to_pl(Next).
bf_to_pl(Ins) --> [X], { \+ member(X, ['[',']',>,<,+,-,'.',',']) }, bf_to_pl(Ins). % skip non bf characters

loop_start --> ['['].
loop_end --> [']'].

bf_code(next_addr) --> ['>'].
bf_code(prev_addr) --> ['<'].
bf_code(inc_caddr) --> ['+'].
bf_code(dec_caddr) --> ['-'].
bf_code(out_caddr) --> ['.'].
bf_code(in_caddr)  --> [','].

/**********************
  Instruction Processor
***********************/
instruction([], _, _).
instruction(I, Code, Mem) :-
	mem_instruction(I, Mem, UpdatedMem),
	next_instruction(Code, NextI, NextCode),
	!, % cuts are to force tail recursion, so big programs will run
	instruction(NextI, NextCode, UpdatedMem).

% to loop, add the loop code to the start of the program then execute
% when the loop has finished it will reach itself again then can retest for zero
instruction(loop(LoopCode), Code, Mem) :-
	caddr(Mem, X),
	dif(X, 0),
	append(LoopCode, Code, [NextI|NextLoopCode]),
	!,
	instruction(NextI, [NextI|NextLoopCode], Mem).
instruction(loop(_), Code, Mem) :-
	caddr(Mem, 0),
	next_instruction(Code, NextI, NextCode),
	!,
	instruction(NextI, NextCode, Mem).

% memory is stored in two parts:
%   1. a list with the current address and everything after it
%   2. a list with the previous memory in reverse order
mem_instruction(next_addr, mem(Mb, [Caddr]), mem([Caddr|Mb], [0])).
mem_instruction(next_addr, mem(Mb, [Caddr,NextAddr|Rest]), mem([Caddr|Mb], [NextAddr|Rest])).
mem_instruction(prev_addr, mem([PrevAddr|RestOfPrev], Caddrs), mem(RestOfPrev, [PrevAddr|Caddrs])).

% wrap instructions at the byte boundaries as this is what most programmers expect to happen
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, 255), update_caddr(MemIn, 0, MemOut).
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(Val, IncVal), update_caddr(MemIn, IncVal, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, 0), update_caddr(MemIn, 255, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(DecVal, Val), update_caddr(MemIn, DecVal, MemOut).

% input and output
mem_instruction(out_caddr, Mem, Mem) :- caddr(Mem, Val), char_code(Char, Val), write(Char).
mem_instruction(in_caddr, MemIn, MemOut) :-
	get_single_char(Code),
	char_code(Char, Code),
	write(Char),
	map_input_code(Code,MappedCode),
	update_caddr(MemIn, MappedCode, MemOut).

% need to map the newline if it is not a proper newline character (system dependent).
map_input_code(13,10) :- nl.
map_input_code(C,C).

% The value at the current address
caddr(mem(_, [Caddr]), Caddr).
caddr(mem(_, [Caddr,_|_]), Caddr).

% The updated value at the current address
update_caddr(mem(BackMem, [_]), Caddr, mem(BackMem, [Caddr])).
update_caddr(mem(BackMem, [_,M|Mem]), Caddr, mem(BackMem, [Caddr,M|Mem])).

% The next instruction, and remaining code
next_instruction([_], [], []).
next_instruction([_,NextI|Rest], NextI, [NextI|Rest]).


$ Recursive
proc fact(n);
    if (n < 2) then
        return 1;
    else
        return n * fact(n - 1);
    end if;
end proc;

$ Iterative
proc factorial(n);
    v := 1;
    for i in {2..n} loop
        v *:= i;
    end loop;
    return v;
end proc;


(define factorial
    0 -> 1
    X -> (* X (factorial (- X 1))))


OSProcess thisOSProcess environment at: #HOME.
OSProcess thisOSProcess environment at: #PATH.
OSProcess thisOSProcess environment at: #USER.


display "`:env PATH'"
display "`:env USERNAME'"
display "`:env USERPROFILE'"


print("USER: \(ProcessInfo.processInfo.environment["USER"] ?? "Not set")")
print("PATH: \(ProcessInfo.processInfo.environment["PATH"] ?? "Not set")")


ASK #1: ACCESS TYPE$
ASK BACK red
ASK COLOR red
ASK COLOR MIX (2) red, green, blue
ASK CURSOR vble1, vble2
ASK #2: DATUM TYPE$
ASK DIRECTORY dir$
ASK #3: ERASABLE TYPE$
ASK #4: FILESIZE vble09
ASK #5: FILETYPE vble10
ASK FREE MEMORY vble11
ASK #61: MARGIN vble12
ASK MAX COLOR vble13
ASK MAX CURSOR vble1, vble2
ASK MODE vble15$
ASK NAME vble16$
ASK #7: ORGANIZATION vble17$
ASK PIXELS vble1, vble2
ASK #8: POINTER vble19$
ASK #9: RECORD vble20
ASK #1: RECSIZE vble21
ASK #2: RECTYPE vble22$
ASK SCREEN vble1, vble2, vble3, vble4
ASK #3: SETTER vble24$
ASK TEXT JUSTIFY vble1$, vble2$
ASK WINDOW vble1, vble2, vble3, vble4
ASK #4: ZONEWIDTH vble27


@(next :env)
@(collect)
@[email protected]
@(end)


// enum fruits { apple, banana, cherry }

var f = "apple";

if(f == "apple"){
    f = "banana";
}


enum fruits { apple, banana, cherry }
enum fruits { apple = 0, banana = 1, cherry = 2 }


{"fruits" : { "apple" : null, "banana" : null, "cherry" : null }
{"fruits" : { "apple" : 0, "banana" : 1, "cherry" : 2 }


// version 1.0.5-2

enum class Animals {
    CAT, DOG, ZEBRA
}

enum class Dogs(val id: Int) {
    BULLDOG(1), TERRIER(2), WOLFHOUND(4)
}

fun main(args: Array<String>) {
    for (value in Animals.values()) println("${value.name.padEnd(5)} : ${value.ordinal}")
    println()
    for (value in Dogs.values()) println("${value.name.padEnd(9)} : ${value.id}")
}


' Euler sum of powers conjecture - 03/07/2015
  'find: x1^5+x2^5+x3^5+x4^5=x5^5
  '-> x1=27 x2=84 x3=110 x4=133 x5=144
  maxn=250
  For i=1 to maxn
	p5[i]=Math.Power(i,5)
  EndFor
  For x1=1 to maxn-4
    For x2=x1+1 to maxn-3
      'TextWindow.WriteLine("x1="+x1+", x2="+x2)
      For x3=x2+1 to maxn-2
        'TextWindow.WriteLine("x1="+x1+", x2="+x2+", x3="+x3)
        For x4=x3+1 to maxn-1
          'TextWindow.WriteLine("x1="+x1+", x2="+x2+", x3="+x3+", x4="+x4)
          x5=x4+1
          valx=p5[x5]
          sumx=p5[x1]+p5[x2]+p5[x3]+p5[x4]
          While x5<=maxn and valx<=sumx
            If valx=sumx Then
              TextWindow.WriteLine("Found!")
              TextWindow.WriteLine("-> "+x1+"^5+"+x2+"^5+"+x3+"^5+"+x4+"^5="+x5+"^5")
              TextWindow.WriteLine("x5^5="+sumx)
              Goto EndPgrm
            EndIf
            x5=x5+1
            valx=p5[x5]
          EndWhile 'x5
        EndFor 'x4
      EndFor 'x3
    EndFor 'x2
  EndFor 'x1
 EndPgrm:


MODULE EulerConjecture;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE Pow5(a : LONGINT) : LONGINT;
BEGIN
    RETURN a * a * a * a * a
END Pow5;

VAR
    buf : ARRAY[0..63] OF CHAR;
    a,b,c,d,e,sum,curr : LONGINT;
BEGIN
    FOR a:=0 TO 250 DO
        FOR b:=a TO 250 DO
            IF b=a THEN CONTINUE END;
            FOR c:=b TO 250 DO
                IF (c=a) OR (c=b) THEN CONTINUE END;
                FOR d:=c TO 250 DO
                    IF (d=a) OR (d=b) OR (d=c) THEN CONTINUE END;
                    sum := Pow5(a) + Pow5(b) + Pow5(c) + Pow5(d);
                    FOR e:=d TO 250 DO
                        IF (e=a) OR (e=b) OR (e=c) OR (e=d) THEN CONTINUE END;
                        curr := Pow5(e);
                        IF (sum#0) AND (sum=curr) THEN
                            FormatString("%l^5 + %l^5 + %l^5 + %l^5 = %l^5\n", buf, a, b, c, d, e);
                            WriteString(buf)
                        ELSIF curr > sum THEN
                            BREAK
                        END
                    END;
                END;
            END;
        END;
    END;

    WriteString("Done");
    WriteLn;
    ReadChar
END EulerConjecture.


 10 LET A$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
 20 LET T$="METHINKS IT IS LIKE A WEASEL"
 30 LET L=LEN T$
 40 LET C=10
 50 LET M=0.05
 60 LET G=0
 70 DIM C$(C,L)
 80 LET P$=""
 90 FOR I=1 TO L
100 LET P$=P$+A$(INT (RND*LEN A$)+1)
110 NEXT I
120 PRINT AT 1,0;P$
130 LET S$=P$
140 GOSUB 390
150 LET N=R
160 PRINT AT 1,30;N
170 PRINT AT 0,4;G
180 IF P$=T$ THEN GOTO 440
190 FOR I=1 TO C
200 FOR J=1 TO L
210 LET C$(I,J)=P$(J)
220 IF RND<=M THEN LET C$(I,J)=A$(INT (RND*LEN A$)+1)
230 PRINT AT I+2,J-1;C$(I,J)
240 NEXT J
250 PRINT AT I+2,30;"  "
260 NEXT I
270 LET F=0
280 FOR I=1 TO C
290 LET S$=C$(I)
300 GOSUB 390
310 PRINT AT I+2,30;R
320 IF R>N THEN LET F=I
330 IF R>N THEN LET N=R
340 NEXT I
350 IF F>0 THEN LET P$=C$(F)
360 LET G=G+1
370 PRINT AT 1,0;P$
380 GOTO 160
390 LET R=0
400 FOR K=1 TO L
410 IF S$(K)=T$(K) THEN LET R=R+1
420 NEXT K
430 RETURN


String subclass: Mutant [
    <shape: #character>

    Target := Mutant from: 'METHINKS IT IS LIKE A WEASEL'.
    Letters := ' ABCDEFGHIJKLMNOPQRSTUVWXYZ'.

    Mutant class >> run: c rate: p
        ["Run Evolutionary algorighm, using c copies and mutate rate p."
        | pool parent |
        parent := self newRandom.
        pool := Array new: c+1.

        [parent displayNl.
        parent = Target] whileFalse:
            [1 to: c do: [:i | pool at: i put: (parent copy mutate: p)].
            pool at: c+1 put: parent.
            parent := pool fold: [:winner :each | winner fittest: each]]]

    Mutant class >> newRandom
        [^(self new: Target size)
            initializeToRandom;
            yourself]

    initializeToRandom
        [self keys do: [:i | self at: i put: self randomLetter]]

    mutate: p
        [self keys do:
            [:i |
            Random next <= p ifTrue: [self at: i put: self randomLetter]]]

    fitness
        [| score |
        score := 0.
        self with: Target do:
            [:me :you |
            me = you ifTrue: [score := score + 1]].
        ^score]

    fittest: aMutant
        [^self fitness > aMutant fitness
            ifTrue: [self]
            ifFalse: [aMutant]]

    randomLetter
        [^Letters at: (Random between: 1 and: Letters size)]
]


package main

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

func main() {
    fmt.Println(ex([]int32{-7, 1, 5, 2, -4, 3, 0}))

    // sequence of 1,000,000 random numbers, with values
    // chosen so that it will be likely to have a couple
    // of equalibrium indexes.
    rand.Seed(time.Now().UnixNano())
    verylong := make([]int32, 1e6)
    for i := range verylong {
        verylong[i] = rand.Int31n(1001) - 500
    }
    fmt.Println(ex(verylong))
}

func ex(s []int32) (eq []int) {
    var r, l int64
    for _, el := range s {
        r += int64(el)
    }
    for i, el := range s {
        r -= int64(el)
        if l == r {
            eq = append(eq, i)
        }
        l += int64(el)
    }
    return
}


func fib(n) {
   if (n < 2) {
      return 1;
   }
   return fib(n - 1) + fib(n - 2);
}


  [ stack ]                                        is switch.arg (       --> [     )

  [ switch.arg put ]                               is switch     (     x -->       )

  [ switch.arg release ]                           is otherwise  (       -->       )

  [ switch.arg share != iff ]else[ done
    otherwise  ]'[ do ]done[ ]                     is case       (     x -->       )

  [ dip tuck unrot poke swap ]                     is poketape   ( [ n n --> [ n   )

  [ 1+ over size over = if [ dip [ 0 join ] ] ]    is stepright  (   [ n --> [ n   )

  [ dup 0 = iff [ 0 rot join swap ] else [ 1 - ] ] is stepleft   (   [ n --> [ n   )

  [ 2dup peek 1 + poketape ]                       is increment  (   [ n --> [ n   )

  [ 2dup peek 1 - poketape ]                       is decrement  (   [ n --> [ n   )

  [ 2dup peek emit ]                               is print      (   [ n --> [ n   )

  [ temp take dup $ "" = iff 0 else behead
    swap temp put poketape ]                       is getchar    (   [ n --> [ n   )

  [ 2dup peek 0 = ]                                is zero       (   [ n --> [ n b )

  [ temp put $ "" swap witheach
      [ switch
        [ char > case [ $ "stepright "      join ]
          char < case [ $ "stepleft "       join ]
          char + case [ $ "increment "      join ]
          char - case [ $ "decrement "      join ]
          char . case [ $ "print "          join ]
          char , case [ $ "getchar "        join ]
          char [ case [ $ "[ zero if done " join ]
          char ] case [ $ "zero until ] "   join ]
          otherwise ( ignore ) ] ]
    0 nested 0 rot quackery temp release 2drop ]   is brainf***  (   $ $ -->       )


func factorial_recursive(n) {
    n == 0 ? 1 : (n * __FUNC__(n-1))
}


begin
    integer procedure factorial(n);
    integer n;
    begin
        integer fact, i;
        fact := 1;
        for i := 2 step 1 until n do
            fact := fact * i;
        factorial := fact
    end;
    integer f; outtext("factorials:"); outimage;
    for f := 0, 1, 2, 6, 9 do begin
        outint(f, 2); outint(factorial(f), 8); outimage
    end
end


import "system"
out (system.getenv "HOME") endl console


#import std

#executable ('parameterized','')

showenv = <.file$[contents: --<''>]>+ %smP+ ~&n-={'TERM','SHELL','X11BROWSER'}*~+ ~environs


// Environment variables in V
// v run environment_variables.v
module main

import os

pub fn main() {
    print('In the $os.environ().len environment variables, ')
    println('\$HOME is set to ${os.getenv('HOME')}')
}


/* environment_variables.wren */
class Environ {
    foreign static variable(name)
}

System.print(Environ.variable("SHELL"))


include c:\cxpl\codes;          \intrinsic 'code' declarations
string 0;                       \use zero-terminated strings
int  CpuReg, PspSeg, EnvSeg, I, J, C;
char EnvVar;
[CpuReg:= GetReg;               \access CPU registers
PspSeg:= CpuReg(9);             \get segment address of our PSP
EnvSeg:= Peek(PspSeg,$2C) + Peek(PspSeg,$2D)<<8;
EnvVar:= "PATH";                \environment variable
I:= 0;
loop    [J:= 0;
        loop    [C:= Peek(EnvSeg,I);  I:= I+1;
                if C = 0 then quit;
                if C = EnvVar(J) then
                        [J:= J+1;
                        if J = 4 then
                                [Text(0, EnvVar);               \show env. var.
                                loop    [C:= Peek(EnvSeg,I);    \ and rest of
                                        I:= I+1;                \ its string
                                        if C = 0 then exit;
                                        ChOut(0, C);
                                        ];
                                ];
                        ]
                else J:= 5;     \line must start with environment variable
                ];
        if Peek(EnvSeg,I) = 0 then quit;        \double 0 = env. var. not found
        ];
]


System.getenv("HOME")
/home/craigd
System.getenv() //--> Dictionary of all env vars


-- parent script "Enumeration"

property ancestor

on new (me)
  data = [:]
  repeat with i = 2 to the paramCount
    data[param(i)] = i-1
  end repeat
  me.ancestor = data
  return me
end

on setAt (me)
  -- do nothing
end

on setProp (me)
  -- do nothing
end

on deleteAt (me)
  -- do nothing
end

on deleteProp (me)
  -- do nothing
end

on addProp (me)
  -- do nothing
end


local fruit = {apple = 0, banana = 1, cherry = 2}


Module Checkit {
      \\ need revision 15, version 9.4
      Enum Fruit  {apple, banana, cherry}
      Enum Fruit2  {apple2=10, banana2=20, cherry2=30}
      Print apple, banana, cherry
      Print apple2, banana2, cherry2
      Print Len(apple)=0
      Print Len(banana)=1
      Print Len(cherry)=2
      Print Len(cherry2)=2, Cherry2=30, Type$(Cherry2)="Fruit2"

      k=each(Fruit)
      While k {
            \\ name of variable, value, length from first (0, 1, 2)
            Print Eval$(k), Eval(k), k^
      }
      m=apple
      Print Eval$(m)="apple"
      Print Eval(m)=m
      m++
      Print Eval$(m)="banana"
      Try {
            \\ error, m is an object
            m=100
      }
      Try {
            \\ error not the same type
            m=apple2
      }
      Try {
            \\ read only can't change
            apple2++
      }
      m++
      Print Eval$(m)="cherry", m
      k=Each(Fruit2 end to start)
      While k {
             Print Eval$(k), Eval(k) , k^
             CheckByValue(Eval(k))
      }
      m2=apple2
      Print "-------------------------"
      CheckByValue(m2)
      CheckByReference(&m2)
      Print m2

      Sub CheckByValue(z as Fruit2)
            Print Eval$(z), z
      End Sub

      Sub CheckByReference(&z as Fruit2)
            z++
            Print Eval$(z), z
      End Sub
}
Checkit


define(`enums',
   `define(`$2',$1)`'ifelse(eval($#>2),1,`enums(incr($1),shift(shift([email protected])))')')
define(`enum',
   `enums(1,[email protected])')
enum(a,b,c,d)
`c='c


# Brute force approach

import times

# assumes an array of non-decreasing positive integers
proc binarySearch(a : openArray[int], target : int) : int =
  var left, right, mid : int
  left = 0
  right = len(a) - 1
  while true :
    if left > right : return 0  # no match found
    mid = (left + right) div 2
    if a[mid] < target :
      left = mid + 1
    elif a[mid] > target :
      right = mid - 1
    else :
      return mid  # match found

var
  p5 : array[250, int]
  sum = 0
  y, t1 : int

let t0 = cpuTime()

for i in 1 .. 249 :
  p5[i] = i * i * i * i * i

for x0 in 1 .. 249 :
  for x1 in 1 .. x0 - 1 :
    for x2 in 1 .. x1 - 1 :
      for x3 in 1 .. x2 - 1 :
        sum = p5[x0] + p5[x1] + p5[x2] + p5[x3]
        y = binarySearch(p5, sum)
        if y > 0 :
          t1 = int((cputime() - t0) * 1000.0)
          echo "Time : ", t1, " milliseconds"
          echo  $x0 & "^5 + " & $x1 & "^5 + " & $x2 & "^5 + " & $x3 & "^5 = " & $y & "^5"
          quit()

if y == 0 :
  echo "No solution was found"


: eulerSum
| i j k l ip jp kp |
   250 loop: i [
      i 5 pow ->ip
      i 1 + 250 for: j [
         j 5 pow ip + ->jp
         j 1 + 250 for: k [
            k 5 pow jp + ->kp
            k 1 + 250 for: l [
               kp l 5 pow + 0.2 powf dup asInteger == ifTrue: [ [ i, j, k, l ] println ]
              ]
            ]
         ]
      ] ;


func evolve(
  to target: String,
  parent: inout String,
  mutationRate: Int,
  copies: Int
) {
  var parentFitness: Int {
    return fitness(target: target, sentence: parent)
  }

  var generation = 0

  while parent != target {
    generation += 1

    let bestOfGeneration =
        (0..<copies)
          .map({_ in mutate(sentence: parent, rate: mutationRate) })
          .map({ (fitness(target: target, sentence: $0), $0) })
          .sorted(by: { $0.0 < $1.0 })
          .first!

    if bestOfGeneration.0 < parentFitness {
      print("Gen \(generation) produced better fit. \(bestOfGeneration.1) with fitness \(bestOfGeneration.0)")
      parent = bestOfGeneration.1
    }
  }
}

func fitness(target: String, sentence: String) -> Int {
  return zip(target, sentence).filter(!=).count
}

func mutate(sentence: String, rate: Int) -> String {
  return String(
    sentence.map({char in
      if Int.random(in: 1...100) - rate <= 0 {
        return "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".randomElement()!
      } else {
        return char
      }
    })
  )
}

let target = "METHINKS IT IS LIKE A WEASEL"
let copies = 100
let mutationRate = 20

var start = mutate(sentence: target, rate: 100)

print("target: \(target)")
print("Gen 0: \(start) with fitness \(fitness(target: target, sentence: start))")

evolve(to: target, parent: &start, mutationRate: mutationRate, copies: 100)


def alphabet: [' ABCDEFGHIJKLMNOPQRSTUVWXYZ'...];
def target: ['METHINKS IT IS LIKE A WEASEL'...];
def generationSize: 100;
def mutationPercent: 10;

source randomCharacter
  $alphabet::length -> SYS::randomInt -> $alphabet($+1)!
end randomCharacter

templates countFitness
  @:0;
  $ -> \[i](when <=$target($i)> do @countFitness: [email protected] + 1; \) -> !VOID
  { candidate: $, fitness: [email protected] } !
end countFitness

sink evolve
  @: {generation: 0"1", parent: $};
  [email protected] -> #
  when <{fitness: <=$target::length>}> do
    'Target "$target...;" reached after [email protected]; generations' -> !OUT::write
  otherwise
    'Fitness $.fitness; at generation [email protected];: "$.candidate...;"$#10;' -> !OUT::write
    @.generation: [email protected] + 1"1";
    1..$generationSize -> [[email protected] -> \(
      when <?(100 -> SYS::randomInt <..~$mutationPercent>)> do $randomCharacter!
      otherwise $!
    \)] -> countFitness -> \(when <{fitness: <[email protected]>}> do @evolve.parent: $;\) -> !VOID
    [email protected] -> #
end evolve

[1..$target::length -> $randomCharacter] -> countFitness -> !evolve


100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PUT$CHAR: PROCEDURE (CH); DECLARE CH BYTE; CALL BDOS(2, CH); END PUT$CHAR;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9, S); END PRINT;

DECLARE I BYTE;
DO I='0' TO '9';
    CALL PUT$CHAR(I);
    CALL PRINT(.' IS $');
    IF I THEN
        CALL PRINT(.'ODD$');
    ELSE
        CALL PRINT(.'EVEN$');
    CALL PRINT(.(13,10,'$'));
END;

CALL EXIT;
EOF


To run:
Start up.
If 56 is even, write "56 is even!" to the console.
If 4 is odd, write "4 is odd!" to the console.
Wait for the escape key.
Shut down.


$IsOdd  = -not ( [bigint]$N ).IsEven
$IsEven =      ( [bigint]$N ).IsEven


import System.Random (randomRIO)
import Data.List (findIndices, takeWhile)
import Control.Monad (replicateM)
import Control.Arrow ((&&&))

equilibr xs =
  findIndices (\(a, b) -> sum a == sum b) . takeWhile (not . null . snd) $
  flip ((&&&) <$> take <*> (drop . pred)) xs <$> [1 ..]

langeSliert = replicateM 2000 (randomRIO (-15, 15) :: IO Int) >>= print . equilibr


procedure main(arglist)
L := if *arglist > 0 then arglist else [-7, 1, 5, 2, -4, 3, 0]   # command line args or default
every writes( "equilibrium indicies of [ " | (!L ||" ") | "] = " | (eqindex(L)||" ") | "\n" )
end

procedure eqindex(L) # generate equilibrium points in a list L or fail
local s,l,i

every (s := 0, i := !L) do
   s +:= numeric(i) | fail              # sum and validate

every (l := 0, i := 1 to *L) do {
   if l = (s-L[i])/2 then suspend i
   l +:= L[i]                           # sum of left side
   }
end


rebol [Title: "Brainfuck interpreter"]

tape: make object! [
    pos: 1
    data: [0]
    inc: does [
        data/:pos: data/:pos + 1
    ]
    dec: does [
        data/:pos: data/:pos - 1
    ]
    advance: does [
        pos: pos + 1
        if (length? data) <= pos [
            append data 0
        ]
    ]
    devance: does [
        if pos > 1 [
            pos: pos - 1
        ]
    ]
    get: does [
        data/:pos
    ]
]

brainfuck: make object! [
    data: string!
    code: ""
    init: func [instr] [
        self/data: instr
    ]
    bracket-map: func [text] [
        leftstack: []
        bm: make map! []
        pc: 1
        for i 1 (length? text) 1 [
            c: text/:i
            if not find "+-<>[].," c [
                continue
            ]
            if c == #"[" [
                append leftstack pc
            ]
            if c == #"]" & ((length? leftstack) > 0) [
                left: last leftstack
                take/last leftstack
                append bm reduce [left pc]
                append bm reduce [pc left]
            ]
            append code c
            pc: pc + 1
        ]
            return bm
    ]
    run: function [] [
        pc: 0
        tp: make tape []
        bm: bracket-map self/data
        while [pc <= (length? code)] [
            switch/default code/:pc [
                #"+" [tp/inc]
                #"-" [tp/dec]
                #">" [tp/advance]
                #"<" [tp/devance]
                #"[" [if tp/get == 0 [
                    pc: bm/:pc
                ]]
                #"]" [if tp/get != 0 [
                    pc: bm/:pc
                ]]
                #"." [prin to-string to-char tp/get]
                    ] []
                    pc: pc + 1
                ]
                print newline
    ]
]

bf: make brainfuck []
bf/init input
bf/run


define main

function main(x : integer returns integer)

  for a in 1, x
    returns
      value of product a
  end for

end function


[email protected](Integer traits) factorial
"The standard recursive definition."
[
  n isNegative ifTrue: [error: 'Negative inputs to factorial are invalid.'].
  n <= 1
    ifTrue: [1]
    ifFalse: [n * ((n - 1) factorial)]
].


System.getenv("HOME")
/home/craigd
System.getenv() //--> Dictionary of all env vars


vardef enum(expr first)(text t) =
save ?; ? := first;
forsuffixes e := t: e := ?; ?:=?+1; endfor
enddef;


enum Fruit {
    |apple
    |banana
    |cherry
}

enum Season {
    |winter = 1
    |spring = 2
    |summer = 3
    |autumn = 4
}


# Simple declaration.
type Fruits1 = enum aApple, aBanana, aCherry

# Specifying values (accessible using "ord").
type Fruits2 = enum bApple = 0, bBanana = 2, bCherry = 5

# Enumerations with a scope which prevent name conflict.
type Fruits3 {.pure.} = enum Apple, Banana, Cherry
type Fruits4 {.pure.} = enum Apple = 3, Banana = 8, Cherry = 10
var x = Fruits3.Apple  # Need to qualify as there are several possible "Apple".

# Using vertical presentation and specifying string representation.
type Fruits5 = enum
  cApple = "Apple"
  cBanana = "Banana"
  cCherry = "Cherry"
echo cApple   # Will display "Apple".

# Specifying values and/or string representation.
type Fruits6 = enum
  Apple = (1, "apple")
  Banana = 3            # implicit name is "Banana".
  Cherry = "cherry"     # implicit value is 4.


enum Color := -3 {
  Red,
  White,
  Blue
}

enum Dog {
  Pug,
  Boxer,
  Terrier
}


typedef NS_ENUM(NSInteger, fruits) { apple, banana, cherry };

typedef NS_ENUM(NSInteger, fruits) { apple = 0, banana = 1, cherry = 2 };


type fruit =
  | Apple
  | Banana
  | Cherry


program Pot5Test;
{$IFDEF FPC} {$MODE DELPHI}{$ELSE]{$APPTYPE CONSOLE}{$ENDIF}
type
  tTest = double;//UInt64;{ On linux 32Bit double is faster than  Uint64 }
var
  Pot5 : array[0..255] of tTest;
  res,tmpSum : tTest;
  x0,x1,x2,x3, y : NativeUint;//= Uint32 or 64 depending on OS xx-Bit
  i : byte;
BEGIN
  For i := 1 to 255 do
    Pot5[i] := (i*i*i*i)*Uint64(i);

  For x0 := 1 to 250-3 do
    For x1 := x0+1 to 250-2 do
      For x2 := x1+1 to 250-1 do
      Begin
        //set y here only, because pot5 is strong monoton growing,
        //therefor the sum is strong monoton growing too.
        y := x2+2;// aka x3+1
        tmpSum := Pot5[x0]+Pot5[x1]+Pot5[x2];
        For x3 := x2+1 to 250 do
        Begin
          res := tmpSum+Pot5[x3];
          while (y< 250) AND (res > Pot5[y]) do
            inc(y);
          IF y > 250 then BREAK;
          if res = Pot5[y] then
            writeln(x0,'^5+',x1,'^5+',x2,'^5+',x3,'^5 = ',y,'^5');
        end;
      end;
END.


package require Tcl 8.5

# A function to select a random character from an argument string
proc tcl::mathfunc::randchar s {
    string index $s [expr {int([string length $s]*rand())}]
}

# Set up the initial variables
set target "METHINKS IT IS LIKE A WEASEL"
set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
set parent [subst [regsub -all . $target {[expr {randchar($charset)}]}]]
set MaxMutateRate 0.91
set C 100

# Work with parent and target as lists of characters so iteration is more efficient
set target [split $target {}]
set parent [split $parent {}]

# Generate the fitness *ratio*
proc fitness s {
    global target
    set count 0
    foreach c1 $s c2 $target {
	if {$c1 eq $c2} {incr count}
    }
    return [expr {$count/double([llength $target])}]
}
# This generates the converse of the Python version; logically saner naming
proc mutateRate {parent} {
    expr {(1.0-[fitness $parent]) * $::MaxMutateRate}
}
proc mutate {rate} {
    global charset parent
    foreach c $parent {
	lappend result [expr {rand() <= $rate ? randchar($charset) : $c}]
    }
    return $result
}
proc que {} {
    global iterations parent
    puts [format "#%-4i, fitness %4.1f%%, '%s'" \
	    $iterations [expr {[fitness $parent]*100}] [join $parent {}]]
}

while {$parent ne $target} {
    set rate [mutateRate $parent]
    if {!([incr iterations] % 100)} que
    set copies [list [list $parent [fitness $parent]]]
    for {set i 0} {$i < $C} {incr i} {
	lappend copies [list [set copy [mutate $rate]] [fitness $copy]]
    }
    set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]
}
puts ""
que


boolean isEven(int i){
  return i%2 == 0;
}

boolean isOdd(int i){
  return i%2 == 1;
}


  even(N) :-
     (between(0, inf, N); integer(N) ),
     0 is N mod 2.


;use last bit method
isOdd = i & 1         ;isOdd is non-zero if i is odd
isEven = i & 1 ! 1    ;isEven is non-zero if i is even

;use modular method
isOdd = i % 2         ;isOdd is non-zero if i is odd
isEven = i % 2 ! 1    ;isEven is non-zero if i is even


public class Equlibrium {
	public static void main(String[] args) {
		int[] sequence = {-7, 1, 5, 2, -4, 3, 0};
		equlibrium_indices(sequence);
	}

	public static void equlibrium_indices(int[] sequence){
		//find total sum
		int totalSum = 0;
		for (int n : sequence) {
			totalSum += n;
		}
		//compare running sum to remaining sum to find equlibrium indices
		int runningSum = 0;
		for (int i = 0; i < sequence.length; i++) {
			int n = sequence[i];
			if (totalSum - runningSum - n == runningSum) {
				System.out.println(i);
			}
			runningSum += n;
		}
	}
}


fib(n)
when(n<2, n, fib(n-1) + fib(n-2))


rebol [Title: "Brainfuck interpreter"]

tape: make object! [
    pos: 1
    data: [0]
    inc: does [
        data/:pos: data/:pos + 1
    ]
    dec: does [
        data/:pos: data/:pos - 1
    ]
    advance: does [
        pos: pos + 1
        if (length? data) <= pos [
            append data 0
        ]
    ]
    devance: does [
        if pos > 1 [
            pos: pos - 1
        ]
    ]
    get: does [
        data/:pos
    ]
]

brainfuck: make object! [
    data: string!
    code: ""
    init: func [instr] [
        self/data: instr
    ]
    bracket-map: func [text] [
        leftstack: []
        bm: make map! []
        pc: 1
        for i 1 (length? text) 1 [
            c: text/:i
            if not find "+-<>[].," c [
                continue
            ]
            if c == #"[" [
                append leftstack pc
            ]
            if c == #"]" & ((length? leftstack) > 0) [
                left: last leftstack
                take/last leftstack
                append bm reduce [left pc]
                append bm reduce [pc left]
            ]
            append code c
            pc: pc + 1
        ]
            return bm
    ]
    run: function [] [
        pc: 0
        tp: make tape []
        bm: bracket-map self/data
        while [pc <= (length? code)] [
            switch/default code/:pc [
                #"+" [tp/inc]
                #"-" [tp/dec]
                #">" [tp/advance]
                #"<" [tp/devance]
                #"[" [if tp/get == 0 [
                    pc: bm/:pc
                ]]
                #"]" [if tp/get != 0 [
                    pc: bm/:pc
                ]]
                #"." [prin to-string to-char tp/get]
                    ] []
                    pc: pc + 1
                ]
                print newline
    ]
]

bf: make brainfuck []
bf/init input
bf/run


Number extend [
  my_factorial [
    (self < 2)
        ifTrue: [ ^1 ]
        ifFalse: [
	    ^ (2 to: self) fold: [ :a :b | a * b ]
        ]
  ]
].

7 factorial printNl.
7 my_factorial printNl.


        define('rfact(n)') :(rfact_end)
rfact   rfact = le(n,0) 1 :s(return)
        rfact = n * rfact(n - 1) :(return)
rfact_end


BEGIN # find some esthetic numbers: numbers whose successive digits differ by 1 #
    # returns TRUE if n is esthetic in the specified base, FALSE otherwise #
    PRIO ISESTHETIC = 1;
    OP   ISESTHETIC = ( INT n, base )BOOL:
         BEGIN
            INT  v             := ABS n;
            BOOL is esthetic   := TRUE;
            INT  prev digit    := v MOD base;
            v OVERAB base;
            WHILE v > 0 AND is esthetic
            DO
                INT next digit := v MOD base;
                is esthetic    := ABS ( next digit - prev digit ) = 1;
                prev digit     := next digit;
                v OVERAB base
            OD;
            is esthetic
         END # ISESTHETIC # ;
    # returns an array of the first n esthetic numbers in the specified base #
    PRIO ESTHETIC = 1;
    OP   ESTHETIC = ( INT n, base )[]INT:
         BEGIN
            [ 1 : n ]INT result;
            INT          e count := 0;
            FOR i WHILE  e count < n DO
                IF i ISESTHETIC base THEN result[ e count +:= 1 ] := i FI
            OD;
            result
         END # ESTHETIC # ;
    # returns a string erpresentation of n in the specified base, 2 <= base <= 16 must be TRUE #
    PRIO TOBASESTRING = 1;
    OP   TOBASESTRING = ( INT n, base )STRING:
         IF base < 2 OR base > 16
         THEN # invalid vbase #
             "?" + whole( n, 0 ) + ":" + whole( base, 0 ) + "?"
         ELSE
            INT    v      := ABS n;
            STRING digits  = "0123456789abcdef";
            STRING result := digits[ ( v MOD base ) + 1 ];
            WHILE ( v OVERAB base ) > 0 DO
                digits[ ( v MOD base ) + 1 ] +=: result
            OD;
            IF n < 0 THEN "-" +=: result FI;
            result
        FI # TOBASESTRING # ;
    # sets count to the number of esthetic numbers with length digits in base b less than max #
    # also displays the esthetic numbers #
    PROC show esthetic = ( INT number, base, length, max, REF INT count )VOID:
         IF length = 1
         THEN # number is esthetic #
             IF number <= max THEN
                 # number is in the required range #
                 print( ( " ", whole( number, 0 ) ) );
                 IF ( count +:= 1 ) MOD 9 = 0 THEN print( ( newline ) ) FI
             FI
         ELSE
             # find the esthetic numbers that start with number #
             INT digit  = number MOD base;
             INT prefix = number * base;
             IF digit > 0 THEN # can have a lower digit #
                 show esthetic( prefix + ( digit - 1 ), base, length - 1, max, count )
             FI;
             IF digit < base - 1 THEN # can have a higher digit #
                 show esthetic( prefix + ( digit + 1 ), base, length - 1, max, count )
             FI
         FI # show esthetic # ;
    # task #
    # esthetic numbers from base * 4 to base * 6 for bases 2 to 16 #
    FOR base FROM 2 TO 16 DO
        INT e from = base * 4;
        INT e to   = base * 6;
        print( ( "Esthetic numbers ", whole( e from, 0 ), " to ", whole( e to, 0 ), " in base ", whole( base, 0 ), newline ) );
        []INT e numbers = e to ESTHETIC base;
        print( ( "  " ) );
        FOR n FROM e from TO e to DO
            print( ( " ", e numbers[ n ] TOBASESTRING base ) )
        OD;
        print( ( newline ) )
    OD;
    # esthetic base 10 numbers between 1000 and 9999 #
    print( ( "Base 10 eshetic numbers between 1000 and 9999", newline ) );
    INT e count := 0;
    FOR i FROM 1000 TO 9999 DO
        IF i ISESTHETIC 10 THEN
            print( ( " ", whole( i, 0 ) ) );
            IF ( e count +:= 1 ) MOD 16 = 0 THEN print( ( newline ) ) FI
        FI
    OD;
    print( ( newline, newline ) );
    print( ( "Esthetic numbers between 100 000 000 and 130 000 000:", newline ) );
    e count := 0;
    show esthetic( 1, 10, 9, 130 000 000, e count );
    print( ( newline ) );
    print( ( "Found ", whole( e count, 0 ), " esthetic numbers", newline ) )
END


[ $apple, $banana, $cherry ] const: Fruits


(define fruits '{
   apple  0
   banana 1
   cherry 2})
; or
(define fruits {
   'apple  0
   'banana 1
   'cherry 2})

; getting enumeration value:
(print (get fruits 'apple -1)) ; ==> 0
; or simply
(print (fruits 'apple))        ; ==> 0
; or simply with default (for non existent enumeration key) value
(print (fruits 'carrot -1))    ; ==> -1

; simple function to create enumeration with autoassigning values
(define (make-enumeration . args)
   (fold (lambda (ff arg i)
            (put ff arg i))
      #empty
      args
      (iota (length args))))

(print (make-enumeration 'apple 'banana 'cherry))
; ==> '#ff((apple . 0) (banana . 1) (cherry . 2))


enum fruits
  apple
  pear
  orange = 14
  banana
  mango
end enum

print banana '15

'fruits values:
'  apple   0
'  pear    1
'  orange 14
'  banana 15
'  mango  16


declare
  fun {IsFruit A}
     {Member A [apple banana cherry]}
  end
in
  {Show {IsFruit banana}}


with javascript_semantics
constant MAX = 250

constant p5 = new_dict(),
         sum2 = new_dict()

atom t0 = time()
for i=1 to MAX do
    atom i5 = power(i,5)
    setd(i5,i,p5)
    for j=1 to i-1 do
        atom j5 = power(j,5)
        setd(j5+i5,{j,i},sum2)
    end for
end for

?time()-t0

function forsum2(object s, object data, object p)
    if p<=s then return 0 end if
    integer k = getd_index(p-s,sum2)
    if k!=NULL then
        ?getd(p,p5)&data&getd_by_index(k,sum2)
        return 0 -- (show one solution per p)
    end if
    return 1
end function

function forp5(object key, object /*data*/, object /*user_data*/)
    traverse_dict(forsum2,key,sum2)
    return 1
end function

traverse_dict(forp5,0,p5)

?time()-t0


T = 0                                  ' Address of target
L = 28                                 ' Length of string
P = T + L                              ' Address of parent
R = 6                                  ' Mutation rate in percent
C = 7                                  ' Number of children
B = 0                                  ' Best rate so far

Proc _Initialize                       ' Initialize

Do                                     ' Now start mutating
  I = 0                                ' Nothing does it better so far

  For x = 2 To C+1                     ' Addresses of children
    Proc _MutateDNA (x, P, R)          ' Now mutate their DNA
    F = FUNC(_Fitness (x, T))          ' Check for fitness
    If F > B Then B = F : I = x        ' If fitness of child is better
  Next                                 ' Make it the best score

  If I Then                            ' If a better child was found
    Proc _MakeParent (P, I)            ' Make the child the parent
    Proc _PrintParent (P)              ' Print the new parent
  EndIf

  Until B = L                          ' Until top score equals length
Loop

End

_MutateDNA Param(3)                    ' Mutate an entire DNA
  Local(1)

  For [email protected] = 0 to L-1                    ' For the entire string
    If [email protected] > Rnd(100) Then              ' If mutation rate is met
       @([email protected]*[email protected]) = Ord("A") + Rnd(27) ' Mutate the gene
    Else
       @([email protected]*[email protected]) = @([email protected][email protected])           ' Otherwise copy it from the parent
    EndIf
  Next
Return

_Fitness Param(2)                      ' Check for fitness
  Local(2)

  [email protected] = 0                               ' Fitness is zero
  For [email protected] = 0 to L-1                    ' For the entire string
    If @([email protected]*[email protected]) = @([email protected][email protected]) Then [email protected] = [email protected] + 1
  Next                                 ' If string matches, increment score
Return ([email protected])                            ' Return the fitness

_MakeParent Param(2)                   ' Make a child into a parent
  Local(1)

  For [email protected] = 0 to L-1                    ' For the entire string
    @([email protected][email protected]) = @([email protected]*[email protected])              ' Copy the DNA gene by gene
  Next
Return

_PrintParent Param(1)                  ' Print the parent
  Local(1)

  For [email protected] = 0 to L-1                    ' For the entire string
    If (@([email protected][email protected])) > Ord ("Z") Then
      Print " ";                       ' Cater for the space
    Else
      Print CHR(@([email protected][email protected]));             ' Print a gene
    EndIf
  Next

  Print                                ' Issue a linefeed
Return

_Initialize                            ' Initialize target and parent
  @(0)=Ord("M")                        ' Initialize target (long!)
  @(1)=Ord("E")                        ' Character by character
  @(2)=Ord("T")
  @(3)=Ord("H")
  @(4)=Ord("I")
  @(5)=Ord("N")
  @(6)=Ord("K")
  @(7)=Ord("S")
  @(8)=Ord("Z")+1
  @(9)=Ord("I")
  @(10)=Ord("T")
  @(11)=Ord("Z")+1
  @(12)=Ord("I")
  @(13)=Ord("S")
  @(14)=Ord("Z")+1
  @(15)=Ord("L")
  @(16)=Ord("I")
  @(17)=Ord("K")
  @(18)=Ord("E")
  @(19)=Ord("Z")+1
  @(20)=Ord("A")
  @(21)=Ord("Z")+1
  @(22)=Ord("W")
  @(23)=Ord("E")
  @(24)=Ord("A")
  @(25)=Ord("S")
  @(26)=Ord("E")
  @(27)=Ord("L")

  Proc _MutateDNA (P/L, P, 100)          ' Now mutate the parent DNA
Return


#import std
#import nat

rand_char = arc ' ABCDEFGHIJKLMNOPQRSTUVWXYZ'

target = 'METHINKS IT IS LIKE A WEASEL'

parent = rand_char* target

fitness = length+ (filter ~=)+ zip/target

mutate("string","rate") = "rate"%~?(rand_char,~&)* "string"

C = 32

evolve = @iiX ~&l->r @r -*iota(C); @lS nleq$-&l+ ^(fitness,~&)^*C/~&h mutate\*10

#cast %s

main = evolve parent


>>> def is_odd(i): return bool(i & 1)

>>> def is_even(i): return not is_odd(i)

>>> [(j, is_odd(j)) for j in range(10)]
[(0, False), (1, True), (2, False), (3, True), (4, False), (5, True), (6, False), (7, True), (8, False), (9, True)]
>>> [(j, is_even(j)) for j in range(10)]
[(0, True), (1, False), (2, True), (3, False), (4, True), (5, False), (6, True), (7, False), (8, True), (9, False)]
>>>


[ 1 & ]     is odd  ( n --> b )

[ odd not ] is even ( n --> b )


# The index origin is 0 in jq.
def equilibrium_indices:
  def indices(a; mx):
    def report: # [i, headsum, tailsum]
      .[0] as $i
      | if $i == mx then empty          # all done
        else .[1] as $h
        | (.[2] - a[$i]) as $t
        | (if $h == $t then $i else empty end),
          ( [ $i + 1, $h + a[$i], $t ] | report )
        end;
    [0, 0, (a|add)] | report;
  . as $in | indices($in; $in|length);


function equindex2pass(data::Array)
    rst = Vector{Int}(0)
    suml, sumr, ddelayed = 0, sum(data), 0
    for (i, d) in enumerate(data)
        suml += ddelayed
        sumr -= d
        ddelayed = d
        if suml == sumr
            push!(rst, i)
        end
    end
    return rst
end

@show equindex2pass([1, -1, 1, -1, 1, -1, 1])
@show equindex2pass([1, 2, 2, 1])
@show equindex2pass([-7, 1, 5, 2, -4, 3, 0])


// version 1.1

fun equilibriumIndices(a: IntArray): MutableList<Int> {
   val ei = mutableListOf<Int>()
   if (a.isEmpty()) return ei // empty list
   val sumAll  = a.sumBy { it }
   var sumLeft = 0
   var sumRight: Int
   for (i in 0 until a.size) {
       sumRight = sumAll - sumLeft - a[i]
       if (sumLeft == sumRight) ei.add(i)
       sumLeft += a[i]
   }
   return ei
}

fun main(args: Array<String>) {
    val a = intArrayOf(-7, 1, 5, 2, -4, 3, 0)
    val ei = equilibriumIndices(a)
    when (ei.size) {
         0     -> println("There are no equilibrium indices")
         1     -> println("The only equilibrium index is : ${ei[0]}")
         else  -> println("The equilibrium indices are : ${ei.joinToString(", ")}")
    }
}


10 LET A = 0
20 LET B = 1
30 PRINT "Which F_n do you want?"
40 INPUT N
50 IF N = 0 THEN GOTO 140
60 IF N = 1 THEN GOTO 120
70 LET C = B + A
80 LET A = B
90 LET B = C
100 LET N = N - 1
110 GOTO 60
120 PRINT B
130 END
140 PRINT 0
150 END


/*REXX program implements the   Brainf*ck   (self─censored)  language.                  */
@.=0                                             /*initialize the infinite  "tape".     */
p =0                                             /*the  "tape"  cell  pointer.          */
! =0                                             /* !   is the instruction pointer (IP).*/
parse arg $                                      /*allow user to specify a BrainF*ck pgm*/
                                                 /* ┌──◄── No program? Then use default;*/
if $=''  then $=,                                /* ↓      it displays:  Hello, World!  */
  "++++++++++             initialize cell #0  to 10;   then loop:         ",
  "[   > +++++++              add  7 to cell #1;  final result:  70       ",
  "    > ++++++++++           add 10 to cell #2;  final result: 100       ",
  "    > +++                  add  3 to cell #3;  final result   30       ",
  "    > +                    add  1 to cell #4;  final result   10       ",
  "    <<<< -      ]      decrement  cell #0                              ",
  "> ++ .                 display 'H'    which is  ASCII  72 (decimal)    ",
  "> + .                  display 'e'    which is  ASCII 101 (decimal)    ",
  "+++++++ ..             display 'll'   which is  ASCII 108 (decimal) {2}",
  "+++ .                  display 'o'    which is  ASCII 111 (decimal)    ",
  "> ++ .                 display ' '    which is  ASCII  32 (decimal)    ",
  "<< +++++++++++++++ .   display 'W'    which is  ASCII  87 (decimal)    ",
  "> .                    display 'o'    which is  ASCII 111 (decimal)    ",
  "+++ .                  display 'r'    which is  ASCII 114 (decimal)    ",
  "------ .               display 'l'    which is  ASCII 108 (decimal)    ",
  "-------- .             display 'd'    which is  ASCII 100 (decimal)    ",
  "> + .                  display '!'    which is  ASCII  33 (decimal)    "
                                                 /* [↑]   note the  Brainf*ck  comments.*/
     do !=1  while  !\==0  &  !<=length($)       /*keep executing  BF  as long as IP ¬ 0*/
     parse var  $  =(!)  x  +1                   /*obtain a  Brainf*ck instruction  (x),*/
                                                 /*···it's the same as  x=substr($,!,1) */
       select                                    /*examine the current instruction.     */
       when x=='+'  then @.[email protected].p + 1             /*increment the   "tape" cell    by  1 */
       when x=='-'  then @.[email protected].p - 1             /*decrement  "       "     "      "  " */
       when x=='>'  then   p=  p + 1             /*increment  "  instruction ptr   "  " */
       when x=='<'  then   p=  p - 1             /*decrement  "       "       "    "  " */
       when x=='['  then != forward()            /*go  forward to   ]+1   if  @.P = 0.  */
       when x==']'  then !=backward()            /* " backward  "   [+1    "   "  ¬ "   */
       when x== .   then call charout , d2c(@.p) /*display a  "tape"  cell to terminal. */
       when x==','  then do;  say 'input a value:';  parse pull @.p;  end
       otherwise    iterate
       end   /*select*/
     end     /*forever*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
forward:  if @.p\==0  then return !;  c=1        /*C: ◄───  is the   [   nested counter.*/
                         do k=!+1  to length($);        ?=substr($, k, 1)
                         if ?=='['  then do; c=c+1;     iterate;                   end
                         if ?==']'  then do; c=c-1;     if c==0  then leave;       end
                         end   /*k*/
          return k
/*──────────────────────────────────────────────────────────────────────────────────────*/
backward: if @.p==0   then return !;  c=1        /*C: ◄───  is the   ]   nested counter.*/
                         do k=!-1  to 1  by -1;         ?=substr($, k, 1)
                         if ?==']'  then do; c=c+1;     iterate;                   end
                         if ?=='['  then do; c=c-1;     if c==0  then return k+1;  end
                         end   /*k*/
          return k


con
  _clkmode = xtal1 + pll16x
  _clkfreq = 80_000_000

obj
  ser : "FullDuplexSerial.spin"

pub main | i
  ser.start(31, 30, 0, 115200)

  repeat i from 0 to 10
    ser.dec(fac(i))
    ser.tx(32)

  waitcnt(_clkfreq + cnt)
  ser.stop
  cogstop(0)

pub fac(n) : f
  f := 1
  repeat while n > 0
    f *= n
    n -= 1


esthetic?: function [n, b][
    if n=0 -> return false
    k: n % b
    l: n / b

    while [l>0][
        j: l % b
        if 1 <> abs k-j -> return false
        l: l / b
        k: j
    ]
    return true
]

HEX: "0000000000ABCDEF"

getHex: function [ds][
    map ds 'd [
        (d < 10)? -> to :string d
                  -> to :string HEX\[d]
    ]
]

findEsthetics: function [base][
    limDown: base * 4
    limUp: base * 6

    cnt: 0
    i: 1
    result: new []
    while [cnt < limUp][
        if esthetic? i base [
            cnt: cnt + 1
            if cnt >= limDown ->
                'result ++ join getHex digits.base: base i
        ]
        i: i + 1
    ]
    print ["Base" base "->" (to :string limDown)++"th" "to" (to :string limUp)++"th" "esthetic numbers:"]
    print result
    print ""
]

loop 2..16 'bs ->
    findEsthetics bs

print "Esthetic numbers between 1000 and 9999:"

loop split.every: 16 select 1000..9999 'num -> esthetic? num 10 'row [
    print map to [:string] row 'item -> pad item 4
]


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

typedef int bool;
typedef unsigned long long ull;

#define TRUE 1
#define FALSE 0

char as_digit(int d) {
    return (d >= 0 && d <= 9) ? d + '0' : d - 10 + 'a';
}

void revstr(char *str) {
    int i, len = strlen(str);
    char t;
    for (i = 0; i < len/2; ++i) {
        t = str[i];
        str[i] = str[len - i - 1];
        str[len - i - 1] = t;
    }
}

char* to_base(char s[], ull n, int b) {
    int i = 0;
    while (n) {
        s[i++] = as_digit(n % b);
        n /= b;
    }
    s[i] = '\0';
    revstr(s);
    return s;
}

ull uabs(ull a, ull  b) {
    return a > b ? a - b : b - a;
}

bool is_esthetic(ull n, int b) {
    int i, j;
    if (!n) return FALSE;
    i = n % b;
    n /= b;
    while (n) {
        j = n % b;
        if (uabs(i, j) != 1) return FALSE;
        n /= b;
        i = j;
    }
    return TRUE;
}

ull esths[45000];
int le = 0;

void dfs(ull n, ull m, ull i) {
    ull d, i1, i2;
    if (i >= n && i <= m) esths[le++] = i;
    if (i == 0 || i > m) return;
    d = i % 10;
    i1 = i * 10 + d - 1;
    i2 = i1 + 2;
    if (d == 0) {
        dfs(n, m, i2);
    } else if (d == 9) {
        dfs(n, m, i1);
    } else {
        dfs(n, m, i1);
        dfs(n, m, i2);
    }
}

void list_esths(ull n, ull n2, ull m, ull m2, int per_line, bool all) {
    int i;
    le = 0;
    for (i = 0; i < 10; ++i) {
        dfs(n2, m2, i);
    }
    printf("Base 10: %'d esthetic numbers between %'llu and %'llu:\n", le, n, m);
    if (all) {
        for (i = 0; i < le; ++i) {
            printf("%llu ", esths[i]);
            if (!(i+1)%per_line) printf("\n");
        }
    } else {
        for (i = 0; i < per_line; ++i) printf("%llu ", esths[i]);
        printf("\n............\n");
        for (i = le - per_line; i < le; ++i) printf("%llu ", esths[i]);
    }
    printf("\n\n");
}

int main() {
    ull n;
    int b, c;
    char ch[15] = {0};
    for (b = 2; b <= 16; ++b) {
        printf("Base %d: %dth to %dth esthetic numbers:\n", b, 4*b, 6*b);
        for (n = 1, c = 0; c < 6 * b; ++n) {
            if (is_esthetic(n, b)) {
                if (++c >= 4 * b) printf("%s ", to_base(ch, n, b));
            }
        }
        printf("\n\n");
    }
    char *oldLocale = setlocale(LC_NUMERIC, NULL);
    setlocale(LC_NUMERIC, "");

    // the following all use the obvious range limitations for the numbers in question
    list_esths(1000, 1010, 9999, 9898, 16, TRUE);
    list_esths(1e8, 101010101, 13*1e7, 123456789, 9, TRUE);
    list_esths(1e11, 101010101010, 13*1e10, 123456789898, 7, FALSE);
    list_esths(1e14, 101010101010101, 13*1e13, 123456789898989, 5, FALSE);
    list_esths(1e17, 101010101010101010, 13*1e16, 123456789898989898, 4, FALSE);
    setlocale(LC_NUMERIC, oldLocale);
    return 0;
}


# Using an array
my @fruits = qw(apple banana cherry);

# Using a hash
my %fruits = ( apple => 0, banana => 1, cherry => 2 );


enum apple, banana, orange
enum apple=5, banana=10, orange=


// Using an array/hash
$fruits = array( "apple", "banana", "cherry" );
$fruits = array( "apple" => 0, "banana" => 1, "cherry" => 2 );

// If you are inside a class scope
class Fruit {
  const APPLE = 0;
  const BANANA = 1;
  const CHERRY = 2;
}

// Then you can access them as such
$value = Fruit::APPLE;

// Or, you can do it using define()
define("FRUIT_APPLE", 0);
define("FRUIT_BANANA", 1);
define("FRUIT_CHERRY", 2);


fruit(apple,1).
fruit(banana,2).
fruit(cherry,4).

print_fruit_name(N) :-
	fruit(Name,N),
	printf("It is %w\nn", Name).


(de enum "Args"
   (mapc def "Args" (range 1 (length "Args"))) )


···
http://rosettacode.org/wiki/Evolutionary_algorithm
···
■ Evolutionary
  § static
    target⦂ String: "METHINKS IT IS LIKE A WEASEL"
    letter⦂ char[]: "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray°
    parent⦂ String
    random⦂ java.util.Random°
    rate⦂ double: 0.5
    C⦂ int: 1000

    ▶ fittness⦂ int    · computes the 'closeness' of its
    • argument⦂ String · to the target string
      closeness⦂ int: 0
      ∀ i ∈ 0 … target.length°
        closeness◥ if target.charAt i = argument.charAt i
      return closeness

    ▶ mutate⦂ String · returns a copy of the
    • given⦂ String  · with some characters probably mutated
    • rate⦂ double
      copy⦂ char[]: given.toCharArray°
      ∀ i ∈ 0 … given.length°
        copy[i]: letter[random.nextInt letter.length] if rate > random.nextDouble°
      return String.valueOf copy

    ▶ main
    • args⦂ String[]
      ancest⦂ StringBuilder°
      ∀ i ∈ 0 … target.length°
        ancest.append letter[random.nextInt letter.length]
      parent: ancest.toString°
      currentFittness⦂ int: fittness parent
      generation⦂ int: 0
      🔁 until the parent ≈ target
        if fittness parent > currentFittness
           currentFittness: fittness parent
           System.out.println "Fittness of generation #⸨generation⸩ is ⸨currentFittness⸩"
        for each time from 1 to C
            mutation⦂ String: mutate parent, rate
            parent: mutation if fittness parent < fittness mutation
        generation◥
      System.out.println "Target reached by generation #⸨generation⸩"


'This is the string we want to "evolve" to. Any string of any length will
'do as long as it consists only of upper case letters and spaces.

Target  = "METHINKS IT IS LIKE A WEASEL"

'This is the pool of letters that will be selected at random for a mutation

letters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"

'A mutation rate of 0.5 means that there is a 50% chance that one letter
'will be mutated at random in the next child

mutation_rate = 0.5

'Set for 10 children per generation

Dim child(10)

'Generate the first guess as random letters

Randomize
Parent = ""

for i = 1 to len(Target)
    Parent = Parent & Mid(letters,Random(1,Len(letters)),1)
next

gen = 0

Do
    bestfit = 0
    bestind = 0

    gen = gen + 1

    'make n copies of the current string and find the one
    'that best matches the target string

    For i = 0 to ubound(child)

        child(i) = Mutate(Parent, mutation_rate)

        fit = Fitness(Target, child(i))

        If fit > bestfit Then
            bestfit = fit
            bestind = i
        End If

    Next

    'Select the child that has the best fit with the target string

    Parent = child(bestind)
    Wscript.Echo parent, "(fit=" & bestfit & ")"

Loop Until Parent = Target

Wscript.Echo vbcrlf & "Generations = " & gen

'apply a random mutation to a random character in a string

Function Mutate ( ByVal str , ByVal rate )

    Dim pos        'a random position in the string'
    Dim ltr        'a new letter chosen at random    '

    If rate > Rnd(1) Then

        ltr = Mid(letters,Random(1,len(letters)),1)
        pos = Random(1,len(str))
        str = Left(str, pos - 1) & ltr & Mid(str, pos + 1)

    End If

    Mutate = str

End Function

'returns the number of letters in the two strings that match

Function Fitness (ByVal str , ByVal ref )

    Dim i

    Fitness = 0

    For i = 1 To Len(str)
        If Mid(str, i, 1) = Mid(ref, i, 1) Then Fitness = Fitness + 1
    Next

End Function

'Return a random integer in the range lower to upper (inclusive)

Private Function Random ( lower , upper )
  Random = Int((upper - lower + 1) * Rnd + lower)
End Function


is.even <- function(x) !is.odd(x)

is.odd <- function(x) intToBits(x)[1] == 1
#or
is.odd <- function(x) x %% 2 == 1


(even? 6) ; -> true
(even? 5) ; -> false
(odd? 6) ; -> false
(odd? 5) ; -> true


subset Even of Int where * %% 2;
subset Odd of Int where * % 2;

say 1 ~~ Even; # false
say 1 ~~ Odd;  # true
say 1.5 ~~ Odd # false ( 1.5 is not an Int )


a(0)=-7
a(1)=1
a(2)=5
a(3)=2
a(4)=-4
a(5)=3
a(6)=0

print "EQ Indices are ";EQindex$("a",0,6)

wait

function EQindex$(b$,mini,maxi)
    if mini>=maxi then exit function
    sum=0
    for i = mini to maxi
        sum=sum+eval(b$;"(";i;")")
    next
    sumA=0:sumB=sum
    for i = mini to maxi
        sumB = sumB - eval(b$;"(";i;")")
        if sumA=sumB then EQindex$=EQindex$+str$(i)+", "
        sumA = sumA + eval(b$;"(";i;")")
    next
    if len(EQindex$)>0 then EQindex$=mid$(EQindex$, 1, len(EQindex$)-2) 'remove last ", "
end function


to equilibrium.iter :i :before :after :tail :ret
  if equal? :before :after [make "ret lput :i :ret]
  if empty? butfirst :tail [output :ret]
  output equilibrium.iter :i+1 (:before+first :tail) (:after-first butfirst :tail) (butfirst :tail) :ret
end
to equilibrium.index :list
  output equilibrium.iter 1 0 (apply "sum butfirst :list) :list []
end

show equilibrium_index [-7 1 5 2 -4 3 0]    ; [4 7]


function array_sum(t)
   assert(type(t) == "table", "t must be a table!")
   local sum = 0
   for i=1, #t do sum = sum + t[i] end
   return sum
end

function equilibrium_index(t)
   assert(type(t) == "table", "t must be a table!")
   local left, right, ret = 0, array_sum(t), -1
   for i,j in pairs(t) do
      right = right - j
      if left == right then
	 ret = i
	 break
      end
      left = left + j
   end
   return ret
end

print(equilibrium_index({-7, 1, 5, 2, -4, 3, 0}))


FUNCTION fibonacci (n)
    LET n1 = 0
    LET n2 = 1
    FOR k = 1 TO ABS(n)
        LET sum = n1 + n2
        LET n1 = n2
        LET n2 = sum
    NEXT k
    IF n < 0 THEN
       LET fibonacci = n1 * ((-1) ^ ((-n) + 1))
    ELSE
       LET fibonacci = n1
    END IF
END FUNCTION

PRINT fibonacci(0)      ! 0
PRINT fibonacci(13)     ! 233
PRINT fibonacci(-42)    !-267914296
PRINT fibonacci(47)     ! 2971215073
END


use std::collections::HashMap;
use std::env;
use std::fs::File;
use std::io::prelude::*;
use std::io::stdin;
use std::num::Wrapping;

fn main() {
    let args: Vec<_> = env::args().collect();
    if args.len() < 2 {
        println!("Usage: {} [path] (--debug)", args[0]);
        return;
    }

    let src: Vec<char> = {
        let mut buf = String::new();
        match File::open(&args[1])
        {
            Ok(mut f) => { f.read_to_string(&mut buf).unwrap(); }
            Err(e)    => {
                println!("Error opening '{}': {}", args[1], e);
                return;
            }
        }

        buf.chars().collect()
    };

    // Launch options
    let debug = args.contains(&"--debug".to_owned());

    // One pass to find bracket pairs.
    let brackets: HashMap<usize, usize> = {
        let mut m = HashMap::new();
        let mut scope_stack = Vec::new();
        for (idx, ch) in src.iter().enumerate() {
            match ch {
                &'[' => { scope_stack.push(idx); }
                &']' => { m.insert(scope_stack.pop().unwrap(), idx); }
                _    => { /* ignore */ }
            }
        }

        m
    };

    let mut pc: usize = 0;                                  // Program counter
    let mut mem: [Wrapping<u8>;5000] = [Wrapping(0);5000];  // Program cemory
    let mut ptr: usize = 0;                                 // Pointer
    let mut stack: Vec<usize> = Vec::new();                 // Bracket stack

    let stdin_ = stdin();
    let mut reader = stdin_.lock().bytes();
    while pc < src.len() {
        let Wrapping(val) = mem[ptr];

        if debug {
            println!("(BFDB) PC: {:04} \tPTR: {:04} \t$PTR: {:03} \tSTACK_DEPTH: {} \tSYMBOL: {}", pc, ptr, val, stack.len(), src[pc]);
        }

        const ONE: Wrapping<u8> = Wrapping(1);
        match src[pc] {
            '>' => { ptr += 1; }
            '<' => { ptr -= 1; }

            '+' => { mem[ptr] = mem[ptr] + ONE; }
            '-' => { mem[ptr] = mem[ptr] - ONE; }

            '[' => {
                if val == 0 {
                    pc = brackets[&pc];
                } else {
                    stack.push(pc);
                }
            }
            ']' => {
                let matching_bracket = stack.pop().unwrap();
                if val != 0 {
                    pc = matching_bracket - 1;
                }
            }

            '.' => {
                if debug {
                    println!("(BFDB) STDOUT: '{}'", val as char);  // Intercept output
                } else {
                    print!("{}", val as char);
                }
            }
            ',' => {
                mem[ptr] = Wrapping(reader.next().unwrap().unwrap());
            }

            _   => { /* ignore */ }
        }

        pc += 1;
    }
}


import scala.annotation._

trait Func[T] {
    val zero: T
    def inc(t: T): T
    def dec(t: T): T
    def in: T
    def out(t: T): Unit
}

object ByteFunc extends Func[Byte] {
  override val zero: Byte = 0
  override def inc(t: Byte) = ((t + 1) & 0xFF).toByte
  override def dec(t: Byte) = ((t - 1) & 0xFF).toByte
  override def in: Byte = readByte
  override def out(t: Byte) { print(t.toChar) }
}

case class Tape[T](left: List[T], cell: T, right: List[T])(implicit func: Func[T]) {
  private def headOf(list:List[T]) = if (list.isEmpty) func.zero else list.head
  private def tailOf(list:List[T]) = if (list.isEmpty) Nil else list.tail
  def isZero = cell == func.zero
  def execute(ch: Char) = (ch: @switch) match {
   case '+' => copy(cell = func.inc(cell))
   case '-' => copy(cell = func.dec(cell))
   case '<' => Tape(tailOf(left), headOf(left), cell :: right)
   case '>' => Tape(cell :: left, headOf(right), tailOf(right))
   case '.' => func.out(cell); this
   case ',' => copy(cell = func.in)
   case '[' | ']' => this
   case _ => error("Unexpected token: " + ch)
  }
}

object Tape {
  def empty[T](func: Func[T]) = Tape(Nil, func.zero, Nil)(func)
}

class Brainfuck[T](func:Func[T]) {

  def execute(p: String) {
    val prog = p.replaceAll("[^\\+\\-\\[\\]\\.\\,\\>\\<]", "")

    @tailrec def braceMatcher(pos: Int, stack: List[Int], o2c: Map[Int, Int]): Map[Int,Int] =
      if(pos == prog.length) o2c else (prog(pos): @switch) match {
        case '[' => braceMatcher(pos + 1, pos :: stack, o2c)
        case ']' => braceMatcher(pos + 1, stack.tail, o2c + (stack.head -> pos))
        case _ => braceMatcher(pos + 1, stack, o2c)
      }

    val open2close = braceMatcher(0, Nil, Map())
    val close2open = open2close.map(_.swap)

    @tailrec def ex(pos:Int, tape:Tape[T]): Unit =
      if(pos < prog.length) ex((prog(pos): @switch) match {
          case '[' if tape.isZero => open2close(pos)
          case ']' if ! tape.isZero => close2open(pos)
          case _ => pos + 1
        }, tape.execute(prog(pos)))

    println("---running---")
    ex(0, Tape.empty(func))
    println("\n---done---")
  }
}


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


#include <functional>
#include <iostream>
#include <sstream>
#include <vector>

std::string to(int n, int b) {
    static auto BASE = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";

    std::stringstream ss;
    while (n > 0) {
        auto rem = n % b;
        n = n / b;
        ss << BASE[rem];
    }

    auto fwd = ss.str();
    return std::string(fwd.rbegin(), fwd.rend());
}

uint64_t uabs(uint64_t a, uint64_t b) {
    if (a < b) {
        return b - a;
    }
    return a - b;
}

bool isEsthetic(uint64_t n, uint64_t b) {
    if (n == 0) {
        return false;
    }
    auto i = n % b;
    n /= b;
    while (n > 0) {
        auto j = n % b;
        if (uabs(i, j) != 1) {
            return false;
        }
        n /= b;
        i = j;
    }
    return true;
}

void listEsths(uint64_t n, uint64_t n2, uint64_t m, uint64_t m2, int perLine, bool all) {
    std::vector<uint64_t> esths;
    const auto dfs = [&esths](uint64_t n, uint64_t m, uint64_t i) {
        auto dfs_impl = [&esths](uint64_t n, uint64_t m, uint64_t i, auto &dfs_ref) {
            if (i >= n && i <= m) {
                esths.push_back(i);
            }
            if (i == 0 || i > m) {
                return;
            }
            auto d = i % 10;
            auto i1 = i * 10 + d - 1;
            auto i2 = i1 + 2;
            if (d == 0) {
                dfs_ref(n, m, i2, dfs_ref);
            } else if (d == 9) {
                dfs_ref(n, m, i1, dfs_ref);
            } else {
                dfs_ref(n, m, i1, dfs_ref);
                dfs_ref(n, m, i2, dfs_ref);
            }
        };
        dfs_impl(n, m, i, dfs_impl);
    };

    for (int i = 0; i < 10; i++) {
        dfs(n2, m2, i);
    }
    auto le = esths.size();
    printf("Base 10: %d esthetic numbers between %llu and %llu:\n", le, n, m);
    if (all) {
        for (size_t c = 0; c < esths.size(); c++) {
            auto esth = esths[c];
            printf("%llu ", esth);
            if ((c + 1) % perLine == 0) {
                printf("\n");
            }
        }
        printf("\n");
    } else {
        for (int c = 0; c < perLine; c++) {
            auto esth = esths[c];
            printf("%llu ", esth);
        }
        printf("\n............\n");
        for (size_t i = le - perLine; i < le; i++) {
            auto esth = esths[i];
            printf("%llu ", esth);
        }
        printf("\n");
    }
    printf("\n");
}

int main() {
    for (int b = 2; b <= 16; b++) {
        printf("Base %d: %dth to %dth esthetic numbers:\n", b, 4 * b, 6 * b);
        for (int n = 1, c = 0; c < 6 * b; n++) {
            if (isEsthetic(n, b)) {
                c++;
                if (c >= 4 * b) {
                    std::cout << to(n, b) << ' ';
                }
            }
        }
        printf("\n");
    }
    printf("\n");

    // the following all use the obvious range limitations for the numbers in question
    listEsths(1000, 1010, 9999, 9898, 16, true);
    listEsths((uint64_t)1e8, 101'010'101, 13 * (uint64_t)1e7, 123'456'789, 9, true);
    listEsths((uint64_t)1e11, 101'010'101'010, 13 * (uint64_t)1e10, 123'456'789'898, 7, false);
    listEsths((uint64_t)1e14, 101'010'101'010'101, 13 * (uint64_t)1e13, 123'456'789'898'989, 5, false);
    listEsths((uint64_t)1e17, 101'010'101'010'101'010, 13 * (uint64_t)1e16, 123'456'789'898'989'898, 4, false);
    return 0;
}


define ordinal animal (frog, gnu, elephant, snake);

define ordinal color (red value (1), green value (3), blue value (5));


Enum fruits {
    Apple
    Banana
    Cherry
}
[fruits]::Apple
[fruits]::Apple + 1
[fruits]::Banana + 1


fruit(apple,1).
fruit(banana,2).
fruit(cherry,4).

write_fruit_name(N) :-
	fruit(Name,N),
	format('It is a ~p~n', Name).


Enumeration
   #Apple
   #Banana
   #Cherry
EndEnumeration


>>> from enum import Enum
>>> Contact = Enum('Contact', 'FIRST_NAME, LAST_NAME, PHONE')
>>> Contact.__members__
mappingproxy(OrderedDict([('FIRST_NAME', <Contact.FIRST_NAME: 1>), ('LAST_NAME', <Contact.LAST_NAME: 2>), ('PHONE', <Contact.PHONE: 3>)]))
>>>
>>> # Explicit
>>> class Contact2(Enum):
	FIRST_NAME = 1
	LAST_NAME = 2
	PHONE = 3

>>> Contact2.__members__
mappingproxy(OrderedDict([('FIRST_NAME', <Contact2.FIRST_NAME: 1>), ('LAST_NAME', <Contact2.LAST_NAME: 2>), ('PHONE', <Contact2.PHONE: 3>)]))
>>>


(off P)
(off S)

(for I 250
   (idx
      'P
      (list (setq @@ (** I 5)) I)
      T )
   (for (J I (>= 250 J) (inc J))
      (idx
         'S
         (list (+ @@ (** J 5)) (list I J))
         T ) ) )
(println
   (catch 'found
      (for A (idx 'P)
         (for B (idx 'S)
            (T (<= (car A) (car B)))
            (and
               (lup S (- (car A) (car B)))
               (throw 'found
                  (conc
                     (cadr (lup S (car B)))
                     (cadr (lup S (- (car A) (car B))))
                     (cdr (lup P (car A))) ) ) ) ) ) ) )


# EULER.PS1
$max = 250

$powers =  New-Object System.Collections.ArrayList
for ($i = 0; $i -lt $max; $i++) {
  $tmp = $powers.Add([Math]::Pow($i, 5))
}

for ($x0 = 1; $x0 -lt $max; $x0++) {
  for ($x1 = 1; $x1 -lt $x0; $x1++) {
    for ($x2 = 1; $x2 -lt $x1; $x2++) {
      for ($x3 = 1; $x3 -lt $x2; $x3++) {
        $sum = $powers[$x0] + $powers[$x1] + $powers[$x2] + $powers[$x3]
        $S1 = [int][Math]::pow($sum,0.2)

        if ($sum -eq $powers[$S1]) {
          Write-host "$x0^5 + $x1^5 + $x2^5 + $x3^5 = $S1^5"
          return
        }
      }
    }
  }
}


Option Explicit

Private Sub Main()
   Dim Target
   Dim Parent
   Dim mutation_rate
   Dim children
   Dim bestfitness
   Dim bestindex
   Dim Index
   Dim fitness

      Target = "METHINKS IT IS LIKE A WEASEL"
      Parent = "IU RFSGJABGOLYWF XSMFXNIABKT"
      mutation_rate = 0.5
       children = 10
      ReDim child(children)

      Do
        bestfitness = 0
        bestindex = 0
        For Index = 1 To children
          child(Index) = FNmutate(Parent, mutation_rate, Target)
          fitness = FNfitness(Target, child(Index))
          If fitness > bestfitness Then
            bestfitness = fitness
            bestindex = Index
          End If
        Next Index

        Parent = child(bestindex)
        Debug.Print Parent
      Loop Until Parent = Target
      End

End Sub

Function FNmutate(Text, Rate, ref)
   Dim C As Integer
   Dim Aux As Integer

     If Rate > Rnd(1) Then
        C = 63 + 27 * Rnd() + 1
        If C = 64 Then C = 32
        Aux = Len(Text) * Rnd() + 1
        If Mid(Text, Aux, 1) <> Mid(ref, Aux, 1) Then
            Text = Left(Text, Aux - 1) & Chr(C) & Mid(Text, Aux + 1)
        End If

     End If
      FNmutate = Text
End Function
Function FNfitness(Text, ref)
    Dim I, F
      For I = 1 To Len(Text)
        If Mid(Text, I, 1) = Mid(ref, I, 1) Then F = F + 1
      Next
      FNfitness = F / Len(Text)
End Function