import rand
import rand.seed
const target = "METHINKS IT IS LIKE A WEASEL".bytes()
const set = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".bytes()

fn initialize() []u8 {
    rand.seed(seed.time_seed_array(2))
    mut parent := []u8{len: target.len}
    for i in 0..parent.len {
        parent[i] = set[rand.intn(set.len) or {0}]
    }
    return parent
}

// fitness:  0 is perfect fit.  greater numbers indicate worse fit.
fn fitness(a []u8) int {
    mut h := 0
    // (hamming distance)
    for i, tc in target {
        if a[i] != tc {
            h++
        }
    }
    return h
}

// set m to mutation of p, with each character of p mutated with probability r
fn mutate(p []u8, mut m []u8, r f64) {
    for i, ch in p {
        if rand.f64() < r {
            m[i] = set[rand.intn(set.len) or {0}]
        } else {
            m[i] = ch
        }
    }
}

fn main() {
    c := 20 // number of times to copy and mutate parent

    mut parent := initialize()
    mut copies := [][]u8{len: c, init: []u8{len: parent.len}}

    println(parent.bytestr())
    for best := fitness(parent); best > 0; {
        for mut cp in copies {
            mutate(parent, mut cp, .05)
        }
        for cp in copies {
            fm := fitness(cp)
            if fm < best {
                best = fm
                parent = cp.clone()
                println(parent.bytestr())
            }
        }
    }
}


public bool isEven(int n) = (n % 2) == 0;
public bool isOdd(int n) = (n % 2) == 1;


Red [
    date: 2021-10-24
    red-version: 0.6.4
    description: "Test whether an integer is even or odd."
]

print even? 10 ;== true
print odd? 10 ;== false


let is_even = d => mod(d, 2) == 0

let is_odd = d => mod(d, 2) != 0


equilibriumIndex[data_]:=Reap[
    Do[If[Total[data[[;; n - 1]]] == Total[data[[n + 1 ;;]]],Sow[n]],
    {n, Length[data]}]][[2, 1]]


function indicies = equilibriumIndex(list)

    indicies = [];

    for i = (1:numel(list))
        if ( sum(-list(1:i)) == sum(-list(i:end)) )
            indicies = [indicies i];
        end
    end

end


/* NetRexx */
options replace format comments java crossref symbols nobinary

numeric digits 20
runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- @see http://www.geeksforgeeks.org/equilibrium-index-of-an-array/
method equilibriumIndex(sequence) private static
  es = ''
  loop ix = 1 to sequence.words()
    sum = 0
    loop jx = 1 to sequence.words()
      if jx < ix then sum = sum + sequence.word(jx)
      if jx > ix then sum = sum - sequence.word(jx)
      end jx
      if sum = 0 then es = es ix
    end ix
  return es

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  -- Note: A Rexx object based list of "words" starts at index 1
  sequences = [ -
    '-7  1  5  2 -4  3  0', -  -- 4 7
    ' 2  4  6'            , -  -- (no equilibrium point)
    ' 0  2  4  0  6  0'   , -  -- 4
    ' 2  9  2'            , -  -- 2
    ' 1 -1  1 -1  1 -1  1'  -  -- 1 2 3 4 5 6 7
    ]
  loop sequence over sequences
    say 'For sequence "'sequence.space(1, ',')'" the equilibrium indices are: \-'
    say '"'equilibriumIndex(sequence).space(1, ',')'"'
    end sequence
  return


// library: math: get: series: fibonacci <description></description> <version control></version control> <version>1.0.0.0.3</version> <version control></version control> (filenamemacro=getmasfi.s) [<Program>] [<Research>] [kn, ri, su, 20-01-2013 22:04:02]
INTEGER PROC FNMathGetSeriesFibonacciI( INTEGER  nI )
 //
 // Method:
 //
 // 1. Take the sum of the last 2 terms
 //
 // 2. Let the sum be the last term
 //    and goto step 1
 //
 INTEGER I = 0
 INTEGER minI = 1
 INTEGER maxI = nI
 INTEGER term1I = 0
 INTEGER term2I = 1
 INTEGER term3I = 0
 //
 FOR I = minI TO maxI
  //
  // make value 3 equal to sum of two previous values 1 and 2
  //
  term3I = term1I + term2I
  //
  // make value 1 equal to next value 2
  //
  term1I = term2I
  //
  // make value 2 equal to next value 3
  //
  term2I = term3I
  //
  ENDFOR
  //
 RETURN( term3I )
 //
END

PROC Main()
 STRING s1[255] = "3"
 REPEAT
  IF ( NOT ( Ask( " = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
  Warn( FNMathGetSeriesFibonacciI( Val( s1 ) ) ) // gives e.g. 3
 UNTIL FALSE
END


$ include "seed7_05.s7i";

const proc: brainF (in string: source, inout file: input, inout file: output) is func
  local
    var array char: memory is 100000 times '\0;';
    var integer: dataPointer is 50000;
    var integer: instructionPointer is 1;
    var integer: nestingLevel is 0;
  begin
    while instructionPointer <= length(source) do
      case source[instructionPointer] of
        when {'>'}: incr(dataPointer);
        when {'<'}: decr(dataPointer);
        when {'+'}: incr(memory[dataPointer]);
        when {'-'}: decr(memory[dataPointer]);
        when {'.'}: write(output, memory[dataPointer]);
        when {','}: memory[dataPointer] := getc(input);
        when {'['}: # Forward if zero at dataPointer
          if memory[dataPointer] = '\0;' then
            nestingLevel := 1;
            repeat
              incr(instructionPointer);
              case source[instructionPointer] of
                when {'['}: incr(nestingLevel);
                when {']'}: decr(nestingLevel);
              end case;
            until nestingLevel = 0;
          end if;
        when {']'}: # Backward if non-zero at dataPointer
          if memory[dataPointer] <> '\0;' then
            nestingLevel := 1;
            repeat
              decr(instructionPointer);
              case source[instructionPointer] of
                when {'['}: decr(nestingLevel);
                when {']'}: incr(nestingLevel);
              end case;
            until nestingLevel = 0;
          end if;
      end case;
      incr(instructionPointer);
    end while;
  end func;

const proc: brainF (in string: source) is func
  begin
    brainF(source, IN, OUT);
  end func;

const proc: main is func
  begin
    brainF("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");
  end func;


define tape_length = 50_000;
define eof_val = -1;
define unbalanced_exit_code = 1;

var cmd = 0;
var cell = 0;
var code = [];
var loops = [];
var tape = tape_length.of(0);

func get_input {
    static input_buffer = [];
    input_buffer.len || (input_buffer = ((STDIN.readline \\ return eof_val).chomp.chars.map{.ord}));
    input_buffer.shift \\ eof_val;
}

func jump {
    var depth = 0;
    while (depth >= 0) {
        ++cmd < code.len || Sys.exit(unbalanced_exit_code);
        if (code[cmd] == '[') {
            ++depth;
        }
        elsif (code[cmd] == ']') {
            --depth;
        }
    }
}

var commands = Hash.new(
    '>' => { ++cell },
    '<' => { --cell },
    '+' => { ++tape[cell] },
    '-' => { --tape[cell] },
    '.' => { tape[cell].chr.print },
    ',' => { tape[cell] = get_input() },
    '[' => { tape[cell] ? loops.append(cmd) : jump() },
    ']' => { cmd = (loops.pop - 1) },
);

STDOUT.autoflush(1);
code = ARGF.slurp.chars.grep {|c| commands.exists(c)};
var code_len = code.len;

while (cmd < code_len) {
    commands{code[cmd]}.run;
    cmd++;
}


mata
real scalar function fact1(real scalar n) {
	if (n<2) return(1)
	else return(fact1(n-1)*n)
}

real scalar function fact2(real scalar n) {
	a=1
	for (i=2;i<=n;i++) a=a*i
	return(a)
}

printf("%f\n",fact1(8))
printf("%f\n",fact2(8))
printf("%f\n",factorial(8))


func factorial(_ n: Int) -> Int {
	return n < 2 ? 1 : (2...n).reduce(1, *)
}


bit7 equ %10000000
bit6 equ %01000000

MOVE.B (A0),D0
AND.B #bit7,D0
;D0.B contains either $00 or $80


Foo : constant := 42;
Foo : constant Blahtype := Blahvalue;


INT max allowed = 20;
REAL pi = 3.1415 9265;    # pi is constant that the compiler will enforce     #
REF REAL var = LOC REAL;  # var is a constant pointer to a local REAL address #
var := pi # constant pointer var has the REAL value referenced assigned pi    #


MyData := new FinalBox("Immutable data")
MsgBox % "MyData.Data = " MyData.Data
MyData.Data := "This will fail to set"
MsgBox % "MyData.Data = " MyData.Data

Class FinalBox {
   __New(FinalValue) {
      ObjInsert(this, "proxy",{Data:FinalValue})
   }
; override the built-in methods:
   __Get(k) {
      return, this["proxy",k]
   }
   __Set(p*) {
      return
   }
   Insert(p*) {
      return
   }
   Remove(p*) {
      return
   }
}


import std.conv;
import std.stdio;

ulong uabs(ulong a, ulong b) {
    if (a > b) {
        return a - b;
    }
    return b - a;
}

bool isEsthetic(ulong n, ulong 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;
}

ulong[] esths;

void dfs(ulong n, ulong m, ulong i) {
    if (i >= n && i <= m) {
        esths ~= 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(n, m, i2);
    } else if (d == 9) {
        dfs(n, m, i1);
    } else {
        dfs(n, m, i1);
        dfs(n, m, i2);
    }
}

void listEsths(ulong n, ulong n2, ulong m, long m2, int perLine, bool all) {
    esths.length = 0;
    for (auto i = 0; i < 10; i++) {
        dfs(n2, m2, i);
    }
    auto le = esths.length;
    writefln("Base 10: %s esthetic numbers between %s and %s:", le, n, m);
    if (all) {
        foreach (c, esth; esths) {
            write(esth, ' ');
            if ((c + 1) % perLine == 0) {
                writeln;
            }
        }
        writeln;
    } else {
        for (auto i = 0; i < perLine; i++) {
            write(esths[i], ' ');
        }
        writeln("\n............");
        for (auto i = le - perLine; i < le; i++) {
            write(esths[i], ' ');
        }
        writeln;
    }
    writeln;
}

void main() {
    for (auto b = 2; b <= 16; b++) {
        writefln("Base %d: %dth to %dth esthetic numbers:", b, 4 * b, 6 * b);
        for (auto n = 1, c = 0; c < 6 * b; n++) {
            if (isEsthetic(n, b)) {
                c++;
                if (c >= 4 * b) {
                    write(to!string(n, b), ' ');
                }
            }
        }
        writeln;
    }
    writeln;

    // the following all use the obvious range limitations for the numbers in question
    listEsths(1000, 1010, 9999, 9898, 16, true);
    listEsths(cast(ulong) 1e8, 101_010_101, 13*cast(ulong) 1e7, 123_456_789, 9, true);
    listEsths(cast(ulong) 1e11, 101_010_101_010, 13*cast(ulong) 1e10, 123_456_789_898, 7, false);
    listEsths(cast(ulong) 1e14, 101_010_101_010_101, 13*cast(ulong) 1e13, 123_456_789_898_989, 5, false);
    listEsths(cast(ulong) 1e17, 101_010_101_010_101_010, 13*cast(ulong) 1e16, 123_456_789_898_989_898, 4, false);
}


 factor(c("apple", "banana", "cherry"))
# [1] apple  banana cherry
# Levels: apple banana cherry


#lang racket

;; Like other Lisps, Racketeers prefer using symbols directly instead of
;; numeric definitions, and lists of symbols instead of bitwise
;; combinations
(define fruits '(apple banana cherry))

;; In Typed Racket, a type can be defined for a specific set of symbols
;; (define-type Fruit (U 'apple 'banana 'cherry))

;; The conventional approach is possible too, of course
(define APPLE  1)
(define BANANA 2)
(define CHERRY 4)

;; And finally, when dealing with foreign functions it is useful to
;; translate idiomatic Racket values (= symbols) to/from integers.
;; Racket's ffi has two ways to do this -- either an enumeration (for
;; independent integer constants) or a bitmask (intended to represent
;; sets using bitwise or):
(require ffi/unsafe)
(define _fruit  (_enum '(APPLE = 1
                         BANANA
                         CHERRY = 4)))
(define _fruits (_bitmask '(APPLE = 1
                            BANANA = 2
                            CHERRY = 4)))

;; Normally, Racket code will just use plain values (a symbol for the
;; first, and a list of symbols for the second) and the foreign side
;; sees the integers.  But do demonstrate this, we can use the primitive
;; raw functionality to see how the translation works:
(require (only-in '#%foreign ctype-scheme->c ctype-c->scheme))

((ctype-scheme->c _fruit)  'CHERRY)         ; -> 4
((ctype-scheme->c _fruits) 'CHERRY)         ; -> 4
((ctype-scheme->c _fruits) '(APPLE CHERRY)) ; -> 5

((ctype-c->scheme _fruit)  4) ; -> 'CHERRY
((ctype-c->scheme _fruits) 4) ; -> '(CHERRY)
((ctype-c->scheme _fruits) 5) ; -> '(APPLE CHERRY)


enum Fruit <Apple Banana Cherry>; # Numbered 0 through 2.

enum ClassicalElement (
    Earth => 5,
    'Air',  # gets the value 6
    'Fire', # gets the value 7
    Water => 10,
);


{ 'apple' 0 'banana' 1 'cherry' 2 } as fruits


'/examples/enum.retro include

{ 'a=10 'b 'c 'd=998 'e 'f } a:enum


/*REXX program illustrates a method of  enumeration  of  constants via  stemmed arrays. */
fruit.=0                              /*the default for all possible "FRUITS."  (zero). */
           fruit.apple      =   65
           fruit.cherry     =    4
           fruit.kiwi       =   12
           fruit.peach      =   48
           fruit.plum       =   50
           fruit.raspberry  =   17
           fruit.tomato     = 8000
           fruit.ugli       =    2
           fruit.watermelon =    0.5  /*◄─────────── could also be specified as:   1/2  */

                                            /*A method of using a list (of some fruits).*/
@fruits= 'apple apricot avocado banana bilberry blackberry blackcurrant blueberry baobab',
         'boysenberry breadfruit cantaloupe cherry chilli chokecherry citron coconut',
         'cranberry cucumber currant date dragonfruit durian eggplant elderberry fig',
         'feijoa gac gooseberry grape grapefruit guava honeydew huckleberry jackfruit',
         'jambul juneberry kiwi kumquat lemon lime lingenberry loquat lychee mandarin',
         'mango mangosteen nectarine orange papaya passionfruit peach pear persimmon',
         'physalis pineapple pitaya pomegranate pomelo plum pumpkin rambutan raspberry',
         'redcurrant satsuma squash strawberry tangerine tomato ugli watermelon zucchini'

/*╔════════════════════════════════════════════════════════════════════════════════════╗
  ║Parental warning: sex is discussed below: PG─13.  Most berries don't have "berry" in║
  ║their name.  A  berry  is a  simple fruit  produced from a single ovary.  Some true ║
  ║berries are: pomegranate, guava, eggplant, tomato, chilli, pumpkin, cucumber, melon,║
  ║and citruses.  Blueberry  is a  false  berry;  blackberry is an  aggregate  fruit;  ║
  ║and strawberry is an  accessory  fruit.  Most nuts are fruits.  The following aren't║
  ║true nuts: almond, cashew, coconut, macadamia, peanut, pecan, pistachio, and walnut.║
  ╚════════════════════════════════════════════════════════════════════════════════════╝*/

                               /*  ┌─◄── due to a Central America blight in 1922; it was*/
                               /*  ↓     called the Panama disease (a soil─borne fungus)*/
if fruit.banana=0  then say "Yes!  We have no bananas today."               /* (sic) */
if fruit.kiwi \=0  then say "We gots "   fruit.kiwi    ' hairy fruit.'      /*   "   */
if fruit.peach\=0  then say "We gots "   fruit.peach   ' fuzzy fruit.'      /*   "   */

maxL=length('  fruit   ')                        /*ensure this header title can be shown*/
maxQ=length(' quantity ')                        /*   "     "    "      "    "   "   "  */
say
     do p    =0  for 2                           /*the first pass finds the maximums.   */
         do j=1  for words(@fruits)              /*process each of the names of fruits. */
         @=word(@fruits, j)                      /*obtain a fruit name from the list.   */
         #=value('FRUIT.'@)                      /*   "   the quantity of a fruit.      */
         if \p  then do                          /*is this the first pass through ?     */
                     maxL=max(maxL, length(@))   /*the longest (widest) name of a fruit.*/
                     maxQ=max(maxQ, length(#))   /*the widest width quantity of fruit.  */
                     iterate  /*j*/              /*now, go get another name of a fruit. */
                     end
         if j==1  then say center('fruit', maxL)    center("quantity", maxQ)
         if j==1  then say copies('─'    , maxL)    copies("─"       , maxQ)
         if #\=0  then say  right( @     , maxL)     right( #        , maxQ)
         end   /*j*/
     end       /*p*/
                                                 /*stick a fork in it,  we're all done. */


makepowers :-
    retractall(pow5(_, _)),
    between(1, 249, X),
    Y is X * X * X * X * X,
    assert(pow5(X, Y)),
    fail.
makepowers.

within(A, Bx, N) :-  % like between but with an exclusive upper bound
   succ(B, Bx),
   between(A, B, N).

solution(X0, X1, X2, X3, Y) :-
    makepowers,
    within(4, 250, X0), pow5(X0, X0_5th),
    within(3, X0,  X1), pow5(X1, X1_5th),
    within(2, X1,  X2), pow5(X2, X2_5th),
    within(1, X2,  X3), pow5(X3, X3_5th),
    Y_5th is X0_5th + X1_5th + X2_5th + X3_5th,
    pow5(Y, Y_5th).


EnableExplicit

; assumes an array of non-decreasing positive integers
Procedure.q BinarySearch(Array a.q(1), Target.q)
  Protected l = 0, r = ArraySize(a()), m
  Repeat
    If l > r : ProcedureReturn 0 : EndIf; no match found
    m = (l + r) / 2
    If a(m) < target
      l = m + 1
    ElseIf a(m) > target
      r = m - 1
    Else
      ProcedureReturn m ; match found
    EndIf
  ForEver
EndProcedure

Define i, x0, x1, x2, x3, y
Define.q sum
Define Dim p5.q(249)

For i = 1 To 249
  p5(i) = i * i * i * i * i
Next

If OpenConsole()
  For x0 = 1 To 249
    For x1 = 1 To x0 - 1
      For x2 = 1 To x1 - 1
        For x3 = 1 To x2 - 1
          sum = p5(x0) + p5(x1) + p5(x2) + p5(x3)
          y = BinarySearch(p5(), sum)
          If y > 0
            PrintN(Str(x0) + "^5 + " + Str(x1) + "^5 + " + Str(x2) + "^5 + " + Str(x3) + "^5 = " + Str(y) + "^5")
            Goto finish
          EndIf
        Next x3
      Next x2
    Next x1
  Next x0

  PrintN("No solution was found")
  finish:
  PrintN("")
  PrintN("Press any key to close the console")
  Repeat: Delay(10) : Until Inkey() <> ""
  CloseConsole()
EndIf


import "random" for Random

var target = "METHINKS IT IS LIKE A WEASEL"
var set = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
var rand = Random.new()

// fitness:  0 is perfect fit.  greater numbers indicate worse fit.
var fitness = Fn.new { |a| (0...target.count).count { |i| a[i] != target[i] } }

// set m to mutation of p, with each character of p mutated with probability r
var mutate = Fn.new { |p, m, r|
    var i = 0
    for (ch in p) {
        if (rand.float(1) < r) {
            m[i] = set[rand.int(set.count)]
        } else {
            m[i] = ch
        }
        i = i + 1
    }
}

var parent = List.filled(target.count, "")
(0...parent.count).each { |i| parent[i] = set[rand.int(set.count)] }
var c = 20 // number of times to copy and mutate parent
var copies = List.filled(c, null)
for (i in 0...c) copies[i] = List.filled(parent.count, 0)
System.print(parent.join())
var best = fitness.call(parent)
while (best > 0) {
    for (cp in copies) mutate.call(parent, cp, 0.05)
    for (cp in copies) {
        var fm = fitness.call(cp)
        if (fm < best) {
            best = fm
            parent = cp.toList
            System.print(parent.join())
        }
    }
}


/*REXX program tests and displays if an integer is  even or odd  using different styles.*/
!.=0;   do j=0  by 2  to 8;   !.j=1;   end       /*assign  0,2,4,6,8  to a "true" value.*/
                                                 /* [↑]  assigns even digits to  "true".*/
numeric digits 1000                              /*handle most huge numbers from the CL.*/
parse arg x _ .                                  /*get an argument from the command line*/
if x==''               then call terr "no integer input (argument)."
if _\=='' | arg()\==1  then call terr "too many arguments: "          _  arg(2)
if \datatype(x, 'N')   then call terr "argument isn't numeric: "      x
if \datatype(x, 'W')   then call terr "argument isn't an integer: "   x
y=abs(x)/1                                       /*in case  X  is negative or malformed,*/
                                                 /* [↑]  remainder of neg # might be -1.*/
                                                 /*malformed #s: 007  9.0  4.8e1  .21e2 */
call tell 'remainder method (oddness)'
if y//2  then say  x  'is odd'
         else say  x  'is even'
                                                 /* [↑]  uses division to get remainder.*/

call tell 'rightmost digit using BIF (not evenness)'
_=right(y, 1)
if pos(_, 86420)==0  then say x 'is odd'
                     else say x 'is even'
                                                 /* [↑]  uses 2 BIF (built─in functions)*/

call tell 'rightmost digit using BIF (evenness)'
_=right(y, 1)
if pos(_, 86420)\==0  then say x 'is even'
                      else say x 'is odd'
                                                 /* [↑]  uses 2 BIF (built─in functions)*/

call tell 'even rightmost digit using array (evenness)'
_=right(y, 1)
if !._  then say x 'is even'
        else say x 'is odd'
                                                 /* [↑]  uses a BIF (built─in function).*/

call tell 'remainder of division via function invoke (evenness)'
if even(y)  then say x 'is even'
            else say x 'is odd'
                                                 /* [↑]  uses (even) function invocation*/

call tell 'remainder of division via function invoke (oddness)'
if odd(y)  then say x 'is odd'
           else say x 'is even'
                                                 /* [↑]  uses (odd)  function invocation*/

call tell 'rightmost digit using BIF (not oddness)'
_=right(y, 1)
if pos(_, 13579)==0  then say x 'is even'
                     else say x 'is odd'
                                                 /* [↑]  uses 2 BIF (built─in functions)*/

call tell 'rightmost (binary) bit (oddness)'
if right(x2b(d2x(y)), 1)  then say x 'is odd'
                          else say x 'is even'
                                                 /* [↑]  requires extra numeric digits. */

call tell 'parse statement using BIF (not oddness)'
parse var  y   ''  -1  _                         /*obtain last decimal digit of the Y #.*/
if pos(_, 02468)==0  then say x 'is odd'
                     else say x 'is even'
                                                 /* [↑]  uses a BIF (built─in function).*/

call tell 'parse statement using array (evenness)'
parse var  y   ''  -1  _                         /*obtain last decimal digit of the Y #.*/
if !._  then say  x  'is even'
        else say  x  'is odd'
                                                 /* [↑]  this is the fastest algorithm. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
even:                     return \( arg(1)//2 )  /*returns "evenness" of arg, version 1.*/
even:                     return    arg(1)//2==0 /*   "         "      "  "      "    2.*/
even: parse arg '' -1 _;  return !._             /*   "         "      "  "      "    3.*/
                                                 /*last version shown is the fastest.   */
odd:                      return   arg(1)//2     /*returns  "oddness" of the argument.  */
tell: say;   say center('using the' arg(1), 79, "═");                    return
terr: say;   say '***error***';     say;    say arg(1);    say;          exit 13


import math, sequtils, strutils

iterator eqindex(data: openArray[int]): int =
  var suml, ddelayed = 0
  var sumr = sum(data)
  for i,d in data:
    suml += ddelayed
    sumr -= d
    ddelayed = d
    if suml == sumr:
      yield i

const d = @[@[-7, 1, 5, 2, -4, 3, 0],
            @[2, 4, 6],
            @[2, 9, 2],
            @[1, -1, 1, -1, 1, -1, 1]]

for data in d:
  echo "d = [", data.join(", "), ']'
  echo "eqIndex(d) -> [", toSeq(eqindex(data)).join(", "), ']'


class Rosetta {
  function : Main(args : String[]) ~ Nil {
    sequence := [-7, 1, 5, 2, -4, 3, 0];
    EqulibriumIndices(sequence);
  }

  function : EqulibriumIndices(sequence : Int[]) ~ Nil {
    # find total sum
    totalSum := 0;
    each(i : sequence) {
      totalSum += sequence[i];
    };

    # compare running sum to remaining sum to find equlibrium indices
    runningSum := 0;
    each(i : sequence) {
      n := sequence[i];
      if (totalSum - runningSum - n = runningSum) {
        i->PrintLine();
      };
      runningSum += n;
    };
  }
}


let lst = [ -7; 1; 5; 2; -4; 3; 0 ]
let sum = List.fold_left ( + ) 0 lst

let () =
  let rec aux acc i left right = function
  | x::xs ->
      let right = right - x in
      let acc = if left = right then i::acc else acc in
      aux acc (succ i) (left + x) right xs
  | [] -> List.rev acc
  in
  let res = aux [] 0 0 sum lst in
  print_string "Results:";
  List.iter (Printf.printf " %d") res;
  print_newline()


% Recursive
function fibb (n: int) : int
    if n < 2 then
        result n
    else
        result fibb (n-1) + fibb (n-2)
    end if
end fibb

% Iterative
function ifibb (n: int) : int
    var a := 0
    var b := 1
    for : 1 .. n
        a := a + b
        b := a - b
    end for
    result a
end ifibb

for i : 0 .. 10
    put fibb (i) : 4, ifibb (i) : 4
end for


import Foundation

let valids = [">", "<", "+", "-", ".", ",", "[", "]"] as Set<Character>
var ip = 0
var dp = 0
var data = [UInt8](count: 30_000, repeatedValue: 0)

let input = Process.arguments

if input.count != 2 {
    fatalError("Need one input file")
}

let infile: String!

do {
    infile = try String(contentsOfFile: input[1], encoding: NSUTF8StringEncoding) ?? ""
} catch let err {
    infile = ""
}

var program = ""

// remove invalid chars
for c in infile.characters {
    if valids.contains(c) {
        program += String(c)
    }
}

let numChars = program.characters.count

if numChars == 0 {
    fatalError("Error reading file")
}

func increaseInstructionPointer() {
    ip += 1
}

func executeInstruction(ins: Character) {
    switch ins {
    case ">":
        dp += 1
        increaseInstructionPointer()
    case "<":
        dp -= 1
        increaseInstructionPointer()
    case "+":
        data[dp] = data[dp] &+ 1
        increaseInstructionPointer()
    case "-":
        data[dp] = data[dp] &- 1
        increaseInstructionPointer()
    case ".":
        print(Character(UnicodeScalar(data[dp])), terminator: "")
        increaseInstructionPointer()
    case ",":
        handleIn()
        increaseInstructionPointer()
    case "[":
        handleOpenBracket()
    case "]":
        handleClosedBracket()
    default:
        fatalError("What")
    }
}

func handleIn() {
    let input = NSFileHandle.fileHandleWithStandardInput()
    let bytes = input.availableData.bytes
    let buf = unsafeBitCast(UnsafeBufferPointer(start: bytes, count: 1),
        UnsafeBufferPointer<UInt8>.self)

    data[dp] = buf[0]
}

func handleOpenBracket() {
    if data[dp] == 0 {
        var i = 1

        while i > 0 {
            ip += 1
            let ins = program[program.startIndex.advancedBy(ip)]

            if ins == "[" {
                i += 1
            } else if ins == "]" {
                i -= 1
            }
        }
    } else {
        increaseInstructionPointer()
    }
}

func handleClosedBracket() {
    if data[dp] != 0 {
        var i = 1

        while i > 0 {
            ip -= 1
            let ins = program[program.startIndex.advancedBy(ip)]

            if ins == "[" {
                i -= 1
            } else if ins == "]" {
                i += 1
            }
        }
    } else {
        increaseInstructionPointer()
    }
}

func tick() {
    let ins = program[program.startIndex.advancedBy(ip)]

    if valids.contains(ins) {
        executeInstruction(ins)
    } else {
        increaseInstructionPointer()
    }
}

while ip != numChars {
    tick()
}


#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
  printf >&2 'Usage: %s program-file\n' "$0"
  exit 1
fi

# load the program
exec 3<"$1"
program=()
while IFS=  read -r line <&3; do
  mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
  program+=("${instr[@]}")
done
exec 3<&-

# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
  instr=${program[pc]}
  if [[ $instr == '[' ]]; then
    loops=("$pc" "${loops[@]}")
  elif [[ $instr == ']' ]]; then
    matches[$pc]=${loops[0]}
    matches[${loops[0]}]=$pc
    loops=(${loops[@]:1})
  fi
done

# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
  instr=${program[pc]}
  (( pc+=1 ))
  mem=${memory[mp]}
  case "$instr" in
    '[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    ']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    +) memory[mp]=$(( (mem + 1) % 256 ));;
    -) memory[mp]=$(( (mem - 1) % 256 ));;
    '>') (( mp+=1 )); if (( mp >= ${#memory[@]} )); then memory+=(0); fi;;
    '<') (( mp-=1 )); if (( mp < 0 )); then memory=(0 "${memory[@]}"); mp=0; fi;;
    .) printf %b $(printf '\\%03o' "$mem");;
    ,) read -n1 c; memory[mp]=$(LC_CTYPE=C printf '%d' "'$c");;
  esac
done


fact
 if n < 1
    return
 endif
  * n fn fn
 - n
 call fact
 return

start

 if i < 20
    1 fn
    i n
    call fact
    fn []
    + i
    goif
 endif


templates factorial
  when <0..> do
    @: 1;
    1..$ -> @: [email protected] * $;
    [email protected] !
end factorial


      DEF FNconst = 2.71828182845905
      PRINT FNconst
      FNconst = 1.234 : REM Reports 'Syntax error'


myVar=immutable (m=mutable) immutable;
changed:?(myVar.m);
lst$myVar


#define PI      3.14159265358979323
#define MINSIZE 10
#define MAXSIZE 100


#include <iostream>

class MyOtherClass
{
public:
  const int m_x;
  MyOtherClass(const int initX = 0) : m_x(initX) { }

};

int main()
{
  MyOtherClass mocA, mocB(7);

  std::cout << mocA.m_x << std::endl; // displays 0, the default value given for MyOtherClass's constructor.
  std::cout << mocB.m_x << std::endl; // displays 7, the value we provided for the constructor for mocB.

  // Uncomment this, and the compile will fail; m_x is a const member.
  // mocB.m_x = 99;

  return 0;
}


// Generate Esthetic Numbers. Nigel Galloway: March 21st., 2020
let rec fN Σ n g = match g with h::t -> match List.head h with
                                         0 -> fN ((1::h)::Σ) n t
                                        |g when g=n-1 -> fN ((g-1::h)::Σ) n t
                                        |g -> fN ((g-1::h)::(g+1::h)::Σ) n t
                               |_    -> Σ

let Esthetic n = let Esthetic, g = fN [] n, [1..n-1] |> List.map(fun n->[n])
                 Seq.unfold(fun n->Some(n,Esthetic(List.rev n)))(g) |> Seq.concat

let EtoS n = let g = "0123456789abcdef".ToCharArray()
             n |> List.map(fun n->g.[n]) |> List.rev |> Array.ofList |> System.String


USING: combinators deques dlists formatting grouping io kernel
locals make math math.order math.parser math.ranges
math.text.english prettyprint sequences sorting strings ;

:: bfs ( from to num base -- )
    DL{ } clone :> q
    base 1 - :> ld
    num q push-front
    [ q deque-empty? ]
    [
        q pop-back :> step-num
        step-num from to between? [ step-num , ] when
        step-num zero? step-num to > or
        [
            step-num base mod :> last-digit
            step-num base * last-digit 1 - + :> a
            step-num base * last-digit 1 + + :> b

            last-digit
            {
                { 0 [ b q push-front ] }
                { ld [ a q push-front ] }
                [ drop a q push-front b q push-front ]
            } case

        ] unless

    ] until ;

:: esthetics ( from to base -- seq )
    [ base <iota> [| num | from to num base bfs ] each ]
    { } make natural-sort ;

: .seq ( seq width -- )
    group [ [ dup string? [ write ] [ pprint ] if bl ] each nl ]
    each nl ;

:: show ( base -- )
    base [ 4 * ] [ 6 * ] bi :> ( from to )
    from to [ dup ordinal-suffix ] [email protected] base
    "%d%s through %d%s esthetic numbers in base %d\n" printf
    from to 1 + 0 5000   ! enough for base 16
    base esthetics subseq [ base >base ] map 17 .seq ;

2 16 [a,b] [ show ] each

"Base 10 numbers between 1,000 and 9,999:" print
1,000 9,999 10 esthetics 16 .seq

"Base 10 numbers between 100,000,000 and 130,000,000:" print
100,000,000 130,000,000 10 esthetics 9 .seq

"Count of base 10 esthetic numbers between zero and one quadrillion:"
print 0 1e15 10 esthetics length .


apple = 0
banana = 1
cherry = 2
see "apple : " + apple + nl
see "banana : " + banana + nl
see "cherry : " + cherry + nl


module Fruits
  APPLE  = 0
  BANANA = 1
  CHERRY = 2
end

# It is possible to use a symbol if the value is unrelated.

FRUITS = [:apple, :banana, :cherry]
val = :banana
FRUITS.include?(val)      #=> true


enum Fruits {
    Apple,
    Banana,
    Cherry
}

enum FruitsWithNumbers {
    Strawberry = 0,
    Pear = 27,
}

fn main() {
    // Access to numerical value by conversion
    println!("{}", FruitsWithNumbers::Pear as u8);
}


sealed abstract class Fruit
case object Apple extends Fruit
case object Banana extends Fruit
case object Cherry extends Fruit


(define apple 0)
(define banana 1)
(define cherry 2)

(define (fruit? atom)
  (or (equal? 'apple atom)
      (equal? 'banana atom)
      (equal? 'cherry atom)))


const type: fruits is new enum
    apple, banana, cherry
  end enum;


def eulers_sum_of_powers():
    max_n = 250
    pow_5 = [n**5 for n in range(max_n)]
    pow5_to_n = {n**5: n for n in range(max_n)}
    for x0 in range(1, max_n):
        for x1 in range(1, x0):
            for x2 in range(1, x1):
                for x3 in range(1, x2):
                    pow_5_sum = sum(pow_5[i] for i in (x0, x1, x2, x3))
                    if pow_5_sum in pow5_to_n:
                        y = pow5_to_n[pow_5_sum]
                        return (x0, x1, x2, x3, y)

print("%i**5 + %i**5 + %i**5 + %i**5 == %i**5" % eulers_sum_of_powers())


include c:\cxpl\codes;          \intrinsic code declarations
string  0;                      \use zero-terminated convention (instead of MSb)

def     MutateRate = 15,        \1 chance in 15 of a mutation
        Copies = 30;            \number of mutated copies
char    Target, AlphaTbl;
int     SizeOfAlpha;

func    StrLen(Str);    \Return the number of characters in a string
char    Str;
int     I;
for I:= 0 to -1>>1-1 do
        if Str(I) = 0 then return I;

func    Unfitness(A, B); \Return number of characters different between A and B
char    A, B;
int     I, C;
[C:= 0;
for I:= 0 to StrLen(A)-1 do
        if A(I) # B(I) then C:= C+1;
return C;
];      \Unfitness

proc    Mutate(A, B);   \Copy string A to B, but with each character of B having
char    A, B;           \ a 1 in MutateRate chance of differing from A
int     I;
[for I:= 0 to StrLen(A)-1 do
        B(I):= if Ran(MutateRate) then A(I) else AlphaTbl(Ran(SizeOfAlpha));
B(I):= 0;               \terminate string
];      \Mutate

int     I, BestI, Diffs, Best, Iter;
def     SizeOfTarget = 28;
char    Specimen(Copies, SizeOfTarget+1);
int     ISpecimen, Temp;

[Target:= "METHINKS IT IS LIKE A WEASEL";
AlphaTbl:= "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
SizeOfAlpha:= StrLen(AlphaTbl);
ISpecimen:= Specimen;   \integer accesses pointers rather than bytes

\Initialize first Specimen, the parent, to a random string
for I:= 0 to SizeOfTarget-1 do
        Specimen(0,I):= AlphaTbl(Ran(SizeOfAlpha));
Specimen(0,I):= 0;      \terminate string

Iter:= 0;
repeat  for I:= 1 to Copies-1 do Mutate(ISpecimen(0), ISpecimen(I));

        Best:= SizeOfTarget;            \find best matching string
        for I:= 0 to Copies-1 do
                [Diffs:= Unfitness(Target, ISpecimen(I));
                if Diffs < Best then [Best:= Diffs;  BestI:= I];
                ];
        if BestI \#0\ then              \swap best string with first string
                [Temp:= ISpecimen(0);
                ISpecimen(0):= ISpecimen(BestI);
                ISpecimen(BestI):= Temp;
                ];
        Text(0, "Iter ");  IntOut(0, Iter);
        Text(0, " Score ");  IntOut(0, Best);
        Text(0, ": ");  Text(0, ISpecimen(0));  CrLf(0);
        Iter:= Iter+1;
until   Best = 0;
]


const target = "METHINKS IT IS LIKE A WEASEL";
const C = 100;  // Number of children in each generation.
const P = 0.05; // Mutation probability.
const A2ZS = ["A".."Z"].walk().append(" ").concat();
fcn fitness(s){ Utils.zipWith('!=,target,s).sum(0) } // bigger is worser
fcn rnd{ A2ZS[(0).random(27)] }
fcn mutate(s){ s.apply(fcn(c){ if((0.0).random(1) < P) rnd() else c }) }

parent := target.len().pump(String,rnd);  // random string of "A..Z "
gen:=0; do{  // mutate C copies of parent and pick the fittest
   parent = (0).pump(C,List,T(Void,parent),mutate)
	    .reduce(fcn(a,b){ if(fitness(a)<fitness(b)) a else b });
   println("Gen %2d, dist=%2d: %s".fmt(gen+=1, fitness(parent), parent));
}while(parent != target);


size = 10
for i = 1 to size
    if i % 2 = 1 see "" + i + " is odd" + nl
    else see "" + i + " is even" + nl ok
next


print "evens: "
p -5.upto(5).select(&:even?)
print "odds: "
p -5.upto(5).select(&:odd?)


for i = 1 to 10
  if i and 1 then print i;" is odd" else print i;" is even"
next i


: equilibrium(l)
| ls rs i e |
   0 ->ls
   l sum ->rs
   ListBuffer new l size loop: i [
      l at(i) ->e
      rs e - dup ->rs ls == ifTrue: [ i over add ]
      ls e + ->ls
      ] ;


Program EquilibriumIndexDemo(output);

{$IFDEF FPC}{$Mode delphi}{$ENDIF}

function ArraySum(list: array of integer; first, last: integer): integer;
  var
    i: integer;
  begin
    Result := 0;
    for i := first to last do  // not taken if first > last
      Result := Result + list[i];
  end;

procedure EquilibriumIndex(list: array of integer; offset: integer);
  var
    i: integer;
  begin
    for i := low(list) to high(list) do
      if ArraySum(list, low(list), i-1) = ArraySum(list, i+1, high(list)) then
        write(offset + i:3);
  end;

var
{** The base index of the array is fully taken care off and can be any number. **}
  numbers: array [1..7] of integer = (-7, 1, 5, 2, -4, 3, 0);
  i: integer;

begin
  write('List of numbers: ');
  for i := low(numbers) to high(numbers) do
    write(numbers[i]:3);
  writeln;
  write('Equilibirum indices: ');
  EquilibriumIndex(numbers, low(numbers));
  writeln;
end.


$$ MODE TUSCRIPT
ASK "What fibionacci number do you want?": searchfib=""
IF (searchfib!='digits') STOP
Loop n=0,{searchfib}
 IF (n==0) THEN
   fib=fiba=n
 ELSEIF (n==1) THEN
   fib=fibb=n
 ELSE
   fib=fiba+fibb, fiba=fibb, fibb=fib
 ENDIF
 IF (n!=searchfib) CYCLE
 PRINT "fibionacci number ",n,"=",fib
ENDLOOP


#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
  printf >&2 'Usage: %s program-file\n' "$0"
  exit 1
fi

# load the program
exec 3<"$1"
program=()
while IFS=  read -r line <&3; do
  mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
  program+=("${instr[@]}")
done
exec 3<&-

# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
  instr=${program[pc]}
  if [[ $instr == '[' ]]; then
    loops=("$pc" "${loops[@]}")
  elif [[ $instr == ']' ]]; then
    matches[$pc]=${loops[0]}
    matches[${loops[0]}]=$pc
    loops=(${loops[@]:1})
  fi
done

# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
  instr=${program[pc]}
  (( pc+=1 ))
  mem=${memory[mp]}
  case "$instr" in
    '[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    ']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    +) memory[mp]=$(( (mem + 1) % 256 ));;
    -) memory[mp]=$(( (mem - 1) % 256 ));;
    '>') (( mp+=1 )); if (( mp >= ${#memory[@]} )); then memory+=(0); fi;;
    '<') (( mp-=1 )); if (( mp < 0 )); then memory=(0 "${memory[@]}"); mp=0; fi;;
    .) printf %b $(printf '\\%03o' "$mem");;
    ,) read -n1 c; memory[mp]=$(LC_CTYPE=C printf '%d' "'$c");;
  esac
done


proc ifact n {
    for {set i $n; set sum 1} {$i >= 2} {incr i -1} {
        set sum [expr {$sum * $i}]
    }
    return $sum
}


user> (def d [1 2 3 4 5]) ; immutable vector
#'user/d
user> (assoc d 3 7)
[1 2 3 7 5]
user> d
[1 2 3 4 5]


ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
    SYMBOLIC CHARACTERS NUL IS 0, TAB IS 9.


import std.random;

// enum allows to define manifest (compile-time) constants:
int sqr(int x) { return x ^^ 2; }
enum int x = 5;
enum y = sqr(5); // Forces Compile-Time Function Evaluation (CTFE).

// enums are compile-time constants:
enum MyEnum { A, B, C }

// immutable defines values that can't change:
immutable double pi = 3.1415;

// A module-level immutable storage class variable that's not
// explicitly initialized can be initialized by its constructor,
// otherwise its value is the default initializer during its life-time.

immutable int z;

static this() {
    z = uniform(0, 100); // Run-time initialization.
}

class Test1 {
    immutable int w;

    this() {
        w = uniform(0, 100); // Run-time initialization.
    }
}

// The items array can't be immutable here.
// "in" is short for "const scope":
void foo(const scope int[] items) {
    // items is constant here.
    // items[0] = 100; // Cannot modify const expression.
}

struct Test2 {
    int x_; // Mutable.
    @property int x() { return this.x_; }
}

// Unlike C++, D const and immutable are transitive.
// And there is also "inout". See D docs.

void main() {
    int[] data = [10, 20, 30];
    foo(data);
    data[0] = 100; // But data is mutable here.

    // Currently manifest constants like arrays and associative arrays
    // are copied in-place every time they are used:
    enum array = [1, 2, 3];
    foo(array);

    auto t = Test2(100);
    auto x2 = t.x; // Reading x is allowed.
    assert(x2 == 100);

    // Not allowed, the setter property is missing:
    // t.x = 10; // Error: not a property t.x
}


\ Returns the next esthetic number in the given base after n, where n is an
\ esthetic number in that base or one less than a power of base.
: next_esthetic_number { n base -- n }
  n 1+ base < if n 1+ exit then
  n base / dup base mod
  dup n base mod 1+ = if dup 1+ base < if 2drop n 2 + exit then then
  drop base recurse
  dup base mod
  dup 0= if 1+ else 1- then
  swap base * + ;

: print_esthetic_numbers { min max per_line -- }
  ." Esthetic numbers in base 10 between " min 1 .r ."  and " max 1 .r ." :" cr
  0
  min 1- 10 next_esthetic_number
  begin
    dup max <=
  while
    dup 4 .r
    swap 1+ dup per_line mod 0= if cr else space then swap
    10 next_esthetic_number
  repeat
  drop
  cr ." count: " . cr ;

: main
  17 2 do
    i 4 * i 6 * { min max }
    ." Esthetic numbers in base " i 1 .r ."  from index " min 1 .r ."  through index " max 1 .r ." :" cr
    0
    max 1+ 1 do
      j next_esthetic_number
      i min >= if dup ['] . j base-execute then
    loop
    drop
    cr cr
  loop
  1000 9999 16 print_esthetic_numbers cr
  100000000 130000000 8 print_esthetic_numbers ;

main
bye


dim shared as string*16 digits = "0123456789ABCDEF"

function get_digit( n as uinteger ) as string
    return mid(digits, n+1, 1)
end function

function find_digit( s as string ) as integer
    for i as uinteger = 1 to len(digits)
        if s = mid(digits, i, 1) then return i
    next i
    return -999
end function

sub make_base( byval n as uinteger, bse as uinteger, byref ret as string )
    if n = 0 then ret = "0" else ret = ""
    dim as uinteger m
    while n > 0
        m = n mod bse
        ret = mid(digits, m+1, 1) + ret
        n = (n - m)/bse
    wend
end sub

function is_esthetic( number as string ) as boolean
    if number = "0" then return false
    if len(number) = 1 then return true
    dim as integer curr = find_digit( left(number,1) ), last, i
    for i = 2 to len(number)
        last = curr
        curr = find_digit( mid(number, i, 1) )
        if abs( last - curr ) <> 1 then return false
    next i
    return true
end function

dim as uinteger b, c
dim as ulongint i
dim as string number
for b = 2 to 16
    print "BASE ";b
    i = 0 : c = 0
    while c <= 6*b
        i += 1
        make_base i, b, number
        if is_esthetic( number ) then
            c += 1
            if c >= 4*b then print number;" ";
        end if
    wend
    print
next b
print "BASE TEN"
for i = 1000 to 9999
    make_base i, 10, number
    if is_esthetic(number) then print number;" ";
next i
print
print "STRETCH GOAL"
for i = 100000000 to 130000000
    make_base i, 10, number
    if is_esthetic(number) then print number;" ";
next i


(tc +)

(datatype fruit

  if (element? Fruit [apple banana cherry])
  _____________
  Fruit : fruit;)


enum {Apple, Banana, Cherry};   # numbered 0 through 2


define: #Fruit &parents: {Cloneable}.
Fruit traits define: #Apple -> Fruit clone.
Fruit traits define: #Banana -> Fruit clone.
Fruit traits define: #Cherry -> Fruit clone.


datatype fruit =
  Apple
| Banana
| Cherry


enum Fruit {
    case Apple
    case Banana
    case Cherry
}
// or
enum Fruit {
    case Apple, Banana, Cherry
}

enum Season : Int {
    case Winter = 1
    case Spring = 2
    case Summer = 3
    case Autumn = 4
}


proc enumerate {name values} {
    interp alias {} $name: {} lsearch $values
    interp alias {} $name@ {} lindex $values
}


needs enum
0 enum| apple banana carrot |
10 enum| foo bar baz |


'this enumerates from 0
Enum fruits
  apple
  banana
  cherry
End Enum

'here we use our own enumeration
Enum fruits2
  pear = 5
  mango = 10
  kiwi = 20
  pineapple = 20
End Enum

Sub test()
Dim f As fruits
  f = apple
  Debug.Print "apple equals "; f
  Debug.Print "kiwi equals "; kiwi
  Debug.Print "cherry plus kiwi plus pineapple equals "; cherry + kiwi + pineapple
End Sub


1 CLS
2 DIM i%(255,6) : DIM a%(6) : DIM c%(6)
3 DIM v%(255,6) : DIM b%(6) : DIM d%(29)
4 RESTORE 137
6      FOR m=0 TO 6
7    READ t%
8    FOR j=1 TO 255
11 LET i%(j,m)=j MOD t%
12 LET v%(j,m)=(i%(j,m) * i%(j,m))MOD t%
14 LET v%(j,m)=(v%(j,m) * v%(j,m))MOD t%
15 LET v%(j,m)=(v%(j,m) * i%(j,m))MOD t%
17  END FOR j : END FOR m
19 PRINT "Abaci ready"
21 FOR j=10 TO 29: d%(j)=210+ j
24 FOR j=0 TO 9: d%(j)=240+ j
25 LET t%=48
30      FOR w=6 TO 246 STEP 3
33     LET o=w
42     FOR x=4 TO 248 STEP 2
44    IF o<x THEN o=x
46    FOR m=1 TO 6: a%(m)=i%((v%(w,m)+v%(x,m)),m)
50    FOR y=10 TO 245 STEP 5
54   IF o<y THEN o=y
56   FOR m=1 TO 6: b%(m)=i%((a%(m)+v%(y,m)),m)
57   FOR z=14 TO 245 STEP 7
59  IF o<z THEN o=z
60  FOR m=1 TO 6: c%(m)=i%((b%(m)+v%(z,m)),m)
65  LET s$="" : FOR m=1 TO 6: s$=s$&CHR$(c%(m)+t%)
70  LET o=o+1 : j=d%(i%((i%(w,0)+i%(x,0)+i%(y,0)+i%(z,0)),0))
75  IF j<o THEN NEXT z
80  FOR k=j TO o STEP -30
85 LET e$="" : FOR m=1 TO 6: e$=e$&CHR$(v%(k,m)+t%)
90 IF s$=e$ THEN PRINT w,x,y,z,k,s$,e$: STOP
95  END FOR k : END FOR z : END FOR y : END FOR x : END FOR w
137 DATA 30,97,113,121,125,127,128


rem - return true (-1) if even, otherwise false (0)
function even(i = integer) = integer
var one = integer    rem - both operands must be variables
one = 1
end = ((i and one) = 0)

rem - exercise the function
var i = integer
for i = 1 to 10 step 3
   print i; " is ";
   if even(i) then
     print "even"
   else
     print "odd"
next

end


def isEven( v:Int ) : Boolean = v % 2 == 0
def isOdd( v:Int ) : Boolean = v % 2 != 0


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

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


#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
  printf >&2 'Usage: %s program-file\n' "$0"
  exit 1
fi

# load the program
exec 3<"$1"
program=()
while IFS=  read -r line <&3; do
  mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
  program+=("${instr[@]}")
done
exec 3<&-

# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
  instr=${program[pc]}
  if [[ $instr == '[' ]]; then
    loops=("$pc" "${loops[@]}")
  elif [[ $instr == ']' ]]; then
    matches[$pc]=${loops[0]}
    matches[${loops[0]}]=$pc
    loops=(${loops[@]:1})
  fi
done

# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
  instr=${program[pc]}
  (( pc+=1 ))
  mem=${memory[mp]}
  case "$instr" in
    '[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    ']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    +) memory[mp]=$(( (mem + 1) % 256 ));;
    -) memory[mp]=$(( (mem - 1) % 256 ));;
    '>') (( mp+=1 )); if (( mp >= ${#memory[@]} )); then memory+=(0); fi;;
    '<') (( mp-=1 )); if (( mp < 0 )); then memory=(0 "${memory[@]}"); mp=0; fi;;
    .) printf %b $(printf '\\%03o' "$mem");;
    ,) read -n1 c; memory[mp]=$(LC_CTYPE=C printf '%d' "'$c");;
  esac
done


factorial(x)
Func
  Return Π(y,y,1,x)
EndFunc


function Factorial(%num)
{
    if(%num < 2)
        return 1;
    for(%a = %num-1; %a > 1; %a--)
        %num *= %a;
    return %num;
}


const
  STR1 = 'abc';         // regular constant
  STR2: string = 'def'; // typed constant


let pi = 3.14
let helloWorld = "Hello, world!"


iex(1)> x = 10          # bind
10
iex(2)> 10 = x          # Pattern matching
10
iex(3)> x = 20          # rebound
20
iex(4)> ^x = 10         # pin operator ^
** (MatchError) no match of right hand side value: 10


constant n = 1
constant s = {1,2,3}
constant str = "immutable string"


package main

import (
    "fmt"
    "strconv"
)

func uabs(a, b uint64) uint64 {
    if a > b {
        return a - b
    }
    return b - a
}

func isEsthetic(n, b uint64) bool {
    if n == 0 {
        return false
    }
    i := n % b
    n /= b
    for n > 0 {
        j := n % b
        if uabs(i, j) != 1 {
            return false
        }
        n /= b
        i = j
    }
    return true
}

var esths []uint64

func dfs(n, m, i uint64) {
    if i >= n && i <= m {
        esths = append(esths, 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)
    }
}

func listEsths(n, n2, m, m2 uint64, perLine int, all bool) {
    esths = esths[:0]
    for i := uint64(0); i < 10; i++ {
        dfs(n2, m2, i)
    }
    le := len(esths)
    fmt.Printf("Base 10: %s esthetic numbers between %s and %s:\n",
        commatize(uint64(le)), commatize(n), commatize(m))
    if all {
        for c, esth := range esths {
            fmt.Printf("%d ", esth)
            if (c+1)%perLine == 0 {
                fmt.Println()
            }
        }
    } else {
        for i := 0; i < perLine; i++ {
            fmt.Printf("%d ", esths[i])
        }
        fmt.Println("\n............\n")
        for i := le - perLine; i < le; i++ {
            fmt.Printf("%d ", esths[i])
        }
    }
    fmt.Println("\n")
}

func commatize(n uint64) string {
    s := fmt.Sprintf("%d", n)
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    return s
}

func main() {
    for b := uint64(2); b <= 16; b++ {
        fmt.Printf("Base %d: %dth to %dth esthetic numbers:\n", b, 4*b, 6*b)
        for n, c := uint64(1), uint64(0); c < 6*b; n++ {
            if isEsthetic(n, b) {
                c++
                if c >= 4*b {
                    fmt.Printf("%s ", strconv.FormatUint(n, int(b)))
                }
            }
        }
        fmt.Println("\n")
    }

    // the following all use the obvious range limitations for the numbers in question
    listEsths(1000, 1010, 9999, 9898, 16, true)
    listEsths(1e8, 101_010_101, 13*1e7, 123_456_789, 9, true)
    listEsths(1e11, 101_010_101_010, 13*1e10, 123_456_789_898, 7, false)
    listEsths(1e14, 101_010_101_010_101, 13*1e13, 123_456_789_898_989, 5, false)
    listEsths(1e17, 101_010_101_010_101_010, 13*1e16, 123_456_789_898_989_898, 4, false)
}


' Is this valid?!
Enum fruits
apple
banana
cherry
End Enum

' This is correct
Enum fruits
apple = 0
banana = 1
cherry = 2
End Enum


var APPLE  = 1
var ORANGE = 2
var PEAR   = 3

var CHERRY = 4
var BANANA = CHERRY + 1
var GRAPE  = BANANA + 1

System.print([APPLE, ORANGE, PEAR, CHERRY, BANANA, GRAPE])


def \Fruit\ Apple, Banana, Cherry;      \Apple=0, Banana=1, Cherry=2
def     Apple=1, Banana=2, Cherry=4;


Sunday equ 0
Monday equ 1
Tuesday equ 2
Wednesday equ 3
Thursday equ 4
Friday equ 5
Saturday equ 6


const RGB_COLOR{  // put color names in a name space
   const RED =0xf00;
   const BLUE=0x0f0, GREEN = 0x00f;
   const CYAN=BLUE + GREEN;  // → 0x0ff
}
println(RGB_COLOR.BLUE);


module Enumerations;
type
	Fruits = (apple,banana,cherry);

var
	deserts,i: Fruits;

begin
		deserts := Fruits.banana;
		writeln("ord(deserts): ",integer(deserts):2);

		for i := Fruits.apple to Fruits.cherry do
			writeln(integer(i):2)
		end
end Enumerations.


#lang racket
(define MAX 250)
(define pow5 (make-vector MAX))
(for ([i (in-range 1 MAX)])
  (vector-set! pow5 i (expt i 5)))
(define pow5s (list->set (vector->list pow5)))
(let/ec break
  (for* ([x0 (in-range 1 MAX)]
         [x1 (in-range 1 x0)]
         [x2 (in-range 1 x1)]
         [x3 (in-range 1 x2)])
    (define sum (+ (vector-ref pow5 x0)
                   (vector-ref pow5 x1)
                   (vector-ref pow5 x2)
                   (vector-ref pow5 x3)))
    (when (set-member? pow5s sum)
      (displayln (list x0 x1 x2 x3 (inexact->exact (round (expt sum 1/5)))))
      (break))))


set num to random of 100 -- start with a random number from 1 to 100

// use the 'is a' operator to test the value
if num is an odd number then put num & " is odd"

// see if num is divisible by 2
if num is divisible by 2 then put num & " is even (is divisible by 2)"

// check to see if the remainder is 0 when dividing by 2
if num rem 2 is 0 then put num & " is even (zero remainder)"


<?php
$arr = array(-7, 1, 5, 2, -4, 3, 0);

function getEquilibriums($arr) {
    $right = array_sum($arr);
    $left = 0;
    $equilibriums = array();
    foreach($arr as $key => $value){
        $right -= $value;
        if($left == $right) $equilibriums[] = $key;
        $left += $value;
    }
    return $equilibriums;
}

echo "# results:\n";
foreach (getEquilibriums($arr) as $r) echo "$r, ";
?>


equilibrium_index1(A, Ix) =>
  append(Front, [_|Back], A),
  sum(Front) = sum(Back),
  Ix = length(Front)+1. % give 1 based index


(de equilibria (Lst)
   (make
      (let Sum 0
         (for ((I . L) Lst L (cdr L))
            (and (= Sum (sum prog (cdr L))) (link I))
            (inc 'Sum (car L)) ) ) ) )


F halve(x)
   R x I/ 2

F double(x)
   R x * 2

F even(x)
   R !(x % 2)

F ethiopian(=multiplier, =multiplicand)
   V result = 0

   L multiplier >= 1
      I !even(multiplier)
         result += multiplicand
      multiplier = halve(multiplier)
      multiplicand = double(multiplicand)

   R result

print(ethiopian(17, 34))


echo 1 |tee last fib ; tail -f fib | while read x
do
   cat last | tee -a fib | xargs -n 1 expr $x + |tee last
done


#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
  printf >&2 'Usage: %s program-file\n' "$0"
  exit 1
fi

# load the program
exec 3<"$1"
program=()
while IFS=  read -r line <&3; do
  mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
  program+=("${instr[@]}")
done
exec 3<&-

# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
  instr=${program[pc]}
  if [[ $instr == '[' ]]; then
    loops=("$pc" "${loops[@]}")
  elif [[ $instr == ']' ]]; then
    matches[$pc]=${loops[0]}
    matches[${loops[0]}]=$pc
    loops=(${loops[@]:1})
  fi
done

# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
  instr=${program[pc]}
  (( pc+=1 ))
  mem=${memory[mp]}
  case "$instr" in
    '[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    ']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    +) memory[mp]=$(( (mem + 1) % 256 ));;
    -) memory[mp]=$(( (mem - 1) % 256 ));;
    '>') (( mp+=1 )); if (( mp >= ${#memory[@]} )); then memory+=(0); fi;;
    '<') (( mp-=1 )); if (( mp < 0 )); then memory=(0 "${memory[@]}"); mp=0; fi;;
    .) printf %b $(printf '\\%03o' "$mem");;
    ,) read -n1 c; memory[mp]=$(LC_CTYPE=C printf '%d' "'$c");;
  esac
done


DEF FNfactorial(n)
    LET f = 1
    FOR  i = 2 TO n
        LET f = f*i
    NEXT i
    LET FNfactorial = f
END DEF
END


TUPLE: range
    { from read-only } { length read-only } { step read-only } ;


256 constant one-hex-dollar
s" Hello world" 2constant hello \ "hello" holds the address and length of an anonymous string.
355 119 2constant ratio-pi \ 2constant can also define ratios (e.g. pi)
3.14159265e fconstant pi


#define IMMUT1 32767    'constants can be created in the preprocessor
dim as const uinteger IMMUT2 = 2222  'or explicitly declared as constants


import Data.List (unfoldr, genericIndex)
import Control.Monad (replicateM, foldM, mzero)

-- a predicate for esthetic numbers
isEsthetic b = all ((== 1) . abs) . differences . toBase b
  where
    differences lst = zipWith (-) lst (tail lst)

-- Monadic solution, inefficient for small bases.
esthetics_m b =
  do differences <- (\n -> replicateM n [-1, 1]) <$> [0..]
     firstDigit <- [1..b-1]
     differences >>= fromBase b <$> scanl (+) firstDigit

-- Much more efficient iterative solution (translation from Python).
-- Uses simple list as an ersatz queue.
esthetics b = tail $ fst <$> iterate step (undefined, q)
  where
    q = [(d, d) | d <- [1..b-1]]
    step (_, queue) =
      let (num, lsd) = head queue
          new_lsds = [d | d <- [lsd-1, lsd+1], d < b, d >= 0]
      in (num, tail queue ++ [(num*b + d, d) | d <- new_lsds])

-- representation of numbers as digits
fromBase b = foldM f 0
  where f r d | d < 0 || d >= b = mzero
              | otherwise = pure (r*b + d)

toBase b = reverse . unfoldr f
  where
    f 0 = Nothing
    f n = let (q, r) = divMod n b in Just (r, q)

showInBase b = foldMap (pure . digit) . toBase b
  where digit = genericIndex (['0'..'9'] <> ['a'..'z'])


/*REXX program finds unique positive integers for ────────── aⁿ+bⁿ+cⁿ+dⁿ==xⁿ  where n=5 */
parse arg L H N .                                /*get optional  LOW, HIGH,  #solutions.*/
if L=='' | L==","  then L=   0  + 1              /*Not specified?  Then use the default.*/
if H=='' | H==","  then H= 250  - 1              /* "      "         "   "   "     "    */
if N=='' | N==","  then N=   1                   /* "      "         "   "   "     "    */
w= length(H)                                     /*W:  used for display aligned numbers.*/
say center(' 'subword(sourceLine(1), 9, 3)" ", 70 +5*w, '─')  /*show title from 1st line*/
numeric digits 1000                              /*be able to handle the next expression*/
numeric digits max(9, length(3*H**5) )           /* "   "   "    "   3* [H to 5th power]*/
bH= H - 2;                 cH= H - 1             /*calculate the upper  DO  loop limits.*/
!.= 0                                            /* [↓]  define values of  5th  powers. */
       do pow=1  for H;    @.pow= pow**5;     _= @.pow;        !._= 1;          $._= pow
       end   /*pow*/
?.= !.
       do    j=4   for H-3                       /*use the range of:   four  to   cH.   */
          do k=j+1  to H;  _= @.k - @.j;  ?._= 1 /*compute the   xⁿ - dⁿ    differences.*/
          end   /*k*/                            /* [↑]  diff. is always positive as k>j*/
       end      /*j*/                            /*define [↑]    5th  power differences.*/
#= 0                                             /*#:  is the number of solutions found.*/   /* [↓]  for N=∞ solutions.*/
    do       a=L    to H-3                       /*traipse through possible  A  values. */   /*◄──done       246 times.*/
      do     b=a+1  to bH;      s1= @.a + @.b    /*   "       "        "     B    "     */   /*◄──done    30,381 times.*/
        do   c=b+1  to cH;      s2= s1  + @.c    /*   "       "        "     C    "     */   /*◄──done 2,511,496 times.*/
        if ?.s2  then do d=c+1  to H;  s= [email protected].d /*find the appropriate solution.       */
                      if !.s  then call show     /*Is it a solution?   Then display it. */
                      end   /*d*/                /* [↑]    !.S  is a boolean.           */
        end                 /*c*/
      end                   /*b*/
    end                     /*a*/

if #==0  then say "Didn't find a solution.";           exit 0
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: _= left('', 5);     #= # + 1               /*_:  used as a spacer; bump # counter.*/
      say _  'solution'   right(#, length(N))":"  _  'a='right(a, w)   _  "b="right(b, w),
          _  'c='right(c, w)     _    "d="right(d, w)     _    'x='right($.s, w+1)
      if #<N  then return                        /*return, keep searching for more sols.*/
      exit #                                     /*stick a fork in it,  we're all done. */


even(x) := x mod 2 = 0;
odd(x) := x mod 2 = 1;


xs := {1..10};
evens := {x in xs | even( x )};
odds := {x in xs | odd( x )};
print( evens );
print( odds );


function Get-EquilibriumIndex ( $Sequence )
    {
    $Indexes = 0..($Sequence.Count - 1)
    $EqulibriumIndex = @()

    ForEach ( $TestIndex in $Indexes )
        {
        $Left = 0
        $Right = 0
        ForEach ( $Index in $Indexes )
            {
            If     ( $Index -lt $TestIndex ) { $Left  += $Sequence[$Index] }
            ElseIf ( $Index -gt $TestIndex ) { $Right += $Sequence[$Index] }
            }

        If ( $Left -eq $Right )
            {
            $EqulibriumIndex += $TestIndex
            }
        }
    return $EqulibriumIndex
    }


equilibrium_index(List, Index) :-
    append(Front, [_|Back], List),
    sumlist(Front, Sum),
    sumlist(Back,  Sum),
    length(Front, Len),
    Index is Len.


	org	100h
	jmp	demo
	;;;	HL = BC * DE
	;;;	BC is left column, DE is right column
emul:	lxi	h,0	; HL will be the accumulator

ztest:	mov	a,b	; Check if the left column is zero.
	ora	c	; If so, stop.
	rz

halve:	mov	a,b	; Halve BC by rotating it right.
	rar		; We know the carry is zero here because of the ORA.
	mov	b,a	; So rotate the top half first,
	mov	a,c	; Then the bottom half
	rar		; This leaves the old low bit in the carry flag,
	mov	c,a	; so this also lets us do the even/odd test in one go.

even:	jnc	$+4	; If no carry, the number is even, so skip (strikethrough)
	dad	d	; But if odd, add the number in the right column

double:	xchg		; Doubling DE is a bit easier since you can add
	dad	h	; HL to itself in one go, and XCHG swaps DE and HL
	xchg

	jmp	ztest	; We want to do the whole thing again until BC is zero

	;;;	Demo code, print 17 * 34
demo:	lxi	b,17	; Load 17 into BC (left column)
	lxi	d,34	; Load 34 into DE (right column)
	call	emul	; Do the multiplication

print:	lxi	b,-10	; Decimal output routine (not very interesting here,
	lxi	d,pbuf	; but without it you can't see the result)
	push	d
digit:	lxi 	d,-1
dloop:	inx	d
	dad	b
	jc	dloop
	mvi	a,58
	add	l
	pop	h
	dcx	h
	mov	m,a
	push 	h
	xchg
	mov	a,h
	ora	l
	jnz	digit
	pop	d
	mvi	c,9
	jmp	5
	db	'*****'
pbuf:	db	'$'


(include-book "arithmetic-3/top" :dir :system)

(defun halve (x)
   (floor x 2))

(defun double (x)
   (* x 2))

(defun is-even (x)
   (evenp x))

(defun multiply (x y)
   (if (zp (1- x))
       y
       (+ (if (is-even x)
              0
              y)
          (multiply (halve x) (double y)))))


def fibIter (int n)
	if (< n 2)
		return n
	end if
	decl int fib fibPrev num
	set fib (set fibPrev 1)
	for (set num 2) (< num n) (inc num)
		set fib (+ fib fibPrev)
		set fibPrev (- fib fibPrev)
	end for
	return fib
end


'Execute BrainFuck
'VBScript Implementation

'The Main Interpreter
Function BFInpt(s, sp, d, dp, i, ip, o)
    While sp < Len(s)
        Select Case Mid(s, sp + 1, 1)
            Case "+"
                newd = Asc(d(dp)) + 1
                If newd > 255 Then newd = newd Mod 256    'To take account of values over 255
                d(dp) = Chr(newd)
            Case "-"
                newd = Asc(d(dp)) - 1
                If newd < 0 Then newd = (newd Mod 256) + 256    'To take account of negative values
                d(dp) = Chr(newd)
            Case ">"
                dp = dp + 1
                If dp > UBound(d) Then
                    ReDim Preserve d(UBound(d) + 1)
                    d(dp) = Chr(0)
                End If
            Case "<"
                dp = dp - 1
            Case "."
                o = o & d(dp)
            Case ","
                If ip = Len(i) Then d(dp) = Chr(0) Else ip = ip + 1 : d(dp) = Mid(i, ip, 1)
            Case "["
                If Asc(d(dp)) = 0 Then
                    bracket = 1
                    While bracket And sp < Len(s)
                        sp = sp + 1
                        If Mid(s, sp + 1, 1) = "[" Then
                            bracket = bracket + 1
                        ElseIf Mid(s, sp + 1, 1) = "]" Then
                            bracket = bracket - 1
                        End If
                    WEnd
                Else
                    pos = sp - 1
                    sp = sp + 1
                    If BFInpt(s, sp, d, dp, i, ip, o) Then sp = pos
                End If
            Case "]"
                BFInpt = Asc(d(dp)) <> 0
                Exit Function
        End Select
        sp = sp + 1
    WEnd
End Function

'This Prepares the Intepreter
Function BFuck(source, input)
    Dim data() : ReDim data(0)
    data(0)  = Chr(0)
    DataPtr  = 0
    SrcPtr   = 0
    InputPtr = 0
    output   = ""

    BFInpt source , SrcPtr   , _
           data   , DataPtr  , _
           input  , InputPtr , _
           output
    BFuck = output
End Function

'Sample Run
'The input is a string. The first character will be scanned by the first comma
'in the code, the next character will be scanned by the next comma, and so on.

code   = ">++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>" & _
         ">+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++."
inpstr = ""
WScript.StdOut.Write BFuck(code, inpstr)


$$ MODE TUSCRIPT
LOOP num=-1,12
 IF (num==0,1) THEN
  f=1
 ELSEIF (num<0) THEN
  PRINT num," is negative number"
  CYCLE
 ELSE
  f=VALUE(num)
  LOOP n=#num,2,-1
   f=f*(n-1)
  ENDLOOP
 ENDIF
formatnum=CENTER(num,+2," ")
PRINT "factorial of ",formatnum," = ",f
ENDLOOP


package main

func main() {
    s := "immutable"
    s[0] = 'a'
}


  B=: A=: 'this is a test'
  A=: '*' 2 3 5 7} A
   A
th** *s*a test
   B
this is a test


final int immutableInt = 4;
int mutableInt = 4;
mutableInt = 6; //this is fine
immutableInt = 6; //this is an error


const pi = 3.1415;
const msg = "Hello World";


import java.util.ArrayList;
import java.util.stream.IntStream;
import java.util.stream.LongStream;

public class EstheticNumbers {
    interface RecTriConsumer<A, B, C> {
        void accept(RecTriConsumer<A, B, C> f, A a, B b, C c);
    }

    private static boolean isEsthetic(long n, long b) {
        if (n == 0) {
            return false;
        }
        var i = n % b;
        var n2 = n / b;
        while (n2 > 0) {
            var j = n2 % b;
            if (Math.abs(i - j) != 1) {
                return false;
            }
            n2 /= b;
            i = j;
        }
        return true;
    }

    private static void listEsths(long n, long n2, long m, long m2, int perLine, boolean all) {
        var esths = new ArrayList<Long>();
        var dfs = new RecTriConsumer<Long, Long, Long>() {
            public void accept(Long n, Long m, Long i) {
                accept(this, n, m, i);
            }

            @Override
            public void accept(RecTriConsumer<Long, Long, Long> f, Long n, Long m, Long i) {
                if (n <= i && i <= m) {
                    esths.add(i);
                }
                if (i == 0 || i > m) {
                    return;
                }
                var d = i % 10;
                var i1 = i * 10 + d - 1;
                var i2 = i1 + 2;
                if (d == 0) {
                    f.accept(f, n, m, i2);
                } else if (d == 9) {
                    f.accept(f, n, m, i1);
                } else {
                    f.accept(f, n, m, i1);
                    f.accept(f, n, m, i2);
                }
            }
        };

        LongStream.range(0, 10).forEach(i -> dfs.accept(n2, m2, i));

        var le = esths.size();
        System.out.printf("Base 10: %d esthetic numbers between %d and %d:%n", le, n, m);
        if (all) {
            for (int i = 0; i < esths.size(); i++) {
                System.out.printf("%d ", esths.get(i));
                if ((i + 1) % perLine == 0) {
                    System.out.println();
                }
            }
        } else {
            for (int i = 0; i < perLine; i++) {
                System.out.printf("%d ", esths.get(i));
            }
            System.out.println();
            System.out.println("............");
            for (int i = le - perLine; i < le; i++) {
                System.out.printf("%d ", esths.get(i));
            }
        }
        System.out.println();
        System.out.println();
    }

    public static void main(String[] args) {
        IntStream.rangeClosed(2, 16).forEach(b -> {
            System.out.printf("Base %d: %dth to %dth esthetic numbers:%n", b, 4 * b, 6 * b);
            var n = 1L;
            var c = 0L;
            while (c < 6 * b) {
                if (isEsthetic(n, b)) {
                    c++;
                    if (c >= 4 * b) {
                        System.out.printf("%s ", Long.toString(n, b));
                    }
                }
                n++;
            }
            System.out.println();
        });
        System.out.println();

        // the following all use the obvious range limitations for the numbers in question
        listEsths(1000, 1010, 9999, 9898, 16, true);
        listEsths((long) 1e8, 101_010_101, 13 * (long) 1e7, 123_456_789, 9, true);
        listEsths((long) 1e11, 101_010_101_010L, 13 * (long) 1e10, 123_456_789_898L, 7, false);
        listEsths((long) 1e14, 101_010_101_010_101L, 13 * (long) 1e13, 123_456_789_898_989L, 5, false);
        listEsths((long) 1e17, 101_010_101_010_101_010L, 13 * (long) 1e16, 123_456_789_898_989_898L, 4, false);
    }
}


# Project : Euler's sum of powers conjecture

max=250
for w = 1 to max
     for x = 1 to w
          for y = 1 to x
               for z = 1 to y
                    sum = pow(w,5) + pow(x,5) + pow(y,5) + pow(z,5)
                    s1  = floor(pow(sum,0.2))
                    if sum = pow(s1,5)
                       see "" + w + "^5 + " + x + "^5 + " + y + "^5 + " + z + "^5 = " + s1 + "^5"
                    ok
               next
          next
     next
next


power5 = (1..250).each_with_object({}){|i,h| h[i**5]=i}
result = power5.keys.repeated_combination(4).select{|a| power5[a.inject(:+)]}
puts result.map{|a| a.map{|i| "#{power5[i]}**5"}.join(' + ') + " = #{power5[a.inject(:+)]}**5"}


max=250
FOR w = 1 TO max
  FOR x = 1 TO w
    FOR y = 1 TO x
      FOR z = 1 TO y
      sum = w^5 + x^5 + y^5 + z^5
      s1  = INT(sum^0.2)
      IF sum=s1^5 THEN
        PRINT w;"^5 + ";x;"^5 + ";y;"^5 + ";z;"^5 = ";s1;"^5"
        end
      end if
      NEXT z
    NEXT y
  NEXT x
NEXT w


(define even?
    0 -> true
    X -> (odd? (- X 1)))

(define odd?
    0 -> false
    X -> (even? (- X 1)))


var n = 42;
say n.is_odd;       # false
say n.is_even;      # true


If OpenConsole()
  Define i, c=CountProgramParameters()-1
  For i=0 To c
    Define j, LSum=0, RSum=0
    For j=0 To c
      If j<i
        LSum+Val(ProgramParameter(j))
      ElseIf j>i
        RSum+Val(ProgramParameter(j))
      EndIf
    Next j
    If LSum=RSum: PrintN(Str(i)): EndIf
  Next i
EndIf


def eqindex2Pass(data):
    "Two pass"
    suml, sumr, ddelayed = 0, sum(data), 0
    for i, d in enumerate(data):
        suml += ddelayed
        sumr -= d
        ddelayed = d
        if suml == sumr:
            yield i


#lang racket
(define (subsums xs)
  (for/fold ([sums '()] [sum 0]) ([x xs])
    (values (cons (+ x sum) sums)
            (+ x sum))))

(define (equivilibrium xs)
  (define-values (sums total) (subsums xs))
  (for/list ([sum (reverse sums)]
             [x xs]
             [i (in-naturals)]
             #:when (= (- sum x) (- total sum)))
    i))

(equivilibrium '(-7 1 5 2 -4 3 0))


INT FUNC EthopianMult(INT a,b)
  INT res

  PrintF("Ethopian multiplication %I by %I:%E",a,b)
  res=0
  WHILE a>=1
  DO
    IF a MOD 2=0 THEN
      PrintF("%I %I strike%E",a,b)
    ELSE
      PrintF("%I %I keep%E",a,b)
      res==+b
    FI
    a==/2
    b==*2
  OD
RETURN (res)

PROC Main()
  INT res

  res=EthopianMult(17,34)
  PrintF("Result is %I",res)
RETURN


function Divide(a:Number):Number {
	return ((a-(a%2))/2);
}
function Multiply(a:Number):Number {
	return (a *= 2);
}
function isEven(a:Number):Boolean {
	if (a%2 == 0) {
		return (true);
	} else {
		return (false);
	}
}
function Ethiopian(left:Number, right:Number) {
	var r:Number = 0;
	trace(left+"     "+right);
	while (left != 1) {
		var State:String = "Keep";
		if (isEven(Divide(left))) {
			State = "Strike";
		}
		trace(Divide(left)+"     "+Multiply(right)+"  "+State);
		left = Divide(left);
		right = Multiply(right);
		if (State == "Keep") {
			r += right;
		}
	}
	trace("="+"      "+r);
}
}


#import std
#import nat

iterative_fib = ~&/(0,1); ~&r->ll ^|\predecessor ^/~&r sum

recursive_fib = {0,1}^?<a/~&a sum^|W/~& predecessor^~/~& predecessor

analytical_fib =

%np+ -+
   mp..round; ..mp2str; sep`+; ^CNC/~&hh take^\~&htt %[email protected],
   (mp..div^|\~& mp..sub+ ~~ @rlX mp..pow_ui)^lrlPGrrPX/~& -+
      ^\~& ^(~&,mp..sub/1.E0)+ mp..div\2.E0+ mp..add/1.E0,
      mp..sqrt+ ..grow/5.E0+-+-


import "io" for Stdin

class Brainf__k {
    construct new(prog, memSize) {
        _prog = prog
        _memSize = memSize
        _mem = List.filled(memSize, 0)
        _ip = 0
        _dp = 0
    }

    memVal_ { (_dp >= 0 && _dp < _memSize) ? _mem[_dp] : 0 }

    execute() {
        while (_ip < _prog.count) {
            var cmd = _prog[_ip]
            _ip = _ip + 1
            if (cmd == ">") {
                _dp = _dp + 1
            } else if (cmd == "<") {
                _dp = _dp - 1
            } else if (cmd == "+") {
                _mem[_dp] = memVal_ + 1
            } else if (cmd == "-") {
                _mem[_dp] = memVal_ - 1
            } else if (cmd == ",") {
                _mem[_dp] = Stdin.readByte()
            } else if (cmd == ".") {
                System.write(String.fromByte(memVal_))
            } else if (cmd == "[") {
                handleLoopStart_()
            } else if (cmd == "]") {
                handleLoopEnd_()
            }
        }
    }

    handleLoopStart_() {
        if (memVal_ != 0) return
        var depth = 1
        while (_ip < _prog.count) {
            var cmd = _prog[_ip]
            _ip = _ip + 1
            if (cmd == "[") {
                depth = depth + 1
            } else if (cmd == "]") {
                depth = depth - 1
                if (depth == 0) return
            }
        }
        Fiber.abort("Could not find matching end bracket.")
    }

    handleLoopEnd_() {
        var depth = 0
        while (_ip >= 0) {
            _ip = _ip - 1
            var cmd = _prog[_ip]
            if (cmd == "]") {
                depth = depth + 1
            } else if (cmd == "[") {
                depth = depth - 1
                if (depth == 0) return
            }
        }
        Fiber.abort("Could not find matching start bracket.")
    }
}

var prog = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
Brainf__k.new(prog, 10).execute()


def factorial (int n)
	decl int result
	set result 1
	decl int i
	for (set i 1) (< i (+ n 1)) (inc i)
		set result (* result i)
	end
	return result
end


const x = 1
x = π # ERROR: invalid ridefinition of constant x


// version 1.1.0

//  constant top level property
const val N = 5

//  read-only top level property
val letters = listOf('A', 'B', 'C', 'D', 'E') // 'listOf' creates here a List<Char) which is immutable

class MyClass {  // MyClass is effectively immutable because it's only property is read-only
                 // and it is not 'open' so cannot be sub-classed
    // read-only class property
    val myInt = 3

    fun myFunc(p: Int) {  // parameter 'p' is read-only
        var pp = p        // local variable 'pp' is mutable
        while (pp < N) {  // compiler will change 'N' to 5
            print(letters[pp++])
        }
        println()
    }
}

fun main(args: Array<String>) {
    val mc = MyClass()   // 'mc' cannot be re-assigned a different object
    println(mc.myInt)
    mc.myFunc(0)
}


:- object(immutable).

    % forbid using (complementing) categories for adding to or
    % modifying (aka hot patching) the object
    :- set_logtalk_flag(complements, deny).
    % forbid dynamically adding new predicates at runtime
    :- set_logtalk_flag(dynamic_declarations, deny).

    :- public(foo/1).
    foo(1).       % static predicate by default

    :- private(bar/2)
    bar(2, 3).    % static predicate by default

:- end_object.


Tau = 2*Pi;Protect[Tau]
{"Tau"}

Tau = 2
->Set::wrsym: Symbol Tau is Protected.


function isEsthetic(inp, base = 10) {
  let arr = inp.toString(base).split('');
  if (arr.length == 1) return false;
  for (let i = 0; i < arr.length; i++)
    arr[i] = parseInt(arr[i], base);
  for (i = 0; i < arr.length-1; i++)
    if (Math.abs(arr[i]-arr[i+1]) !== 1) return false;
  return true;
}

function collectEsthetics(base, range) {
  let out = [], x;
  if (range) {
    for (x = range[0]; x < range[1]; x++)
      if (isEsthetic(x)) out.push(x);
    return out;
  } else {
    x = 1;
    while (out.length < base*6) {
      s = x.toString(base);
      if (isEsthetic(s, base)) out.push(s.toUpperCase());
      x++;
    }
    return out.slice(base*4);
  }
}

// main
let d = new Date();
for (let x = 2; x <= 36; x++) { // we put b17 .. b36 on top, because we can
  console.log(`${x}:`);
  console.log( collectEsthetics(x),
    (new Date() - d) / 1000 + ' s');
}
console.log( collectEsthetics(10, [1000, 9999]),
  (new Date() - d) / 1000 + ' s' );

console.log( collectEsthetics(10, [1e8, 1.3e8]),
  (new Date() - d) / 1000 + ' s' );


const MAX_N : u64 = 250;

fn eulers_sum_of_powers() -> (usize, usize, usize, usize, usize) {
    let pow5: Vec<u64> = (0..MAX_N).map(|i| i.pow(5)).collect();
    let pow5_to_n = |pow| pow5.binary_search(&pow);

    for x0 in 1..MAX_N as usize {
        for x1 in 1..x0 {
            for x2 in 1..x1 {
                for x3 in 1..x2 {
                    let pow_sum = pow5[x0] + pow5[x1] + pow5[x2] + pow5[x3];
                    if let Ok(n) = pow5_to_n(pow_sum) {
                        return (x0, x1, x2, x3, n)
                    }
                }
            }
        }
    }

    panic!();
}

fn main() {
	let (x0, x1, x2, x3, y) = eulers_sum_of_powers();
	println!("{}^5 + {}^5 + {}^5 + {}^5 == {}^5", x0, x1, x2, x3, y)
}


import scala.collection.Searching.{Found, search}

object EulerSopConjecture extends App {

  val (maxNumber, fifth) = (250, (1 to 250).map { i => math.pow(i, 5).toLong })

  def binSearch(fact: Int*) = fifth.search(fact.map(f => fifth(f)).sum)

  def sop = (0 until maxNumber)
    .flatMap(a => (a until maxNumber)
      .flatMap(b => (b until maxNumber)
        .flatMap(c => (c until maxNumber)
          .map { case x$1@d => (binSearch(a, b, c, d), x$1) }
          .withFilter { case (f, _) => f.isInstanceOf[Found] }
          .map { case (f, d) => (a + 1, b + 1, c + 1, d + 1, f.insertionPoint + 1) }))).take(1)
    .map { case (a, b, c, d, f) => s"$a⁵ + $b⁵ + $c⁵ + $d⁵ = $f⁵" }

  println(sop)

}


      DEFINE('even(n)')                         :(even_end)
even  even = (EQ(REMDR(n, 2), 0) 'even', 'odd') :(RETURN)
even_end

      OUTPUT = "-2 is " even(-2)
      OUTPUT = "-1 is " even(-1)
      OUTPUT = "0 is " even(0)
      OUTPUT = "1 is " even(1)
      OUTPUT = "2 is " even(2)
END


> n, 0..9
  ? #.even(n), #.output(n," even")
  ? #.odd(n), #.output(n," odd")
<


sub equilibrium_index(@list) {
    my ($left,$right) = 0, [+] @list;

    gather for @list.kv -> $i, $x {
        $right -= $x;
        take $i if $left == $right;
        $left += $x;
    }
}

my @list = -7, 1, 5, 2, -4, 3, 0;
.say for equilibrium_index(@list).grep(/\d/);


Red []
eqindex: func [a [block!]] [
  collect [
    repeat ind length? a [ if (sum skip a ind) = sum copy/part a ind - 1 [ keep ind ] ]
  ]
]
prin "(1 based) equ indices are:  "
probe eqindex [-7 1 5 2 -4 3 0]


let arr = [-7, 1, 5, 2, -4, 3, 0]
let sum = Js.Array2.reduce(arr, \"+", 0)
let len = Js.Array.length(arr)

let rec aux = (acc, i, left, right) => {
  if (i >= len) { acc } else {
    let x = arr[i]
    let right = right - x
    if (left == right) {
      let _ = Js.Array2.push(acc, i)
    }
    aux(acc, i+1, (left + x), right)
  }
}
let res = aux([], 0, 0, sum)
Js.log("Results:")
Js.Array2.forEach(res, Js.log)


with ada.text_io;use ada.text_io;

procedure ethiopian is
  function double  (n : Natural) return Natural is (2*n);
  function halve   (n : Natural) return Natural is (n/2);
  function is_even (n : Natural) return Boolean is (n mod 2 = 0);

  function mul (l, r : Natural) return Natural is
  (if l = 0 then 0 elsif l = 1 then r elsif is_even (l) then mul (halve (l),double (r))
   else r + double (mul (halve (l), r)));

begin
  put_line (mul (17,34)'img);
end ethiopian;


void
halve(integer &x)
{
    x >>= 1;
}

void
double(integer &x)
{
    x <<= 1;
}

integer
iseven(integer x)
{
    return (x & 1) == 0;
}

integer
ethiopian(integer plier, integer plicand, integer tutor)
{
    integer result;

    result = 0;

    if (tutor) {
        o_form("ethiopian multiplication of ~ by ~\n", plier, plicand);
    }

    while (plier >= 1) {
        if (iseven(plier)) {
            if (tutor) {
                o_form("/w4/ /w6/ struck\n", plier, plicand);
            }
        } else {
            if (tutor) {
                o_form("/w4/ /w6/ kept\n", plier, plicand);
            }

            result += plicand;
        }

        halve(plier);
        double(plicand);
    }

    return result;
}

integer
main(void)
{
    o_integer(ethiopian(17, 34, 1));
    o_byte('\n');

    return 0;
}


[fib
   [small?] []
     [pred dup pred]
     [+]
   binrec].


#>
newsyntax
@in:PE
@token:bf
@PE:"function(Stack){
	this.TestNext(Stack,\"Paren\",\"TK_POPEN\");
	this.Move(Stack,2);
	let Check = function(t,v){
		return AST.IsPreciseToken(Stack.Token,t,v);
	}
	let Write = function(v){
		AST.ChunkWrite(Stack,v);
	}
	this.OpenChunk(Stack);
	while(!this.IsPreciseToken(Stack.Token,\"Paren\",\"TK_PCLOSE\")){
		if(Check(\"None\",\"TK_DOT\")){
			Write(\"output\");
		}else if(Check(\"None\",\"TK_COMMA\")){
			Write(\"input\");
		}else if(Check(\"Operator\",\"TK_ADD\")){
			Write(\"inc\");
		}else if(Check(\"Operator\",\"TK_SUB\")){
			Write(\"deinc\");
		}else if(Check(\"Compare\",\"TK_GT\")){
			Write(\"meminc\");
		}else if(Check(\"Compare\",\"TK_LT\")){
			Write(\"memdeinc\");
		}else if(Check(\"Brace\",\"TK_IOPEN\")){
			this.OpenChunk(Stack);
		}else if(Check(\"Brace\",\"TK_ICLOSE\")){
			this.CloseChunk(Stack);
		}
		this.Next(Stack);
	}
	this.CloseChunk(Stack);
	if(!this.CheckNext(Stack,\"None\",\"TK_LINEEND\")&&!this.CheckNext(Stack,\"None\",\"TK_COMMA\")){
		this.Next(Stack);
		this.ChunkWrite(Stack,this.ParseExpression(Stack));
	}
}"
@Interpret:"function(AST,Token){
	let BF = Token[3];
	let Chunk = BF[0];
	let Input = BF[1];
	if(Input){
		Input=this.Parse(AST,Input);
	}
	let IPos=0;
	let Memory = [],MemPos=0;
	let UpdateMemory = function(){
		if(Memory[MemPos]===undefined){
			Memory[MemPos]=0;
		}
	}
	let Read = function(v){
		if(v==\"output\"){
			AST.LibGlobals.log(Memory[MemPos]);
		}else if(v==\"input\"){
			Memory[MemPos]=Input.charCodeAt(IPos)||0;
			IPos++;
		}else if(v==\"inc\"){
			UpdateMemory();
			Memory[MemPos]++;
		}else if(v==\"deinc\"){
			UpdateMemory();
			Memory[MemPos]--;
		}else if(v==\"meminc\"){
			MemPos++;
			UpdateMemory();
		}else if(v==\"memdeinc\"){
			MemPos--;
			UpdateMemory();
		}else if(v instanceof Array){
			UpdateMemory();
			while(Memory[MemPos]!=0){
				for(let vv of v){
					Read(vv);
				}
				UpdateMemory();
			}
		}
	}
	UpdateMemory();
	for(let v of Chunk){
		Read(v);
	}
	UpdateMemory();
	return Memory[MemPos];
}"
<#

set x = bf ( + + + > + + [ < + > - ] < );
log(x);


fcn bf(pgm,input=""){ pgm=pgm.text;  // handle both String and Data
   const CELLS=0d30_000;
   if(Void==pgm.span("[","]")){ println("Mismatched brackets"); return(); }
   fcn(code,z,jmpTable){ // build jump table (for [ & ])
      if(span:=code.span("[","]")){
	 a,b:=span; b+=a-1; jmpTable[a+z]=b+z; jmpTable[b+z]=a+z;
	 self.fcn(code[a+1,b-a-1],z+a+1,jmpTable);
	 self.fcn(code[b+1,*],z+b+1,jmpTable);
      }
   }(pgm,0,jmpTable:=Dictionary());

   tape:=CELLS.pump(Data(CELLS,Int),0);
   ip:=dp:=0; input=input.walker();
   try{
      while(1){
	 switch(pgm[ip]){
	    case(">"){ dp+=1 }
	    case("<"){ dp-=1 }
	    case("+"){ tape[dp]=tape[dp]+1 }
	    case("-"){ tape[dp]=tape[dp]-1 }
	    case("."){ tape[dp].toChar().print() }
	    case(","){ c:=input._next(); tape[dp]=(c and input.value or 0); }
	    case("["){ if(0==tape[dp]){ ip=jmpTable[ip] }}
	    case("]"){ if(tape[dp])   { ip=jmpTable[ip] }}
	 }
	 ip+=1;
      } // while
   }catch(IndexError){}  // read past end of tape == end of program
}


#import nat

good_factorial   = ~&?\1! product:-1^lrtPC/~& iota
better_factorial = ~&?\1! ^T(~&lSL,@rS product:-1)+ ~&Z-~^*lrtPC/~& iota


Public Function factorial(n As Integer) As Long
    factorial = WorksheetFunction.Fact(n)
End Function


def foo = 42;              // immutable by default
mutable bar = "O'Malleys"; // mutable because you asked it to be


var x = "mutablefoo" # Mutable variable
let y = "immutablefoo" # Immutable variable, at runtime
const z = "constantfoo" # Immutable constant, at compile time

x[0] = 'M'
y[0] = 'I' # Compile error: 'y[0]' cannot be assigned to
z[0] = 'C' # Compile error: 'z[0]' cannot be assigned to


type im_string

val create : int -> im_string
val make : int -> char -> im_string
val of_string : string -> im_string
val to_string : im_string -> string
val copy : im_string -> im_string
val sub : im_string -> int -> int -> im_string
val length : im_string -> int
val get : im_string -> int -> char
val iter : (char -> unit) -> im_string -> unit
val escaped : im_string -> im_string
val index : im_string -> char -> int
val contains : im_string -> char -> bool
val print : im_string -> unit


Object Class new: MyClass(a, b)

MyClass method: setA(value)  value := a ;
MyClass method: setB(value)  value := b ;

MyClass method: initialize(v, w)  self setA(v) self setB(w) ;

MyClass new(1, 2)                // OK : An immutable object
MyClass new(1, 2) setA(4)        // KO : An immutable object can't be updated after initialization
MyClass new(ListBuffer new, 12)  // KO : Not an immutable value.
ListBuffer new Constant new: T   // KO : A constant cannot be mutable.
Channel new send(ListBuffer new) // KO : A mutable object can't be sent into a channel.


use constant PI => 3.14159;
use constant MSG => "Hello World";


using Formatting
import Base.iterate, Base.IteratorSize, Base.IteratorEltype

"""
    struct Esthetic

Used for iteration of esthetic numbers
"""
struct Esthetic{T}
    lowerlimit::T where T <: Integer
    base::T
    upperlimit::T
    Esthetic{T}(n, bas, m=typemax(T)) where T = new{T}(nextesthetic(n, bas), bas, m)
end

Base.IteratorSize(n::Esthetic) = Base.IsInfinite()
Base.IteratorEltype(n::Esthetic) = Integer
function Base.iterate(es::Esthetic, state=typeof(es.lowerlimit)[])
    state = isempty(state) ? digits(es.lowerlimit, base=es.base) : increment!(state, es.base, 1)
    n = toInt(state, es.base)
    return n <= es.upperlimit ? (n, state) : nothing
end

isesthetic(n, b) = (d = digits(n, base=b); all(i -> abs(d[i] - d[i + 1]) == 1, 1:length(d)-1))
toInt(dig, bas) = foldr((i, j) -> i + bas * j, dig)
nextesthetic(n, b) = for i in n:typemax(typeof(n)) if isesthetic(i, b) return i end; end

""" Fill the digits below pos in vector with the least esthetic number fitting there """
function filldecreasing!(vec, pos)
    if pos > 1
        n = vec[pos]
        for i in pos-1:-1:1
            n = (n == 0) ? 1 : n - 1
            vec[i] = n
        end
    end
    return vec
end

""" Get the next esthetic number's digits from the previous number's digits """
function increment!(vec, bas, startpos = 1)
    len = length(vec)
    if len == 1
        if vec[1] < bas - 1
            vec[1] += 1
        else
            vec[1] = 0
            push!(vec, 1)
        end
    else
        pos = findfirst(i -> vec[i] < vec[i + 1], startpos:len-1)
        if pos == nothing
            if vec[end] >= bas - 1
                push!(vec, 1)
                filldecreasing!(vec, len + 1)
            else
                vec[end] += 1
                filldecreasing!(vec, len)
            end
        else
            for i in pos:len
                if i == len
                    if vec[i] < bas - 1
                        vec[i] += 1
                        filldecreasing!(vec, i)
                    else
                        push!(vec, 1)
                        filldecreasing!(vec, len + 1)
                    end
                elseif vec[i] < vec[i + 1] && vec[i] < bas - 2
                    vec[i] += 2
                    filldecreasing!(vec, i)
                    break
                end
            end
        end
    end
    return vec
end

for b in 2:16
    println("For base $b, the esthetic numbers indexed from $(4b) to $(6b) are:")
    printed = 0
    for (i, n) in enumerate(Iterators.take(Esthetic{Int}(1, b), 6b))
        if i >= 4b
            printed += 1
            print(string(n, base=b), printed % 21 == 20 ? "\n" : " ")
        end
    end
    println("\n")
end

for (bottom, top, cols, T) in [[1000, 9999, 16, Int], [100_000_000, 130_000_000, 8, Int],
        [101_010_000_000, 130_000_000_000, 6, Int], [101_010_101_010_000_000, 130_000_000_000_000_000, 4, Int],
        [101_010_101_010_101_000_000, 130_000_000_000_000_000_000, 4, Int128]]
    esth, count = Esthetic{T}(bottom, 10, top), 0
    println("\nBase 10 esthetic numbers between $(format(bottom, commas=true)) and $(format(top, commas=true)):")
    for n in esth
        count += 1
        if count == 64
            println(" ...")
        elseif count < 64
            print(format(n, commas=true), count % cols == 0 ? "\n" : " ")
        end
    end
    println("\nTotal esthetic numbers in interval: $count")
end


import kotlin.math.abs

fun isEsthetic(n: Long, b: Long): Boolean {
    if (n == 0L) {
        return false
    }
    var i = n % b
    var n2 = n / b
    while (n2 > 0) {
        val j = n2 % b
        if (abs(i - j) != 1L) {
            return false
        }
        n2 /= b
        i = j
    }
    return true
}

fun listEsths(n: Long, n2: Long, m: Long, m2: Long, perLine: Int, all: Boolean) {
    val esths = mutableListOf<Long>()
    fun dfs(n: Long, m: Long, i: Long) {
        if (i in n..m) {
            esths.add(i)
        }
        if (i == 0L || i > m) {
            return
        }
        val d = i % 10
        val i1 = i * 10 + d - 1
        val i2 = i1 + 2
        when (d) {
            0L -> {
                dfs(n, m, i2)
            }
            9L -> {
                dfs(n, m, i1)
            }
            else -> {
                dfs(n, m, i1)
                dfs(n, m, i2)
            }
        }
    }

    for (i in 0L until 10L) {
        dfs(n2, m2, i)
    }

    val le = esths.size
    println("Base 10: $le esthetic numbers between $n and $m:")
    if (all) {
        for (c_esth in esths.withIndex()) {
            print("${c_esth.value} ")
            if ((c_esth.index + 1) % perLine == 0) {
                println()
            }
        }
        println()
    } else {
        for (i in 0 until perLine) {
            print("${esths[i]} ")
        }
        println()
        println("............")
        for (i in le - perLine until le) {
            print("${esths[i]} ")
        }
        println()
    }
    println()
}

fun main() {
    for (b in 2..16) {
        println("Base $b: ${4 * b}th to ${6 * b}th esthetic numbers:")
        var n = 1L
        var c = 0L
        while (c < 6 * b) {
            if (isEsthetic(n, b.toLong())) {
                c++
                if (c >= 4 * b) {
                    print("${n.toString(b)} ")
                }
            }
            n++
        }
        println()
    }
    println()

    // the following all use the obvious range limitations for the numbers in question
    listEsths(1000, 1010, 9999, 9898, 16, true);
    listEsths(1e8.toLong(), 101_010_101, 13 * 1e7.toLong(), 123_456_789, 9, true);
    listEsths(1e11.toLong(), 101_010_101_010, 13 * 1e10.toLong(), 123_456_789_898, 7, false);
    listEsths(1e14.toLong(), 101_010_101_010_101, 13 * 1e13.toLong(), 123_456_789_898_989, 5, false);
    listEsths(1e17.toLong(), 101_010_101_010_101_010, 13 * 1e16.toLong(), 123_456_789_898_989_898, 4, false);
}


$ include "seed7_05.s7i";

const func integer: binarySearch (in array integer: arr, in integer: aKey) is func
  result
    var integer: index is 0;
  local
    var integer: low is 1;
    var integer: high is 0;
    var integer: middle is 0;
  begin
    high := length(arr);
    while index = 0 and low <= high do
      middle := (low + high) div 2;
      if aKey < arr[middle] then
        high := pred(middle);
      elsif aKey > arr[middle] then
        low := succ(middle);
      else
        index := middle;
      end if;
    end while;
  end func;

const proc: main is func
  local
    var array integer: p5 is 249 times 0;
    var integer: i is 0;
    var integer: x0 is 0;
    var integer: x1 is 0;
    var integer: x2 is 0;
    var integer: x3 is 0;
    var integer: sum is 0;
    var integer: y is 0;
    var boolean: found is FALSE;
  begin
    for i range 1 to 249 do
      p5[i] := i ** 5;
    end for;
    for x0 range 1 to 249 until found do
      for x1 range 1 to pred(x0) until found do
        for x2 range 1 to pred(x1) until found do
          for x3 range 1 to pred(x2) until found do
            sum := p5[x0] + p5[x1] + p5[x2] + p5[x3];
            y := binarySearch(p5, sum);
            if y > 0 then
              writeln(x0 <& "**5 + " <& x1 <& "**5 + " <& x2 <& "**5 + " <& x3 <& "**5 = " <& y <& "**5");
              found := TRUE;
            end if;
          end for;
        end for;
      end for;
    end for;
    if not found then
      writeln("No solution was found");
    end if;
  end func;


findEulerSumOfPowers
to findEulerSumOfPowers
    set MAX_NUMBER to 250
    set possibleValues to 1..MAX_NUMBER
    set possible5thPowers to each item of possibleValues to the power of 5
    repeat for x0 in 1..250
        repeat for x1 in 1..x0
            repeat for x2 in 1..x1
                repeat for x3 in 1..x2
                    set possibleSum to item x0 of possible5thPowers \
                            plus item x1 of possible5thPowers \
                            plus item x2 of possible5thPowers \
                            plus item x3 of possible5thPowers
                    if possibleSum is in possible5thPowers
                        put x0 & "^5 + " & x1 & "^5 + " & x2 & "^5 + " & x3 & "^5 = " & the item number of possibleSum within possible5thPowers & "^5"
                        return
                    end if
                end repeat
            end repeat
        end repeat
    end repeat
end findEulerSumOfPowers


-- Setup a table with some integers
CREATE TABLE ints(INT INTEGER);
INSERT INTO ints VALUES (-1);
INSERT INTO ints VALUES (0);
INSERT INTO ints VALUES (1);
INSERT INTO ints VALUES (2);

-- Are they even or odd?
SELECT
  INT,
  CASE MOD(INT, 2) WHEN 0 THEN 'Even' ELSE 'Odd' END
FROM
  ints;


/*REXX program calculates and displays the equilibrium index for a numeric array (list).*/
parse arg x                                      /*obtain the optional arguments from CL*/
if x=''  then x= copies(" 7 -7", 50)   7         /*Not specified?  Then use the default.*/
say '         array list: '     space(x)         /*echo the array list to the terminal. */
#= words(x)                                      /*the number of elements in the X list.*/
              do j=0  for #;   @.j= word(x, j+1) /*zero─start is for zero─based array.  */
              end   /*j*/                        /* [↑]  assign   @.0   @.1   @.3  ···  */
say                                              /*  ··· and also display a blank line. */
answer= equilibriumIDX();       w= words(answer) /*calculate the  equilibrium index.    */
say 'equilibrium'  word("(none) index: indices:",   1 + (w>0) + (w>1))        answer
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
equilibriumIDX: $=;     do i=0  for #;           sum= 0
                                do k=0  for #;   sum= sum  +  @.k * sign(k-i);   end /*k*/
                        if sum==0  then $= $ i
                        end   /*i*/              /* [↑] Zero? Found an equilibrium index*/
                return $                         /*return equilibrium list (may be null)*/


list  = [-7, 1, 5, 2, -4, 3, 0]
see "equilibrium indices are : " + equilibrium(list) + nl

func equilibrium l
     r = 0 s = 0 e = ""
     for n = 1 to len(l)
         s += l[n]
     next
     for i = 1 to len(l)
         if r = s - r - l[i]  e += string(i-1) + "," ok
         r += l[i]
     next
     e = left(e,len(e)-1)
     return e


PROC halve = (REF INT x)VOID: x := ABS(BIN x SHR 1);
PROC doublit = (REF INT x)VOID: x := ABS(BIN x SHL 1);
PROC iseven = (#CONST# INT x)BOOL: NOT ODD x;

PROC ethiopian = (INT in plier,
              INT in plicand, #CONST# BOOL tutor)INT:
(
  INT plier := in plier, plicand := in plicand;
  INT result:=0;

  IF tutor THEN
    printf(($"ethiopian multiplication of "g(0)," by "g(0)l$, plier, plicand)) FI;

  WHILE plier >= 1 DO
    IF iseven(plier) THEN
      IF tutor THEN printf(($" "4d,"  "6d" struck"l$, plier, plicand)) FI
    ELSE
      IF tutor THEN printf(($" "4d,"  "6d" kept"l$, plier, plicand)) FI;
      result +:= plicand
    FI;
    halve(plier); doublit(plicand)
  OD;
  result
);

main:
(
  printf(($g(0)l$, ethiopian(17, 34, TRUE)))
)


int fibRec(int n){
	if (n < 2)
		return n;
	else
		return fibRec(n - 1) + fibRec(n - 2);
}