; This module translates a string containing a
; Brainf*** program into a list of NewLISP expressions.
; Attempts to optimize consecutive +, -, > and < operations
; as well as bracket loops.

; Create a namespace and put the following definitions in it

(context 'BF)

; If BF:quiet is true, BF:run will return the output of the
; Brainf*** program

(define quiet)

; If BF:show-timing is true, the amount of milliseconds spent
; in 'compiling' (actually translating) and running the
; resulting program will be shown

(define show-timing true)

; The Brainf*** program as a string of characters

(define src "")

; Checks for correct pairs of brackets

(define (well-formed?)
  (let (p 0)
    (dostring (i src (> 0 p))
      (case i
	("[" (++ p))
	("]" (-- p))))
    (zero? p)))

; Translate the Brainf*** command into S-expressions

(define (_compile)
  (let ((prog '())
	; Translate +
	(incr '(++ (tape i) n))
	; Translate -
	(decr '(-- (tape i) n))
	; Translate .
        (emit (if quiet
		'(push (char (tape i)) result -1)
                '(print (char (tape i)))))
	; Translate ,
	(store '(setf (tape i) (read-key)))
	; Check for loop condition
	(over? '(zero? (tape i)))
	; Current character of the program
	(m)
	; Find how many times the same character occurs
	(rep (fn ((n 1))
		 (while (= m (src 0))
		 (++ n)
		 (pop src))
	     n)))
    ; Traverse the program and translate recursively
    (until (or (empty? src) (= "]" (setq m (pop src))))
	   (case m
	     (">" (push (list '++ 'i (rep)) prog -1))
	     ("<" (push (list '-- 'i (rep)) prog -1))
	     ("+" (push (expand incr '((n (rep))) true) prog -1))
	     ("-" (push (expand decr '((n (rep))) true) prog -1))
	     ("." (push emit prog -1))
	     ("," (push store prog -1))
	     ("[" (push (append (list 'until over?)
				(_compile))
			prog -1))))
    prog))

(define (compile str , tim code)
  (setq src (join
	(filter (fn (x)
		    (member x '("<" ">" "-" "+"
				"." "," {[} {]})))
		(explode str))))
  ; Throw an error if the program is ill-formed
  (unless (well-formed?)
    (throw-error "Unbalanced brackets in Brainf*** source string"))
  (setq tim (time (setq code (cons 'begin (_compile)))))
  (and show-timing (println "Compilation time: " tim))
  code)

; Translate and run
; Tape size is optional and defaults to 30000 cells

(define (run str (size 30000))
  (let ((tape (array size '(0)))
	 (i 0)
	 (result '())
	 (tim 0)
	 (prog (compile str)))
    (setq tim (time (eval prog)))
    (and show-timing (println "Execution time: " tim))
    (and quiet (join result))))

; test - run it with (BF:test)

(define (test)
  (run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."))

; to interpret a string of Brainf*** code, use (BF:run <string>)
; to interpret a Brainf*** code file, use (BF:run (read-file <path-to-file>))


USING: assocs io io.encodings.utf8 io.files kernel math
math.functions math.statistics prettyprint sequences ;
IN: rosetta-code.entropy-narcissist

: entropy ( seq -- entropy )
    [ length ] [ histogram >alist [ second ] map ] bi
    [ swap / ] with map
    [ dup log 2 log / * ] map-sum neg ;

"entropy-narcissist.factor" utf8 [
    contents entropy .
] with-file-reader


' version 01-06-2016
' compile with: fbc -s console
' modified code from ENTROPY entry

Dim As Integer i, count, totalchar(255)
Dim As UByte buffer
Dim As Double prop, entropy
' command (0) returns the name of this program (including the path)
Dim As String slash, filename = Command(0)
Dim As Integer ff = FreeFile   ' find first free filenumber
Open filename For Binary As #ff

If Err > 0 Then ' should not happen
    Print "Error opening the file"
    Beep : Sleep 5000, 1
    End
End If

' will read 1 UByte from the file until it reaches the end of the file
For i = 1 To Lof(ff)
    Get #ff, ,buffer
    totalchar(buffer) += 1
    count = count + 1
Next

For i = 0  To 255
    If totalchar(i) = 0 Then Continue For
    prop = totalchar(i) / count
    entropy = entropy - (prop * Log (prop) / Log(2))
Next

' next lines are only compiled when compiling for Windows OS (32/64)
#Ifdef __FB_WIN32__
    slash = chr(92)
    print "Windows version"
#endif
#Ifdef __FB_LINUX__
   slash = chr(47)
   print "LINUX version"
#EndIf

    i = InStrRev(filename, slash)
    If i <> 0 Then filename = Right(filename, Len(filename)-i)

Print "My name is "; filename
Print : Print "The Entropy of myself is"; entropy
Print

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import (
    "fmt"
    "io/ioutil"
    "log"
    "math"
    "os"
    "runtime"
)

func main() {
    _, src, _, _ := runtime.Caller(0)
    fmt.Println("Source file entropy:", entropy(src))
    fmt.Println("Binary file entropy:", entropy(os.Args[0]))
}

func entropy(file string) float64 {
    d, err := ioutil.ReadFile(file)
    if err != nil {
        log.Fatal(err)
    }
    var f [256]float64
    for _, b := range d {
        f[b]++
    }
    hm := 0.
    for _, c := range f {
        if c > 0 {
            hm += c * math.Log2(c)
        }
    }
    l := float64(len(d))
    return math.Log2(l) - hm/l
}


rebol [
    Title: "Factorial"
    URL: http://rosettacode.org/wiki/Factorial_function
]

; Standard recursive implementation.

factorial: func [n][
	either n > 1 [n * factorial n - 1] [1]
]

; Iteration.

ifactorial: func [n][
	f: 1
	for i 2 n 1 [f: f * i]
	f
]

; Automatic memoization.
; I'm just going to say up front that this is a stunt. However, you've
; got to admit it's pretty nifty. Note that the 'memo' function
; works with an unlimited number of arguments (although the expected
; gains decrease as the argument count increases).

memo: func [
	"Defines memoizing function -- keeps arguments/results for later use."
	args [block!] "Function arguments. Just specify variable names."
	body [block!] "The body block of the function."
	/local m-args m-r
][
	do compose/deep [
		func [
			(args)
			/dump "Dump memory."
		][
			m-args: []
			if dump [return m-args]

			if m-r: select/only m-args reduce [(args)] [return m-r]

			m-r: do [(body)]
			append m-args reduce [reduce [(args)] m-r]
			m-r
		]
	]
]

mfactorial: memo [n][
	either n > 1 [n * mfactorial n - 1] [1]
]

; Test them on numbers zero to ten.

for i 0 10 1 [print [i ":" factorial i  ifactorial i  mfactorial i]]


program show_home
implicit none
character(len=32) :: home_val  ! The string value of the variable HOME
integer           :: home_len  ! The actual length of the value
integer           :: stat      ! The status of the value:
                               !  0 = ok
                               !  1 = variable does not exist
                               ! -1 = variable is not long enought to hold the result
call get_environment_variable('HOME', home_val, home_len, stat)
if (stat == 0) then
    write(*,'(a)') 'HOME = '//trim(home_val)
else
    write(*,'(a)') 'No HOME to go to!'
end if
end program show_home


' FB 1.05.0 Win64

Var v = Environ("SystemRoot")
Print v
Sleep


println( System.getenv('PATH') )
println( $home )
println( $user )


package main

import (
    "fmt"
    "os"
)

func main() {
    fmt.Println(os.Getenv("SHELL"))
}


T.enum TokenCategory
   NAME
   KEYWORD
   CONSTANT
   TEST_CATEGORY = 10


def euler(y, a, b, h)
  a.step(b,h) do |t|
    puts "%7.3f %7.3f" % [t,y]
    y += h * yield(t,y)
  end
end

[10, 5, 2].each do |step|
  puts "Step = #{step}"
  euler(100,0,100,step) {|time, temp| -0.07 * (temp - 20) }
  puts
end


object App{

  def main(args : Array[String]) = {

    def cooling( step : Int ) = {
      eulerStep( (step , y) => {-0.07 * (y - 20)} ,
        100.0,0,100,step)
    }
    cooling(10)
    cooling(5)
    cooling(2)
  }
  def eulerStep( func : (Int,Double) => Double,y0 : Double,
    begin : Int, end : Int , step : Int) = {

    println("Step size: %s".format(step))

    var current : Int = begin
    var y : Double = y0
    while( current <= end){
      println( "%d %.5f".format(current,y))
      current += step
      y += step * func(current,y)
    }

    println("DONE")
  }

}


n = 250
len p5[] n
len h5[] 65537
for i range n
  p5[i] = i * i * i * i * i
  h5[p5[i] mod 65537] = 1
.
func search a s . y .
  y = -1
  b = n
  while a + 1 < b
    i = (a + b) div 2
    if p5[i] > s
      b = i
    elif p5[i] < s
      a = i
    else
      a = b
      y = i
    .
  .
.
for x0 range n
  for x1 range x0
    sum1 = p5[x0] + p5[x1]
    for x2 range x1
      sum2 = p5[x2] + sum1
      for x3 range x2
        sum = p5[x3] + sum2
        if h5[sum mod 65537] = 1
          call search x0 sum y
          if y >= 0
            print x0 & " " & x1 & " " & x2 & " " & x3 & " " & y
            break 4
          .
        .
      .
    .
  .
.


(define dim 250)

;; speed up n^5
(define (p5 n) (* n n n n n))
(remember 'p5) ;; memoize

;; build vector of all  y^5 - x^5 diffs - length 30877
(define all-y^5-x^5
	(for*/vector
		[(x (in-range 1 dim))  (y (in-range (1+ x) dim))]
		(- (p5 y) (p5 x))))

;; sort to use vector-search
(begin (vector-sort! <  all-y^5-x^5) 'sorted)

 ;; find couple (x y) from y^5 - x^5
(define (x-y y^5-x^5)
	(for*/fold (x-y null)
	[(x (in-range 1 dim)) (y (in-range (1+ x ) dim))]
		(when
			(= (- (p5 y) (p5 x)) y^5-x^5)
			(set! x-y (list x y))
			(break #t)))) ; stop on first

;; search
(for*/fold  (sol null)
	[(x0 (in-range 1 dim)) (x1 (in-range (1+ x0) dim)) (x2 (in-range (1+ x1) dim))]
	(set! sol (+ (p5 x0) (p5 x1) (p5 x2)))
 	(when
 		(vector-search sol all-y^5-x^5)  ;; x0^5 + x1^5 + x2^5 = y^5 - x3^5 ???
 		(set! sol (append (list x0 x1 x2) (x-y  sol))) ;; found
 		(break #t))) ;; stop on first

  →   (27 84 110 133 144) ;; time 2.8 sec


Define population = 100, mutationRate = 6
Define.s target$ = "METHINKS IT IS LIKE A WEASEL"
Define.s charSet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

Procedure.i fitness(Array aspirant.c(1), Array target.c(1))
  Protected i, len, fit
  len = ArraySize(aspirant())
  For i = 0 To len
    If aspirant(i) = target(i): fit +1: EndIf
  Next
  ProcedureReturn fit
EndProcedure

Procedure mutatae(Array parent.c(1), Array child.c(1), Array charSetA.c(1), rate.i)
  Protected i, L, maxC
  L = ArraySize(child())
  maxC = ArraySize(charSetA())
  For i = 0 To L
    If Random(100) < rate
      child(i) = charSetA(Random(maxC))
    Else
      child(i) = parent(i)
    EndIf
  Next
EndProcedure

Procedure.s cArray2string(Array A.c(1))
  Protected S.s, len
  len = ArraySize(A())+1 : S = Space(len)
  CopyMemory(@A(0), @S, len * SizeOf(Character))
  ProcedureReturn S
EndProcedure

Define mutationRate, maxChar, target_len, i, maxfit, gen, fit, bestfit
Dim targetA.c(Len(target$) - 1)
CopyMemory(@target$, @targetA(0), StringByteLength(target$))

Dim charSetA.c(Len(charSet$) - 1)
CopyMemory(@charSet$, @charSetA(0), StringByteLength(charSet$))

maxChar   = Len(charSet$) - 1
maxfit = Len(target$)
target_len   = Len(target$) - 1
Dim    parent.c(target_len)
Dim     child.c(target_len)
Dim Bestchild.c(target_len)

For i = 0 To target_len
  parent(i) = charSetA(Random(maxChar))
Next

fit = fitness (parent(), targetA())
OpenConsole()

PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(fit) + "/" + Str(maxfit))

While bestfit <> maxfit
  gen + 1
  For i = 1 To population
    mutatae(parent(),child(),charSetA(), mutationRate)
    fit = fitness (child(), targetA())
    If fit > bestfit
      bestfit = fit: CopyArray(child(), Bestchild())
    EndIf
  Next
  CopyArray(Bestchild(), parent())
  PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(bestfit) + "/" + Str(maxfit))
Wend

PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""


for i in range(-4, 4)
    if i % 2 == 0 then print i + " is even" else print i + " is odd"
end for


.data
	even_str: .asciiz "Even"
	odd_str: .asciiz "Odd"

.text
	#set syscall to get integer from user
	li $v0,5
	syscall

	#perform bitwise AND and store in $a0
	and $a0,$v0,1

	#set syscall to print dytomh
	li $v0,4

	#jump to odd if the result of the AND operation
	beq $a0,1,odd
even:
	#load even_str message, and print
	la $a0,even_str
	syscall

	#exit program
	li $v0,10
	syscall

odd:
	#load odd_str message, and print
	la $a0,odd_str
	syscall

	#exit program
	li $v0,10
	syscall


with Ada.Containers.Vectors;

generic
   type Index_Type is range <>;
   type Element_Type is private;
   Zero : Element_Type;
   with function "+" (Left, Right : Element_Type) return Element_Type is <>;
   with function "-" (Left, Right : Element_Type) return Element_Type is <>;
   with function "=" (Left, Right : Element_Type) return Boolean is <>;
   type Array_Type is private;
   with function Element (From : Array_Type; Key : Index_Type) return Element_Type is <>;
package Equilibrium is
   package Index_Vectors is new Ada.Containers.Vectors
      (Index_Type => Positive, Element_Type => Index_Type);

   function Get_Indices (From : Array_Type) return Index_Vectors.Vector;

end Equilibrium;


list
eqindex(list l)
{
    integer e, i, s, sum;
    list x;

    s = sum = 0;
    l.ucall(add_i, 1, sum);
    for (i, e in l) {
        if (s * 2 + e == sum) {
            x.append(i);
        }
        s += e;
    }

    x;
}

integer
main(void)
{
    list(-7, 1, 5, 2, -4, 3, 0).eqindex.ucall(o_, 0, "\n");

    0;
}


MODE YIELDINT = PROC(INT)VOID;

PROC gen equilibrium index = ([]INT arr, YIELDINT yield)VOID:
(
    INT sum := 0;
    FOR i FROM LWB arr TO UPB arr DO
        sum +:= arr[i]
    OD;

    INT left:=0, right:=sum;
    FOR i FROM LWB arr TO UPB arr DO
        right -:= arr[i];
        IF left = right THEN yield(i) FI;
        left +:= arr[i]
    OD
);

test:(
  []INT arr = []INT(-7, 1, 5, 2, -4, 3, 0)[@0];
# FOR INT index IN # gen equilibrium index(arr, # ) DO ( #
##   (INT index)VOID:
     print(index)
# OD # );
  print(new line)
)


con
  _clkmode = xtal1 + pll16x
  _clkfreq = 80_000_000

obj
  ser : "FullDuplexSerial.spin"

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

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

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

pub fib(i) : b | a
  b := a := 1
  repeat i
    a := b + (b := a)


import os

var
  code = if paramCount() > 0: readFile paramStr 1
         else: readAll stdin
  tape = newSeq[char]()
  d    = 0
  i    = 0

proc run(skip = false): bool =
  while d >= 0 and i < code.len:
    if d >= tape.len: tape.add '\0'

    if code[i] == '[':
      inc i
      let p = i
      while run(tape[d] == '\0'): i = p
    elif code[i] == ']':
      return tape[d] != '\0'
    elif not skip:
      case code[i]
      of '+': inc tape[d]
      of '-': dec tape[d]
      of '>': inc d
      of '<': dec d
      of '.': stdout.write tape[d]
      of ',': tape[d] = stdin.readChar
      else: discard

    inc i

discard run()


class Brainfu_k {
  @program : String; @mem : Int[];
  @ip : Int;  @dp : Int;

  New(program : String, size : Int) {
    @program := program;
    @mem := Int → New[size];
  }

  function : Main(args : String[]) ~ Nil {
    if(args → Size() = 2) {
      Brainfu_k → New(args[0], args[1] → ToInt()) → Execute();
    };
  }

  method : Execute() ~ Nil {
    while(@ip < @program → Size()) {
      instr := @program → Get(@ip);
      select(instr) {
        label '>': { @dp += 1; }
        label '<': { @dp -= 1; }
        label '+': { @mem[@dp] := @mem[@dp] + 1; }
        label '-': { @mem[@dp] := @mem[@dp] - 1; }
        label '.': { value := @mem[@dp] → As(Char); value → Print(); }
        label ',': { @mem[@dp] := Read(); }
        label '[': { JumpForward(); }
        label ']': { JumpBack(); }
      };
      @ip += 1;
    };
  }

  method : JumpForward() ~ Nil {
    depth := 1;
    if(@mem[@dp] = 0) {
      while(@ip < @program → Size()) {
        instr := @program → Get(@ip);
        if(instr = ']') {
          depth -= 1;  if(depth = 0) { return;  };
        }
        else if(instr = '[') { depth += 1; };
        @ip += 1;
      };
      "*** Unbalanced jump ***" → ErrorLine();
      Runtime → Exit(1);
    };
  }

  method : JumpBack() ~ Nil {
    depth := 1;
    if(@mem[@dp] <> 0) {
      while(@ip > 0) {
        @ip -= 1;
        instr := @program → Get(@ip);
        if(instr = '[') {
          depth -= 1;  if(depth = 0) { return; };
        }
        else if(instr = ']') { depth += 1; };
      };
      "*** Unbalanced jump ***" → ErrorLine();
      Runtime → Exit(1);
    };
  }

  method : Read() ~ Int {
    in := IO.Console → ReadString();
    if(in → Size() > 0) { return in → ToInt(); };
    return 0;
  }
}


import qualified Data.ByteString as BS
import Data.List
import System.Environment

(>>>) = flip (.)

main = getArgs >>= head >>> BS.readFile >>= BS.unpack >>> entropy >>> print

entropy = sort >>> group >>> map genericLength >>> normalize >>> map lg >>> sum
  where lg c = -c * logBase 2 c
        normalize c = let sc = sum c in map (/ sc) c


import java.io.BufferedReader;
import java.io.File;
import java.io.FileReader;
import java.io.IOException;
import java.util.HashMap;
import java.util.Map;

public class EntropyNarcissist {

    private static final String FILE_NAME = "src/EntropyNarcissist.java";

    public static void main(String[] args) {
        System.out.printf("Entropy of file \"%s\" = %.12f.%n", FILE_NAME, getEntropy(FILE_NAME));
    }

    private static double getEntropy(String fileName) {
        Map<Character,Integer> characterCount = new HashMap<>();
        int length = 0;

        try (BufferedReader reader = new BufferedReader(new FileReader(new File(fileName)));) {
            int c = 0;
            while ( (c = reader.read()) != -1 ) {
                characterCount.merge((char) c, 1, (v1, v2) -> v1 + v2);
                length++;
            }
        }
        catch ( IOException e ) {
            throw new RuntimeException(e);
        }

        double entropy = 0;
        for ( char key : characterCount.keySet() ) {
            double fraction = (double) characterCount.get(key) / length;
            entropy -= fraction * Math.log(fraction);
        }

        return entropy / Math.log(2);
    }

}


fac: function [n][r: 1 repeat i n [r: r * i] r]
fac: function [n][repeat i also n n: 1 [n: n * i] n]


function factorial (n)
set result = 1
if n > 1
set k = 2
while k <= n
set result = result * k
set k = k + 1
end while
end if
end function


System.getenv().each { property, value -> println "$property = $value"}


import System.Environment
main = do getEnv "HOME" >>= print  -- get env var
          getEnvironment >>= print -- get the entire environment as a list of (key, value) pairs


println env "HOME"
println env "PATH"
println env "USER"


CHARACTER string*255

string = "PATH="
SYSTEM(GEteNV = string)


software {
	print(load("$HOME"))
	print(load("$USER"))
	print(load("$PATH"))
}


procedure main(arglist)

if *envars = 0 then envars := ["HOME", "TRACE", "BLKSIZE","STRSIZE","COEXPSIZE","MSTKSIZE", "IPATH","LPATH","NOERRBUF"]

every v := !sort(envars) do
   write(v," = ",image(getenv(v))|"* not set *")
end


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


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


(defun symbol-to-constant (sym)
   (intern (concatenate 'string "*" (symbol-name sym) "*")
           "ACL2"))

(defmacro enum-with-vals (symbol value &rest args)
   (if (endp args)
       `(defconst ,(symbol-to-constant symbol) ,value)
       `(progn (defconst ,(symbol-to-constant symbol) ,value)
               (enum-with-vals ,@args))))

(defun interleave-with-nats-r (xs i)
   (if (endp xs)
       nil
       (cons (first xs)
             (cons i (interleave-with-nats-r (rest xs)
                                             (1+ i))))))

(defun interleave-with-nats (xs)
   (interleave-with-nats-r xs 0))

(defmacro enum (&rest symbols)
   `(enum-with-vals ,@(interleave-with-nats symbols)))


import <Utilities/Conversion.sl>;
import <Utilities/Sequence.sl>;

T0 := 100.0;
TR := 20.0;
k := 0.07;

main(args(2)) :=
	let
		results[i] := euler(newtonCooling, T0, 100, stringToInt(args[i]), 0, "delta_t = " ++ args[i]);
	in
		delimit(results, '\n');

newtonCooling(t) := -k * (t - TR);

euler: (float -> float) * float * int * int * int * char(1) -> char(1);
euler(f, y, n, h, x, output(1)) :=
	let
		newOutput := output ++ "\n\t" ++ intToString(x) ++ "\t" ++ floatToString(y, 3);
		newY := y + h * f(y);
		newX := x + h;
	in
			output when x > n
		else
			euler(f, newY, n, h, newX, newOutput);


defmodule Euler do
  def sum_of_power(max \\ 250) do
    {p5, sum2} = setup(max)
    sk = Enum.sort(Map.keys(sum2))
    Enum.reduce(Enum.sort(Map.keys(p5)), Map.new, fn p,map ->
      sum(sk, p5, sum2, p, map)
    end)
  end

  defp setup(max) do
    Enum.reduce(1..max, {%{}, %{}}, fn i,{p5,sum2} ->
      i5 = i*i*i*i*i
      add = for j <- i..max, into: sum2, do: {i5 + j*j*j*j*j, [i,j]}
      {Map.put(p5, i5, i), add}
    end)
  end

  defp sum([], _, _, _, map), do: map
  defp sum([s|_], _, _, p, map) when p<=s, do: map
  defp sum([s|t], p5, sum2, p, map) do
    if sum2[p - s],
      do:   sum(t, p5, sum2, p, Map.put(map, Enum.sort(sum2[s] ++ sum2[p-s]), p5[p])),
      else: sum(t, p5, sum2, p, map)
  end
end

Enum.each(Euler.sum_of_power, fn {k,v} ->
  IO.puts Enum.map_join(k, " + ", fn i -> "#{i}**5" end) <> " = #{v}**5"
end)


PROGRAM EULERO

CONST MAX=250

!$DOUBLE

FUNCTION POW5(X)
    POW5=X*X*X*X*X
END FUNCTION

!$INCLUDE="PC.LIB"

BEGIN
   CLS
   FOR X0=1 TO MAX DO
     FOR X1=1 TO X0 DO
        FOR X2=1 TO X1 DO
           FOR X3=1 TO X2 DO
              LOCATE(3,1) PRINT(X0;X1;X2;X3)
              SUM=POW5(X0)+POW5(X1)+POW5(X2)+POW5(X3)
              S1=INT(SUM^0.2#+0.5#)
              IF SUM=POW5(S1) THEN PRINT(X0,X1,X2,X3,S1) END IF
           END FOR
        END FOR
     END FOR
   END FOR
END PROGRAM


//Find 4 integers whose 5th powers sum to the fifth power of an integer (Quickly!) - Nigel Galloway: April 23rd., 2015
let G =
  let GN = Array.init<float> 250 (fun n -> (float n)**5.0)
  let rec gng (n, i, g, e) =
    match (n, i, g, e) with
    | (250,_,_,_) -> "No Solution Found"
    | (_,250,_,_) -> gng (n+1, n+1, n+1, n+1)
    | (_,_,250,_) -> gng (n, i+1, i+1, i+1)
    | (_,_,_,250) -> gng (n, i, g+1, g+1)
    | _ -> let l = GN.[n] + GN.[i] + GN.[g] + GN.[e]
           match l with
           | _ when l > GN.[249]           -> gng(n,i,g+1,g+1)
           | _ when l = round(l**0.2)**5.0 -> sprintf "%d**5 + %d**5 + %d**5 + %d**5 = %d**5" n i g e (int (l**0.2))
           | _                             -> gng(n,i,g,e+1)
  gng (1, 1, 1, 1)


from string import letters
from random import choice, random

target  = list("METHINKS IT IS LIKE A WEASEL")
charset = letters + ' '
parent  = [choice(charset) for _ in range(len(target))]
minmutaterate  = .09
C = range(100)

perfectfitness = float(len(target))

def fitness(trial):
    'Sum of matching chars by position'
    return sum(t==h for t,h in zip(trial, target))

def mutaterate():
    'Less mutation the closer the fit of the parent'
    return 1-((perfectfitness - fitness(parent)) / perfectfitness * (1 - minmutaterate))

def mutate(parent, rate):
    return [(ch if random() <= rate else choice(charset)) for ch in parent]

def que():
    '(from the favourite saying of Manuel in Fawlty Towers)'
    print ("#%-4i, fitness: %4.1f%%, '%s'" %
           (iterations, fitness(parent)*100./perfectfitness, ''.join(parent)))

def mate(a, b):
    place = 0
    if choice(xrange(10)) < 7:
        place = choice(xrange(len(target)))
    else:
        return a, b

    return a, b, a[:place] + b[place:], b[:place] + a[place:]

iterations = 0
center = len(C)/2
while parent != target:
    rate = mutaterate()
    iterations += 1
    if iterations % 100 == 0: que()
    copies = [ mutate(parent, rate) for _ in C ]  + [parent]
    parent1 = max(copies[:center], key=fitness)
    parent2 = max(copies[center:], key=fitness)
    parent = max(mate(parent1, parent2), key=fitness)
que()


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


MODULE EvenOrOdd;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;

VAR
    buf : ARRAY[0..63] OF CHAR;
    i : INTEGER;
BEGIN
    FOR i:=-5 TO 5 DO
        FormatString("%i is even: %b\n", buf, i, i MOD 2 = 0);
        WriteString(buf)
    END;

    ReadChar
END EvenOrOdd.


-- equilibriumIndices :: [Int] -> [Int]
on equilibriumIndices(xs)

    script balancedPair
        on |λ|(a, pair, i)
            set {x, y} to pair
            if x = y then
                {i - 1} & a
            else
                a
            end if
        end |λ|
    end script

    script plus
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    -- Fold over zipped pairs of sums from left
    -- and sums from right

    foldr(balancedPair, {}, ¬
        zip(scanl1(plus, xs), scanr1(plus, xs)))

end equilibriumIndices

-- TEST -----------------------------------------------------------------------
on run

    map(equilibriumIndices, {¬
        {-7, 1, 5, 2, -4, 3, 0}, ¬
        {2, 4, 6}, ¬
        {2, 9, 2}, ¬
        {1, -1, 1, -1, 1, -1, 1}, ¬
        {1}, ¬
        {}})

    --> {{3, 6}, {}, {1}, {0, 1, 2, 3, 4, 5, 6}, {0}, {}}
end run

-- GENERIC FUNCTIONS ----------------------------------------------------------

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- foldr :: (a -> b -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldr

-- init :: [a] -> [a]
on init(xs)
    set lng to length of xs
    if lng > 1 then
        items 1 thru -2 of xs
    else if lng > 0 then
        {}
    else
        missing value
    end if
end init

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- scanl :: (b -> a -> b) -> b -> [a] -> [b]
on scanl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        set lst to {startValue}
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
            set end of lst to v
        end repeat
        return lst
    end tell
end scanl

-- scanl1 :: (a -> a -> a) -> [a] -> [a]
on scanl1(f, xs)
    if length of xs > 0 then
        scanl(f, item 1 of xs, tail(xs))
    else
        {}
    end if
end scanl1

-- scanr :: (b -> a -> b) -> b -> [a] -> [b]
on scanr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        set lst to {startValue}
        repeat with i from lng to 1 by -1
            set v to |λ|(v, item i of xs, i, xs)
            set end of lst to v
        end repeat
        return reverse of lst
    end tell
end scanr

-- scanr1 :: (a -> a -> a) -> [a] -> [a]
on scanr1(f, xs)
    if length of xs > 0 then
        scanr(f, item -1 of xs, init(xs))
    else
        {}
    end if
end scanr1

-- tail :: [a] -> [a]
on tail(xs)
    if length of xs > 1 then
        items 2 thru -1 of xs
    else
        {}
    end if
end tail

-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
    set lng to min(length of xs, length of ys)
    set lst to {}
    repeat with i from 1 to lng
        set end of lst to {item i of xs, item i of ys}
    end repeat
    return lst
end zip


(define (bf program stack-length)
   (let ((program (string-append program "]")); end
         (program-counter 0)
         (stack (make-bytevector stack-length 0))
         (stack-pointer 0))
      (letrec ((skip (lambda (PC sp in)
                        (let loop ((pc PC) (sp sp) (in in))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list pc sp in))
                                 (#\[  (apply loop (skip pc sp in)))
                                 (else
                                    (loop pc sp in)))))))
               (step (lambda (PC SP IN)
                        (let loop ((pc PC) (sp SP) (in IN))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list (- PC 1) sp in)) ; the end
                                 (#\[  (if (eq? (ref stack sp) 0)
                                          (apply loop (skip pc sp in))
                                          (apply loop (step pc sp in))))
                                 (#\+  (set-ref! stack sp (mod (+ (ref stack sp) 257) 256))
                                       (loop pc sp in))
                                 (#\-  (set-ref! stack sp (mod (+ (ref stack sp) 255) 256))
                                       (loop pc sp in))
                                 (#\>  (loop pc (+ sp 1) in))
                                 (#\<  (loop pc (- sp 1) in))
                                 (#\.  (display (string (ref stack sp)))
                                       (loop pc sp in))
                                 (#\,  (let this ((in in))
                                          (cond
                                             ((pair? in)
                                                (set-ref! stack sp (car in))
                                                (loop pc sp (cdr in)))
                                             ((null? in)
                                                (set-ref! stack sp 0)
                                                (loop pc sp in))
                                             (else
                                                (this (force in))))))
                                 (else ; skip any invalid character
                                    (loop pc sp in))))))))
         (step 0 0 (port->bytestream stdin)))))


using DataStructures

entropy(s) = -sum(x -> x / length(s) * log2(x / length(s)), values(counter(s)))
println("self-entropy: ", entropy(read(Base.source_path(), String)))


// version 1.1.0 (entropy_narc.kt)

fun log2(d: Double) = Math.log(d) / Math.log(2.0)

fun shannon(s: String): Double {
    val counters = mutableMapOf<Char, Int>()
    for (c in s) {
        if (counters.containsKey(c)) counters[c] = counters[c]!! + 1
        else counters.put(c, 1)
    }
    val nn = s.length.toDouble()
    var sum = 0.0
    for (key in counters.keys) {
       val term = counters[key]!! / nn
       sum += term * log2(term)
    }
    return -sum
}

fun main(args: Array<String>) {
   val prog = java.io.File("entropy_narc.kt").readText()
   println("This program's entropy is ${"%18.16f".format(shannon(prog))}")
}


function getFile (filename)
    local inFile = io.open(filename, "r")
    local fileContent = inFile:read("*all")
    inFile:close()
    return fileContent
end

function log2 (x) return math.log(x) / math.log(2) end

function entropy (X)
    local N, count, sum, i = X:len(), {}, 0
    for char = 1, N do
        i = X:sub(char, char)
        if count[i] then
            count[i] = count[i] + 1
        else
            count[i] = 1
        end
    end
    for n_i, count_i in pairs(count) do
        sum = sum + count_i / N * log2(count_i / N)
    end
    return -sum
end

print(entropy(getFile(arg[0])))


: <factorial> dup 1 = if; dup 1- <factorial> * ;
: factorial dup 0 = [ 1+ ] [ <factorial> ] if ;


/*REXX pgm computes & shows the factorial of a non─negative integer, and also its length*/
numeric digits 100000                            /*100k digits:  handles  N  up to  25k.*/
parse arg n                                      /*obtain optional argument from the CL.*/
if n=''                   then call er  'no argument specified.'
if arg()>1 | words(n)>1   then call er  'too many arguments specified.'
if \datatype(n,'N')       then call er  "argument isn't numeric: "          n
if \datatype(n,'W')       then call er  "argument isn't a whole number: "   n
if n<0                    then call er  "argument can't be negative: "      n
!= 1                                             /*define the factorial product (so far)*/
      do j=2  to n;       !=!*j                  /*compute the factorial the hard way.  */
      end   /*j*/                                /* [↑]  where da rubber meets da road. */

say n'!  is  ['length(!) "digits]:"              /*display number of digits in factorial*/
say                                              /*add some whitespace to the output.   */
say !                                            /*display the factorial product──►term.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
er:    say;       say '***error***';      say;      say arg(1);      say;          exit 13


System.getenv("HOME") // get env var
System.getenv()       // get the entire environment as a Map of keys to values


var shell = new ActiveXObject("WScript.Shell");
var env = shell.Environment("PROCESS");
WScript.echo('SYSTEMROOT=' + env.item('SYSTEMROOT'));


/* Environment variables, in Jsi */
puts(Util.getenv("HOME"));
var environment = Util.getenv();
puts(environment.PATH);


type Fruit is (apple, banana, cherry); -- No specification of the representation value;
for Fruit use (apple => 1, banana => 2, cherry => 4); -- specification of the representation values


BEGIN # example 1 #
  MODE FRUIT = INT;
  FRUIT apple = 1, banana = 2, cherry = 4;
  FRUIT x := cherry;
  CASE x IN
    print(("It is an apple #",x, new line)),
    print(("It is a banana #",x, new line)),
    SKIP, # 3 not defined #
    print(("It is a cherry #",x, new line))
  OUT
    SKIP # other values #
  ESAC
END;


ENUM APPLE, BANANA, CHERRY

PROC main()
  DEF x
  ForAll({x}, [APPLE, BANANA, CHERRY],
         `WriteF('\d\n', x))
ENDPROC


enum: [apple banana cherry]
print "as a block of words:"
inspect.muted enum

enum: ['apple 'banana 'cherry]
print "\nas a block of literals:"
print enum

enum: #[
    apple: 1
    banana: 2
    cherry: 3
]
print "\nas a dictionary:"
print enum


ODESolver>>eulerOf: f init: y0 from: a to: b step: h
	| t y |
	t := a.
	y := y0.
	[ t < b ]
		whileTrue: [
			Transcript
				show: t asString, ' ' , (y printShowingDecimalPlaces: 3);
				cr.
			t := t + h.
			y := y + (h * (f value: t value: y)) ]

ODESolver new eulerOf: [:time :temp| -0.07 * (temp - 20)]  init: 100 from: 0 to: 100 step: 10


import Foundation

let numberFormat = " %7.3f"
let k = 0.07
let initialTemp = 100.0
let finalTemp = 20.0
let startTime = 0
let endTime = 100

func ivpEuler(function: (Double, Double) -> Double, initialValue: Double, step: Int) {
    print(String(format: " Step %2d: ", step), terminator: "")
    var y = initialValue
    for t in stride(from: startTime, through: endTime, by: step) {
        if t % 10 == 0 {
            print(String(format: numberFormat, y), terminator: "")
        }
        y += Double(step) * function(Double(t), y)
    }
    print()
}

func analytic() {
    print("    Time: ", terminator: "")
    for t in stride(from: startTime, through: endTime, by: 10) {
        print(String(format: " %7d", t), terminator: "")
    }
    print("\nAnalytic: ", terminator: "")
    for t in stride(from: startTime, through: endTime, by: 10) {
        let temp = finalTemp + (initialTemp - finalTemp) * exp(-k * Double(t))
        print(String(format: numberFormat, temp), terminator: "")
    }
    print()
}

func cooling(t: Double, temp: Double) -> Double {
    return -k * (temp - finalTemp)
}

analytic()
ivpEuler(function: cooling, initialValue: initialTemp, step: 2)
ivpEuler(function: cooling, initialValue: initialTemp, step: 5)
ivpEuler(function: cooling, initialValue: initialTemp, step: 10)


proc euler {f y0 a b h} {
    puts "computing $f over \[$a..$b\], step $h"
    set y [expr {double($y0)}]
    for {set t [expr {double($a)}]} {$t < $b} {set t [expr {$t + $h}]} {
	puts [format "%.3f\t%.3f" $t $y]
	set y [expr {$y + $h * double([$f $t $y])}]
    }
    puts "done"
}


USING: arrays backtrack kernel literals math.functions
math.ranges prettyprint sequences ;

CONSTANT: pow5 $[ 0 250 [a,b) [ 5 ^ ] map ]

: xn ( n1 -- n2 n2 ) [1,b) amb-lazy dup ;

250 xn xn xn xn drop 4array dup pow5 nths sum dup pow5
member? [ pow5 index suffix . ] [ 2drop fail ] if


: sq  dup * ;
: 5^  dup sq sq * ;

create pow5 250 cells allot
:noname
   250 0 DO  i 5^  pow5 i cells + !  LOOP ; execute

: @5^  cells pow5 + @ ;

: solution? ( n -- n )
   pow5 250 cells bounds DO
      dup i @ = IF  drop i pow5 - cell / unloop EXIT  THEN
   cell +LOOP drop 0 ;

\ GFORTH only provides 2 index variables: i, j
\ so the code creates locals for two outer loop vars, k & l

: euler  ( -- )
   250 4 DO i { l }
      l 3 DO i { k }
         k 2 DO
            i 1 DO
               i @5^ j @5^ + k @5^ + l @5^ + solution?
               dup IF
                  l . k . j . i . . cr
                  unloop unloop unloop unloop EXIT
               ELSE
                  drop
               THEN
            LOOP
         LOOP
      LOOP
   LOOP ;

euler
bye


set.seed(1234, kind="Mersenne-Twister")

## Easier if the string is a character vector
target <- unlist(strsplit("METHINKS IT IS LIKE A WEASEL", ""))

charset <- c(LETTERS, " ")
parent <- sample(charset, length(target), replace=TRUE)

mutaterate <- 0.01

## Number of offspring in each generation
C <- 100

## Hamming distance between strings normalized by string length is used
## as the fitness function.
fitness <- function(parent, target) {
    sum(parent == target) / length(target)
}

mutate <- function(parent, rate, charset) {
    p <- runif(length(parent))
    nMutants <- sum(p < rate)
    if (nMutants) {
        parent[ p < rate ] <- sample(charset, nMutants, replace=TRUE)
    }
    parent
}

evolve <- function(parent, mutate, fitness, C, mutaterate, charset) {
    children <- replicate(C, mutate(parent, mutaterate, charset),
                          simplify=FALSE)
    children <- c(list(parent), children)
    children[[which.max(sapply(children, fitness, target=target))]]
}

.printGen <- function(parent, target, gen) {
    cat(format(i, width=3),
        formatC(fitness(parent, target), digits=2, format="f"),
        paste(parent, collapse=""), "\n")
}

i <- 0
.printGen(parent, target, i)
while ( ! all(parent == target)) {
    i <- i + 1
    parent <- evolve(parent, mutate, fitness, C, mutaterate, charset)

    if (i %% 20 == 0) {
        .printGen(parent, target, i)
    }
}
.printGen(parent, target, i)


#lang racket

(define alphabet " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(define (randch) (string-ref alphabet (random 27)))

(define (fitness s1 s2)
  (for/sum ([c1 (in-string s1)] [c2 (in-string s2)])
    (if (eq? c1 c2) 1 0)))

(define (mutate s P)
  (define r (string-copy s))
  (for ([i (in-range (string-length r))] #:when (<= (random) P))
    (string-set! r i (randch)))
  r)

(define (evolution target C P)
  (let loop ([parent (mutate target 1.0)] [n 0])
    ;; (printf "~a: ~a\n" n parent)
    (if (equal? parent target)
      n
      (let cloop ([children (for/list ([i (in-range C)]) (mutate parent P))]
                  [best #f] [fit -1])
        (if (null? children)
          (loop best (add1 n))
          (let ([f (fitness target (car children))])
            (if (> f fit)
              (cloop (cdr children) (car children) f)
              (cloop (cdr children) best fit))))))))

;; Some random experiment using all of this
(define (try-run C P)
  (define ns
    (for/list ([i 10])
      (evolution "METHINKS IT IS LIKE A WEASEL" C P)))
  (printf "~s Average generation: ~s\n" C (/ (apply + 0.0 ns) (length ns)))
  (printf "~s      Total strings: ~s\n" C (for/sum ([n ns]) (* n 50))))
(for ([C (in-range 10 501 10)]) (try-run C 0.001))


def isEven(n)
        if ((n % 2) = 1)
                return false
        else
                return true
        end
end

for i in range(1, 10)
        print i
        if isEven(i)
                println " is even."
        else
                println " is odd."
        end
end


var number = 6;

if(number % 2 == 0) {
	$print("Even");
} else {
	$print("Odd");
}


function even(n) = mod(n, 2) == 0;

% test the function by applying it to the first ten positive integers: %
{even(n) : n in [1:11]};


eqIndex: function [row][
    suml: 0
    delayed: 0
    sumr: sum row
    result: new []
    loop.with:'i row 'r [
        suml: suml + delayed
        sumr: sumr - r
        delayed: r
        if suml = sumr -> 'result ++ i
    ]
    return result
]

data: @[
    @[neg 7, 1, 5, 2, neg 4, 3, 0]
    @[2 4 6]
    @[2 9 2]
    @[1 neg 1 1 neg 1 1 neg 1 1]
]

loop data 'd ->
    print [pad.right join.with:", " to [:string] d 25 "=> equilibrium index:" eqIndex d]


Equilibrium_index(list, BaseIndex=0){
	StringSplit, A, list, `,
	Loop % A0 {
		i := A_Index	, Pre := Post := 0
		loop, % A0
			if (A_Index < i)
				Pre += A%A_Index%
			else if (A_Index > i)
				Post += A%A_Index%
		if (Pre = Post)
			Res .= (Res?", ":"") i - (BaseIndex?0:1)
	}
	return Res
}


SELECT round ( EXP ( SUM (ln ( ( 1 + SQRT( 5 ) ) / 2)
        ) OVER ( ORDER BY level ) ) / SQRT( 5 ) ) fibo
FROM dual
CONNECT BY level <= 10;


(define (bf program stack-length)
   (let ((program (string-append program "]")); end
         (program-counter 0)
         (stack (make-bytevector stack-length 0))
         (stack-pointer 0))
      (letrec ((skip (lambda (PC sp in)
                        (let loop ((pc PC) (sp sp) (in in))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list pc sp in))
                                 (#\[  (apply loop (skip pc sp in)))
                                 (else
                                    (loop pc sp in)))))))
               (step (lambda (PC SP IN)
                        (let loop ((pc PC) (sp SP) (in IN))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list (- PC 1) sp in)) ; the end
                                 (#\[  (if (eq? (ref stack sp) 0)
                                          (apply loop (skip pc sp in))
                                          (apply loop (step pc sp in))))
                                 (#\+  (set-ref! stack sp (mod (+ (ref stack sp) 257) 256))
                                       (loop pc sp in))
                                 (#\-  (set-ref! stack sp (mod (+ (ref stack sp) 255) 256))
                                       (loop pc sp in))
                                 (#\>  (loop pc (+ sp 1) in))
                                 (#\<  (loop pc (- sp 1) in))
                                 (#\.  (display (string (ref stack sp)))
                                       (loop pc sp in))
                                 (#\,  (let this ((in in))
                                          (cond
                                             ((pair? in)
                                                (set-ref! stack sp (car in))
                                                (loop pc sp (cdr in)))
                                             ((null? in)
                                                (set-ref! stack sp 0)
                                                (loop pc sp in))
                                             (else
                                                (this (force in))))))
                                 (else ; skip any invalid character
                                    (loop pc sp in))))))))
         (step 0 0 (port->bytestream stdin)))))


import os, math, strutils, tables

let execName = getAppFilename().splitPath().tail
let srcName = execName & ".nim"

func entropy(str: string): float =
  var counts: CountTable[char]
  for ch in str:
    counts.inc(ch)
  for count in counts.values:
    result -= count / str.len * log2(count / str.len)

echo "Source file entropy: ", srcName.readFile().entropy().formatFloat(ffDecimal, 5)
echo "Binary file entropy: ", execName.readFile().entropy().formatFloat(ffDecimal, 5)


#!/usr/bin/perl
use strict ;
use warnings ;
use feature 'say' ;

sub log2 {
   my $number = shift ;
   return log( $number ) / log( 2 ) ;
}

open my $fh , "<" , $ARGV[ 0 ] or die "Can't open $ARGV[ 0 ]$!\n" ;
my %frequencies ;
my $totallength = 0 ;
while ( my $line = <$fh> ) {
   chomp $line ;
   next if $line =~ /^$/ ;
   map { $frequencies{ $_ }++ } split( // , $line ) ;
   $totallength += length ( $line ) ;
}
close $fh ;
my $infocontent = 0 ;
for my $letter ( keys %frequencies ) {
   my $content = $frequencies{ $letter } / $totallength ;
   $infocontent += $content * log2( $content ) ;
}
$infocontent *= -1 ;
say "The information content of the source file is $infocontent !" ;


without js -- command_line, file i/o
function entropy(sequence s)
    sequence symbols = {},
             counts = {}
    integer N = length(s)
    for i=1 to N do
        object si = s[i]
        integer k = find(si,symbols)
        if k=0 then
            symbols = append(symbols,si)
            counts = append(counts,1)
        else
            counts[k] += 1
        end if
    end for
    atom H = 0
    for i=1 to length(counts) do
        atom ci = counts[i]/N
        H -= ci*log2(ci)
    end for
    return H
end function

?entropy(get_text(open(substitute(command_line()[2],".exe",".exw")),"rb"))


give n
x = fact(n)
see n + " factorial is : " + x

func fact nr if nr = 1 return 1 else return nr * fact(nr-1) ok


input string "Enter a number:"
set "in" to "('ABS('input')')"
if "in" <= 1 then "one"
set "result" to 1

: "factorial"
set "result" to "('result' * 'in')"
dec "in" by 1
if "in" > 1 then "factorial"
* "('result')"
end

: "one"
* "1"
end


@show ENV["PATH"]
@show ENV["HOME"]
@show ENV["USER"]


// version 1.0.6

// tested on Windows 10

fun main(args: Array<String>) {
   println(System.getenv("SystemRoot"))
}


writeln "HOME: ", _env["HOME"]
writeln "PATH: ", _env["PATH"]
writeln "USER: ", _env["USER"]


#!/usr/bin/lasso9

define getenv(sysvar::string) => {
	local(regexp = regexp(
		-find = `(?m)^` + #sysvar + `=(.*?)$`,
		-input = sys_environ -> join('\n'),
		-ignorecase
	))
	return #regexp ->find ? #regexp -> matchString(1)
}

stdoutnl(getenv('HOME'))
stdoutnl(getenv('PATH'))
stdoutnl(getenv('USER'))
stdoutnl(getenv('WHAT'))


static LILCALLBACK lil_value_t fnc_env(lil_t lil, size_t argc, lil_value_t* argv)
{
    if (!argc) return NULL;
    return lil_alloc_string(getenv(lil_to_string(argv[0])));
}


datatype my_enum =
| value_a
| value_b
| value_c


fruit_%apple% = 0
fruit_%banana% = 1
fruit_%cherry% = 2


fruit["apple"]=1; fruit["banana"]=2; fruit["cherry"]=3
fruit[1]="apple"; fruit[2]="banana"; fruit[3]="cherry"
i=0; apple=++i; banana=++i; cherry=++i;


REM Impossible. Can only be faked with arrays of strings.
OPTION BASE 1
DIM SHARED fruitsName$(1 TO 3)
DIM SHARED fruitsVal%( 1 TO 3)
fruitsName$[1] = "apple"
fruitsName$[2] = "banana"
fruitsName$[3] = "cherry"
fruitsVal%[1] = 1
fruitsVal%[2] = 2
fruitsVal%[3] = 3

REM OR GLOBAL CONSTANTS
DIM SHARED apple%, banana%, cherry%
apple%  = 1
banana% = 2
cherry% = 3


Private Sub ivp_euler(f As String, y As Double, step As Integer, end_t As Integer)
    Dim t As Integer
    Debug.Print " Step "; step; ": ",
    Do While t <= end_t
        If t Mod 10 = 0 Then Debug.Print Format(y, "0.000"),
        y = y + step * Application.Run(f, y)
        t = t + step
    Loop
    Debug.Print
End Sub

Sub analytic()
    Debug.Print "    Time: ",
    For t = 0 To 100 Step 10
        Debug.Print " "; t,
    Next t
    Debug.Print
    Debug.Print "Analytic: ",
    For t = 0 To 100 Step 10
        Debug.Print Format(20 + 80 * Exp(-0.07 * t), "0.000"),
    Next t
    Debug.Print
End Sub

Private Function cooling(temp As Double) As Double
    cooling = -0.07 * (temp - 20)
End Function

Public Sub euler_method()
    Dim r_cooling As String
    r_cooling = "cooling"
    analytic
    ivp_euler r_cooling, 100, 2, 100
    ivp_euler r_cooling, 100, 5, 100
    ivp_euler r_cooling, 100, 10, 100
End Sub


import math
// Fdy is a type for fntion f used in Euler's method.
type Fdy = fn(f64, f64) f64

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

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

// new_cooling_rate returns a fntion that computes cooling rate
// for a given cooling rate constant k.
fn new_cooling_rate(k f64) fn(f64) f64 {
    return fn[k](delta_temp f64) f64 {
        return -k * delta_temp
    }
}

// new_temp_func returns a fntion that computes the analytical solution
// of cooling rate integrated over time.
fn new_temp_func(k f64, ambient_temp f64, initial_temp f64) fn(f64) f64 {
    return fn[ambient_temp,initial_temp,k](time f64) f64 {
        return ambient_temp + (initial_temp-ambient_temp)*math.exp(-k*time)
    }
}

// new_cooling_rate_dy returns a fntion of the kind needed for Euler's method.
// That is, a fntion representing dy(x, y(x)).
//
// Parameters to new_cooling_rate_dy are cooling constant k and ambient
// temperature.
fn new_cooling_rate_dy(k f64, ambient_temp f64) Fdy {
    // note that result is dependent only on the object temperature.
    // there are no additional dependencies on time, so the x parameter
    // provided by euler_step is unused.
    return fn[k,ambient_temp](_ f64, object_temp f64) f64 {
        return new_cooling_rate(k)(object_temp - ambient_temp)
    }
}

fn main() {
    k := .07
    temp_room := 20.0
    temp_object := 100.0
    fcr := new_cooling_rate_dy(k, temp_room)
    analytic := new_temp_func(k, temp_room, temp_object)
    for delta_time in [2.0, 5, 10] {
        println("Step size = ${delta_time:.1f}")
        println(" Time Euler's Analytic")
        mut temp := temp_object
        for time := 0.0; time <= 100; time += delta_time {
            println("${time:5.1f} ${temp:7.3f} ${analytic(time):7.3f}")
            temp = euler_step(fcr, time, temp, delta_time)
        }
        println('')
    }
}


C EULER SUM OF POWERS CONJECTURE - FORTRAN IV
C FIND I1,I2,I3,I4,I5 : I1**5+I2**5+I3**5+I4**5=I5**5
      INTEGER I,P5(250),SUMX
      MAXN=250
      DO 1 I=1,MAXN
   1  P5(I)=I**5
      DO 6 I1=1,MAXN
      DO 6 I2=1,MAXN
      DO 6 I3=1,MAXN
      DO 6 I4=1,MAXN
      SUMX=P5(I1)+P5(I2)+P5(I3)+P5(I4)
      I5=1
   2  IF(I5-MAXN) 3,3,6
   3  IF(P5(I5)-SUMX) 5,4,6
   4  WRITE(*,300) I1,I2,I3,I4,I5
      STOP
   5  I5=I5+1
      GOTO 2
   6  CONTINUE
 300  FORMAT(5(1X,I3))
      END


' version 14-09-2015
' compile with: fbc -s console

' some constants calculated when the program is compiled

Const As UInteger max = 250
Const As ULongInt pow5_max = CULngInt(max) * max * max * max * max
' limit x1, x2, x3
Const As UInteger limit_x1 = (pow5_max / 4) ^ 0.2
Const As UInteger limit_x2 = (pow5_max / 3) ^ 0.2
Const As UInteger limit_x3 = (pow5_max / 2) ^ 0.2

' ------=< MAIN >=------

Dim As ULongInt pow5(max), ans1, ans2, ans3
Dim As UInteger x1, x2, x3, x4, x5 , m1, m2

Cls : Print

For x1 = 1 To max
    pow5(x1) = CULngInt(x1) * x1 * x1 * x1 * x1
Next x1

For x1 = 1 To limit_x1
    For x2 = x1 +1 To limit_x2
        m1 = x1 + x2
        ans1 = pow5(x1) + pow5(x2)
        If ans1 > pow5_max Then Exit For
        For x3 = x2 +1 To limit_x3
            ans2 = ans1 + pow5(x3)
            If ans2 > pow5_max Then Exit For
            m2 = (m1 + x3) Mod 30
            If m2 = 0 Then m2 = 30
            For x4 = x3 +1 To max -1
                ans3 = ans2 + pow5(x4)
                If ans3 > pow5_max Then Exit For
                For x5 = x4 + m2 To max Step 30
                    If ans3 < pow5(x5) Then Exit For
                    If ans3 = pow5(x5) Then
                        Print x1; "^5 + "; x2; "^5 + "; x3; "^5 + "; _
                              x4; "^5 = "; x5; "^5"
                        Exit For, For
                    EndIf
                Next x5
            Next x4
        Next x3
    Next x2
Next x1

Print
Print "done"

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


constant target = "METHINKS IT IS LIKE A WEASEL";
constant mutate_chance = .08;
constant @alphabet = flat 'A'..'Z',' ';
constant C = 100;

sub mutate { [~] (rand < mutate_chance ?? @alphabet.pick !! $_ for $^string.comb) }
sub fitness { [+] $^string.comb Zeq target.comb }

loop (
    my $parent = @alphabet.roll(target.chars).join;
    $parent ne target;
    $parent = max :by(&fitness), mutate($parent) xx C
) { printf "%6d: '%s'\n", $++, $parent }


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

say 'Val'.right(5)': mod  - ver  - pos  - bits'
say '---'.right(5)': ---- + ---- + ---- + ----'
loop nn = -15 to 15 by 3
  say nn.right(5)':' eo(isEven(nn)) '-' eo(isEven(nn, 'v')) '-' eo(isEven(nn, 'p')) '-' eo(isEven(nn, 'b'))
  end nn
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Overloaded method.  Default is to use the remainder specialization below
method isEven(anInt, meth = 'R') public static returns boolean
  select case meth.upper().left(1)
    when 'R' then eo = isEvenRemainder(anInt)
    when 'V' then eo = isEvenVerify(anInt)
    when 'P' then eo = isEvenPos(anInt)
    when 'B' then eo = isEvenBits(anInt)
    otherwise     eo = isEvenRemainder(anInt) -- default
    end
  return eo

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method isEvenRemainder(anInt) public static returns boolean
  return anInt // 2 == 0

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method isEvenVerify(anInt) public static returns boolean
  return anInt.right(1).verify('02468') == 0

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method isEvenPos(anInt) public static returns boolean
  return '13579'.pos(anInt.right(1)) == 0

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method isEvenBits(anInt) public static returns boolean
  return \(anInt.d2x(1).x2b().right(1))

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method eo(state = boolean) public static
  if state then sv = 'Even'
           else sv = 'Odd'
  return sv.left(4)


# syntax: GAWK -f EQUILIBRIUM_INDEX.AWK
BEGIN {
    main("-7 1 5 2 -4 3 0")
    main("2 4 6")
    main("2 9 2")
    main("1 -1 1 -1 1 -1 1")
    exit(0)
}
function main(numbers,  x) {
    x = equilibrium(numbers)
    printf("numbers: %s\n",numbers)
    printf("indices: %s\n\n",length(x)==0?"none":x)
}
function equilibrium(numbers,  arr,i,leftsum,leng,str,sum) {
    leng = split(numbers,arr," ")
    for (i=1; i<=leng; i++) {
      sum += arr[i]
    }
    for (i=1; i<=leng; i++) {
      sum -= arr[i]
      if (leftsum == sum) {
        str = str i " "
      }
      leftsum += arr[i]
    }
    return(str)
}


@echo off
setlocal enabledelayedexpansion

call :equilibrium-index "-7 1 5 2 -4 3 0"
call :equilibrium-index "2 4 6"
call :equilibrium-index "2 9 2"
call :equilibrium-index "1 -1 1 -1 1 -1 1"
pause>nul
exit /b

	%== The Function ==%
:equilibrium-index <sequence with quotes>
	::Set the pseudo-array sequence...
set "seq=%~1"
set seq.length=0
for %%S in (!seq!) do (
	set seq[!seq.length!]=%%S
	set /a seq.length+=1
)
	::Initialization of other variables...
set "equilms="
set /a last=seq.length - 1
	::The main checking...
for /l %%e in (0,1,!last!) do (
	set left=0
	set right=0

	for /l %%i in (0,1,!last!) do (
		if %%i lss %%e (set /a left+=!seq[%%i]!)
		if %%i gtr %%e (set /a right+=!seq[%%i]!)
	)
	if !left!==!right! (
		if defined equilms (
			set "equilms=!equilms! %%e"
		) else (
			set "equilms=%%e"
		)
	)
)
echo [!equilms!]
goto :EOF
	%==/The Function ==%


BF(prog)={
	prog=Vec(Str(prog));
	my(codeptr,ptr=1,v=vector(1000),t);
	while(codeptr++ <= #prog,
		t=prog[codeptr];
		if(t=="+",
			v[ptr]++
		,
			if(t=="-",
				v[ptr]--
			,
				if(t==">",
					ptr++
				,
					if(t=="<",
						ptr--
					,
						if(t=="[" && !v[ptr],
							t=1;
							while(t,
								if(prog[codeptr++]=="[",t++);
								if(prog[codeptr]=="]",t--)
							);
						);
						if(t=="]"&&v[ptr],
							t=1;
							while(t,
								if(prog[codeptr--]=="[",t--);
								if(prog[codeptr]=="]",t++)
							)
						);
						if(t==".",
							print1(Strchr(v[ptr]))
						);
						if(t==",",
							v[ptr]=Vecsmall(input)[1]
						)
					)
				)
			)
		)
	)
};


<?php
$h  =                             0;
$s  =   file_get_contents(__FILE__);
$l  =                    strlen($s);
foreach ( count_chars($s, 1) as $c )
                               $h -=
                       ( $c / $l ) *
                  log( $c / $l, 2 );
echo                             $h;


entropy(File) = E =>
    Bytes = read_file_bytes(File),
    F = [0: I in 1..256],
    foreach (B in Bytes)
        B1 := B + 1,
        F[B1] := F[B1] + 1
    end,
    HM = 0,
    foreach (C in F)
        if (C > 0) then
            HM := HM + C * log(2, C)
        end
    end,
    L = Bytes.length,
    E = log(2, L) - HM / L.

main(Args) =>
    printf("Entropy: %f\n", entropy(Args[1])).


(scl 8)
(load "@lib/math.l")

(setq LN2 0.693147180559945309417)

(setq Me
   (let F (file)
      (pack (car F) (cadr F))))

(setq Hist NIL Sz 0)
(in Me
   (use Ch
      (while (setq Ch (rd 1))
         (inc 'Sz)
         (if (assoc Ch Hist)
            (con @ (inc (cdr @)))
            (setq Hist (cons (cons Ch 1) Hist))))))

(prinl "My entropy is "
   (format
      (*/
         (sum
            '((Pair)
               (let R (*/ (cdr Pair) 1. Sz)
                  (- (*/ R (log R) 1.))))
            Hist)
         1. LN2)
      *Scl))

(bye)


import math
from collections import Counter

def entropy(s):
    p, lns = Counter(s), float(len(s))
    return -sum( count/lns * math.log(count/lns, 2) for count in p.values())

with open(__file__) as f:
    b=f.read()

print(entropy(b))


#lang racket
(require math)
(define (log2 x) (/ (log x) (log 2)))
(define ds (string->list (file->string "entropy.rkt")))
(define n (length ds))
(- (for/sum ([(d c) (in-hash (samples->hash ds))])
     (* (/ c n) (log2 (/ c n)))))


say log(2) R/ [+] map -> \p { p * -log p }, $_.comb.Bag.values >>/>> +$_
    given slurp($*PROGRAM-NAME).comb


Factorial takes a number
If a number is 0
Give back 1.

Put a number into the first
Knock a number down
Give back the first times Factorial taking a number


# Recursive
def factorial_recursive(n)
  n.zero? ? 1 : n * factorial_recursive(n - 1)
end

# Tail-recursive
def factorial_tail_recursive(n, prod = 1)
  n.zero? ? prod : factorial_tail_recursive(n - 1, prod * n)
end

# Iterative with Range#each
def factorial_iterative(n)
  (2...n).each { |i| n *= i }
  n.zero? ? 1 : n
end

# Iterative with Range#inject
def factorial_inject(n)
  (1..n).inject(1){ |prod, i| prod * i }
end

# Iterative with Range#reduce, requires Ruby 1.8.7
def factorial_reduce(n)
  (2..n).reduce(1, :*)
end

require 'benchmark'

n = 400
m = 10000

Benchmark.bm(16) do |b|
  b.report('recursive:')       {m.times {factorial_recursive(n)}}
  b.report('tail recursive:')  {m.times {factorial_tail_recursive(n)}}
  b.report('iterative:')       {m.times {factorial_iterative(n)}}
  b.report('inject:')          {m.times {factorial_inject(n)}}
  b.report('reduce:')          {m.times {factorial_reduce(n)}}
end


sx = xtra("Shell").new()
if the platform contains "win" then
  path = sx.shell_cmd("echo %PATH%").line[1]
else
  path = sx.shell_cmd("echo $PATH").line[1]
end if


default {
	state_entry() {
		llOwnerSay("llGetTimestamp()="+(string)llGetTimestamp());
		llOwnerSay("llGetEnergy()="+(string)llGetEnergy());
		llOwnerSay("llGetFreeMemory()="+(string)llGetFreeMemory());
		llOwnerSay("llGetMemoryLimit()="+(string)llGetMemoryLimit());
	}
}


Module CheckIt {
      \\ using read only variablles
      Print "Platform: ";Platform$
      Print "Computer Os: "; Os$
      Print "Type of OS: ";OsBit;" bit"
      Print "Computer Name:";  Computer$
      Print "User Name: "; User.Name$
      \\ using WScript.Shell
      Declare objShell "WScript.Shell"
      With  objShell, "Environment" set env ("Process")
      With env, "item" as Env$()
      Print Env$("PATH")
      Print Env$("HOMEPATH")
      Declare objShell Nothing
      \\ using internal Information object
      Declare OsInfo INFORMATION
      With OsInfo, "build" as build, "NtDllVersion" as NtDllVersion$
      Method OsInfo, "GetCurrentProcessSID" as PID$
      Method OsInfo, "IsProcessElevated" as isElevated
      Print "Os build number: ";build
      Print "Nr Dll version: ";NtDllVersion$
      Print "ProcessSID: ";pid$
      Print "Is Process Eleveted: ";isElevated
      Declare OsInfo Nothing
}
Checkit


TARGET = $(HOME)/some/thing.txt
foo:
	echo $(TARGET)


enum fruits { apple, banana, cherry };

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


enum fruits { apple, banana, cherry }

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

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

[FlagsAttribute]
enum Colors { Red = 1, Green = 2, Blue = 4, Yellow = 8 }


; a set of keywords
(def fruits #{:apple :banana :cherry})

; a predicate to test "fruit" membership
(defn fruit? [x] (contains? fruits x))

; if you need a value associated with each fruit
(def fruit-value (zipmap fruits (iterate inc 1)))

(println (fruit? :apple))
(println (fruit-value :banana))


include c:\cxpl\codes;  \intrinsic 'code' declarations

proc Euler(Step);       \Display cooling temperatures using Euler's method
int  Step;
int  Time;  real Temp;
[Text(0, "Step ");  IntOut(0, Step);  Text(0, " ");
Time:= 0;  Temp:= 100.0;
repeat  if rem(Time/10) = 0 then RlOut(0, Temp);
        Temp:= Temp + float(Step) * (-0.07*(Temp-20.0));
        Time:= Time + Step;
until   Time > 100;
CrLf(0);
];

real Time, Temp;
[Format(6,0);                   \display time heading
Text(0, "Time   ");
Time:= 0.0;
while Time <= 100.1 do          \(.1 avoids possible rounding error)
        [RlOut(0, Time);
        Time:= Time + 10.0;
        ];
CrLf(0);

Format(3,2);                    \display cooling temps using differential eqn.
Text(0, "Dif eq ");             \ dTemp(time)/dtime = -k*�Temp
Time:= 0.0;
while Time <= 100.1 do
        [Temp:= 20.0 + (100.0-20.0) * Exp(-0.07*Time);
        RlOut(0, Temp);
        Time:= Time + 10.0;
        ];
CrLf(0);

Euler(2);                       \display cooling temps for various time steps
Euler(5);
Euler(10);
]


import "/fmt" for Fmt
import "/trait" for Stepped

var euler = Fn.new { |f, y, step, end|
    Fmt.write(" Step $2d: ", step)
    for (t in Stepped.new(0..end, step)) {
        if (t%10 == 0) Fmt.write(" $7.3f", y)
        y = y + step * f.call(y)
    }
    System.print()
}

var analytic = Fn.new {
    System.write("    Time: ")
    for (t in Stepped.new(0..100, 10)) Fmt.write(" $7d", t)
    System.write("\nAnalytic: ")
    for (t in Stepped.new(0..100, 10)) {
        Fmt.write(" $7.3f", 20 + 80 * (-0.07*t).exp)
    }
    System.print()
}
var cooling = Fn.new { |temp| -0.07 * (temp - 20) }

analytic.call()
for (i in [2, 5, 10]) euler.call(cooling, 100, i, 100)


package main

import (
	"fmt"
	"log"
)

func main() {
	fmt.Println(eulerSum())
}

func eulerSum() (x0, x1, x2, x3, y int) {
	var pow5 [250]int
	for i := range pow5 {
		pow5[i] = i * i * i * i * i
	}
	for x0 = 4; x0 < len(pow5); x0++ {
		for x1 = 3; x1 < x0; x1++ {
			for x2 = 2; x2 < x1; x2++ {
				for x3 = 1; x3 < x2; x3++ {
					sum := pow5[x0] +
						pow5[x1] +
						pow5[x2] +
						pow5[x3]
					for y = x0 + 1; y < len(pow5); y++ {
						if sum == pow5[y] {
							return
						}
					}
				}
			}
		}
	}
	log.Fatal("no solution")
	return
}


class EulerSumOfPowers {
    static final int MAX_NUMBER = 250

    static void main(String[] args) {
        boolean found = false
        long[] fifth = new long[MAX_NUMBER]

        for (int i = 1; i <= MAX_NUMBER; i++) {
            long i2 = i * i
            fifth[i - 1] = i2 * i2 * i
        }

        for (int a = 0; a < MAX_NUMBER && !found; a++) {
            for (int b = a; b < MAX_NUMBER && !found; b++) {
                for (int c = b; c < MAX_NUMBER && !found; c++) {
                    for (int d = c; d < MAX_NUMBER && !found; d++) {
                        long sum = fifth[a] + fifth[b] + fifth[c] + fifth[d]
                        int e = Arrays.binarySearch(fifth, sum)
                        found = (e >= 0)
                        if (found) {
                            println("${a + 1}^5 + ${b + 1}^5 + ${c + 1}^5 + ${d + 1}^5 + ${e + 1}^5")
                        }
                    }
                }
            }
        }
    }
}


Red[]

; allowed characters
alphabet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
; target string
target: "METHINKS IT IS LIKE A WEASEL"
; parameter controlling the number of children
C: 10
; parameter controlling the evolution rate
RATE: 0.05

; compute closeness of 'string' to 'target'
fitness: function [string] [
  sum: 0

  repeat i length? string [
    if not-equal? pick string i pick target i [
      sum: sum + 1
    ]
  ]

  sum
]

; return copy of 'string' with mutations, frequency based on given 'rate'
mutate: function [string rate] [
  result: copy string

  repeat i length? result [
    if rate > random 1.0 [
      poke result i random/only alphabet
    ]
  ]

  result
]

; create initial random parent
parent: ""
repeat i length? target [
  append parent random/only alphabet
]

; main loop, displaying progress
while [not-equal? parent target] [
  print parent
  children: copy []

  repeat i C [
    append children mutate parent RATE
  ]
  sort/compare children function [a b] [lesser? fitness a fitness b]

  parent: pick children 1
]
print parent


/*REXX program  demonstrates  an  evolutionary algorithm  (by using mutation).          */
parse arg  children  MR  seed .                  /*get optional arguments from the C.L. */
if children=='' | children=="," then children=10 /*# children produced each generation. */
if MR      =='' | MR      =="," then MR= "4%"    /*the character Mutation Rate each gen.*/
if right(MR,1)=='%'  then MR= strip(MR,,"%")/100 /*expressed as a percent?  Then adjust.*/
if seed\==''  then call random ,,seed            /*SEED allow the runs to be repeatable.*/
abc   = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '  ;     Labc= length(abc)
target= 'METHINKS IT IS LIKE A WEASEL' ;     Ltar= length(target)
parent= mutate( left('', Ltar), 1)               /*gen rand string,same length as target*/
say center('target string', Ltar, "─")    'children'        "mutationRate"
say target  center(children, 8)   center((MR*100/1)'%', 12);                      say
say center('new string'    ,Ltar, "─")    "closeness"       'generation'

       do gen=0  until  parent==target;                      close= fitness(parent)
       almost= parent
                        do  children;                        child= mutate(parent,MR)
                        _= fitness(child);                   if _<=close  then iterate
                        close= _;                            almost= child
                        say almost  right(close, 9)   right(gen, 10)
                        end   /*children*/
       parent= almost
       end   /*gen*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fitness: parse arg x; $=0;  do k=1 for Ltar; $= $+(substr(x,k,1)==substr(target,k,1)); end
         return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
mutate:  parse arg x,rate;  $=                   /*set  X  to 1st argument, RATE to 2nd.*/
                   do j=1  for Ltar;       r= random(1, 100000)  /*REXX's max for RANDOM*/
                   if .00001*r<=rate  then $= $  ||  substr(abc, r//Labc+1, 1)
                                      else $= $  ||  substr(x  , j        , 1)
                   end   /*j*/
         return $


func isOdd(n : int) -> int {
    n % 2 == 1
}

func isEven(n : int) -> int {
    n % 2 == 0
}


# Least signficant bit:
proc isOdd(i: int): bool = (i and 1) != 0
proc isEven(i: int): bool = (i and 1) == 0

# Modulo:
proc isOdd2(i: int): bool = (i mod 2) != 0
proc isEven2(i: int): bool = (i mod 2) == 0

# Bit Shifting:
proc isOdd3(n: int): bool = n != ((n shr 1) shl 1)
proc isEven3(n: int): bool = n == ((n shr 1) shl 1)

echo isEven(1)
echo isOdd2(5)


      DIM list(6)
      list() = -7, 1, 5, 2, -4, 3, 0
      PRINT "Equilibrium indices are " FNequilibrium(list())
      END

      DEF FNequilibrium(l())
      LOCAL i%, r, s, e$
      s = SUM(l())
      FOR i% = 0 TO DIM(l(),1)
        IF r = s - r - l(i%) THEN e$ += STR$(i%) + ","
        r += l(i%)
      NEXT
      = LEFT$(e$)


#include <stdio.h>
#include <stdlib.h>

int list[] = {-7, 1, 5, 2, -4, 3, 0};

int eq_idx(int *a, int len, int **ret)
{
	int i, sum, s, cnt;
	/* alloc long enough: if we can afford the original list,
	 * we should be able to afford to this.  Beats a potential
         * million realloc() calls.  Even if memory is a real concern,
         * there's no garantee the result is shorter than the input anyway */
        cnt = s = sum = 0;
	*ret = malloc(sizeof(int) * len);

	for (i = 0; i < len; i++)
                sum += a[i];

	for (i = 0; i < len; i++) {
		if (s * 2 + a[i] == sum) {
			(*ret)[cnt] = i;
                        cnt++;
                }
		s += a[i];
	}

        /* uncouraged way to use realloc since it can leak memory, for example */
	*ret = realloc(*ret, cnt * sizeof(int));

	return cnt;
}

int main()
{
	int i, cnt, *idx;
	cnt = eq_idx(list, sizeof(list) / sizeof(int), &idx);

	printf("Found:");
	for (i = 0; i < cnt; i++)
                printf(" %d", idx[i]);
	printf("\n");

	return 0;
}


program fib
args n
clear
qui set obs `n'
qui gen a=1
qui replace a=a[_n-1]+a[_n-2] in 3/l
end


program rcExceuteBrainF;

uses
     Crt;

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

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

begin

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

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

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

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

Const
  HelloWorldWiki = '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>'+
                   '---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.';

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

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

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


/*REXX program calculates the   "information entropy"   for  ~this~  REXX program.      */
numeric digits length( e() ) % 2   -  length(.)  /*use 1/2 of the decimal digits of  E. */
#= 0;   @.= 0;   $=;   $$=;   recs= sourceline() /*define some handy─dandy REXX vars.   */
            do m=1  for recs; $=$||sourceLine(m) /* [↓]  obtain program source and ──► $*/
            end   /*m*/                          /* [↑]  $ str won't have any meta chars*/
L=length($)                                      /*the byte length of this REXX program.*/
            do j=1  for L;  _= substr($, j, 1)   /*process each character in  $  string.*/
            if @._==0  then do;  #= # + 1        /*¿Character unique?  Bump char counter*/
                                 $$= $$ || _     /*add this character to the  $$  list. */
                            end
            @._= @._ + 1                         /*keep track of this character's count.*/
            end   /*j*/                          /* [↑]  characters are all 8─bit bytes.*/
sum= 0                                           /*calculate info entropy for each char.*/
            do i=1  for #;  _= substr($$, i, 1)  /*obtain a character from unique list. */
            sum= sum -  @._ / L * log2(@._ / L)  /*add {negatively} the char entropies. */
            end   /*i*/
say '    program length: '   L                   /*pgm length doesn't include meta chars*/
say 'program statements: '   recs                /*pgm statements are actually pgm lines*/
say ' unique characters: '   #;           say    /*characters are 8─bit bytes of the pgm*/
say 'The information entropy of this REXX program ──► '       format(sum,,12)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
e: e= 2.718281828459045235360287471352662497757247093699959574966967627724076630; return e
/*──────────────────────────────────────────────────────────────────────────────────────*/
log2: procedure;  parse arg x 1 ox;     ig= x>1.5;     ii= 0;         is= 1 - 2 * (ig\==1)
      numeric digits digits()+5;        call e   /*the precision of E must be≥digits(). */
        do  while  ig & ox>1.5 | \ig&ox<.5;       _= e;       do j=-1;   iz= ox * _ ** -is
        if j>=0 & (ig & iz<1 | \ig&iz>.5)  then leave;    _= _ * _;    izz= iz;  end /*j*/
        ox=izz;  ii=ii+is*2**j;  end /*while*/;   x= x * e** -ii -1;   z= 0;  _= -1;  p= z
          do k=1;   _= -_ * x;   z= z+_/k;        if z=p  then leave;  p= z;    end  /*k*/
        r= z + ii;  if arg()==2  then return r;   return r / log2(2,.)


def entropy(s)
  counts = s.each_char.tally
  size = s.size.to_f
  counts.values.reduce(0) do |entropy, count|
    freq = count / size
    entropy - freq * Math.log2(freq)
  end
end

s = File.read(__FILE__)
p entropy(s)


use std::fs::File;
use std::io::{Read, BufReader};

fn entropy<I: IntoIterator<Item = u8>>(iter: I) -> f32 {
    let mut histogram = [0u64; 256];
    let mut len = 0u64;

    for b in iter {
        histogram[b as usize] += 1;
        len += 1;
    }

    histogram
        .iter()
        .cloned()
        .filter(|&h| h > 0)
        .map(|h| h as f32 / len as f32)
        .map(|ratio| -ratio * ratio.log2())
        .sum()
}

fn main() {
    let name = std::env::args().nth(0).expect("Could not get program name.");
    let file = BufReader::new(File::open(name).expect("Could not read file."));
    println!("Entropy is {}.", entropy(file.bytes().flatten()));
}


for i = 0 to 100
   print " fctrI(";right$("00";str$(i),2); ") = "; fctrI(i)
   print " fctrR(";right$("00";str$(i),2); ") = "; fctrR(i)
next i
end

function fctrI(n)
fctrI = 1
 if n >1 then
  for i = 2 To n
    fctrI = fctrI * i
  next i
 end if
end function

function fctrR(n)
fctrR = 1
if n > 1 then fctrR = n * fctrR(n -1)
end function


fn factorial_recursive (n: u64) -> u64 {
    match n {
        0 => 1,
        _ => n * factorial_recursive(n-1)
    }
}

fn factorial_iterative(n: u64) -> u64 {
    (1..=n).product()
}

fn main () {
    for i in 1..10 {
        println!("{}", factorial_recursive(i))
    }
    for i in 1..10 {
        println!("{}", factorial_iterative(i))
    }
}


    getenv('HOME')
    getenv('PATH')
    getenv('USER')


:- module env_var.
:- interface.

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

:- implementation.
:- import_module maybe, string.

main(!IO) :-
    io.get_environment_var("HOME", MaybeValue, !IO),
    (
        MaybeValue = yes(Value),
        io.write_string("HOME is " ++ Value ++ "\n", !IO)
    ;
        MaybeValue = no,
        io.write_string("environment variable HOME not set\n", !IO)
    ).


MODULE EnvVars EXPORTS Main;

IMPORT IO, Env;

VAR
  k, v: TEXT;

BEGIN
  IO.Put(Env.Get("HOME") & "\n");

  FOR i := 0 TO Env.Count - 1 DO
    Env.GetNth(i, k, v);
    IO.Put(k & " = " & v & "\n")
  END
END EnvVars.


 Set X=$ZF(-1,"show logical")
 Set X=$ZF(-1,"show symbol")


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

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method sysEnvironment(vn = '') public static
  if vn.length > 0 then do
    envName = vn
    envValu = System.getenv(envName)
    if envValu = null then envValu = ''
    say envName '=' envValu
    end
  else do
    envVars = System.getenv()
    key = String
    loop key over envVars.keySet()
      envName = key
      envValu = String envVars.get(key)
      say envName '=' envValu
      end key
    end
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method sysProperties(vn = '') public static
  if vn.length > 0 then do
    propName = vn
    propValu = System.getProperty(propName)
    if propValu = null then propValu = ''
    say propName '=' propValu
    end
  else do
    sysProps = System.getProperties()
    key = String
    loop key over sysProps.keySet()
      propName = key
      propValu = sysProps.getProperty(key)
      say propName '=' propValu
      end key
    end
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
  parse arg ev pv .
  if ev = '' then ev = 'CLASSPATH'
  if pv = '' then pv = 'java.class.path'
  say '-'.left(80, '-').overlay(' Environment "'ev'" ', 5)
  sysEnvironment(ev)
  say '-'.left(80, '-').overlay(' Properties "'pv'" ', 5)
  sysProperties(pv)
  say
  say '-'.left(80, '-').overlay(' Environment ', 5)
  sysEnvironment()
  say '-'.left(80, '-').overlay(' Properties ', 5)
  sysProperties()
  say
  return


;; symbol to number
(defconstant +apple+ 0)
(defconstant +banana+ 1)
(defconstant +cherry+ 2)

;; number to symbol
(defun index-fruit (i)
  (aref #(+apple+ +banana+ +cherry+) i))


LDA 4 ;load from memory address 4
STP
NOP
NOP
byte 1


void main() {
    // Named enumeration (commonly used enum in D).
    // The underlying type is a 32 bit int.
    enum Fruits1 { apple, banana, cherry }

    // You can assign an enum to the general type, but not the opposite:
    int f1 = Fruits1.banana; // No error.
    // Fruits1 f2 = 1; // Error: cannot implicitly convert.

    // Anonymous enumeration, as in C, of type 32 bit int.
    enum { APPLE, BANANA, CHERRY }
    static assert(CHERRY == 2);

    // Named enumeration with specified values (int).
    enum Fruits2 { apple = 0, banana = 10, cherry = 20 }

    // Named enumeration, typed and with specified values.
    enum Fruits3 : ubyte { apple = 0, banana = 100, cherry = 200 }

    // Named enumeration, typed and with partially specified values.
    enum Test : ubyte { A = 2, B, C = 3 }
    static assert(Test.B == 3); // Uses the next ubyte, duplicated value.

    // This raises a compile-time error for overflow.
    // enum Fruits5 : ubyte { apple = 254, banana = 255, cherry }

    enum Component {
        none,
        red   = 2 ^^ 0,
        green = 2 ^^ 1,
        blue  = 2 ^^ 2
    }

    // Phobos BitFlags support all the most common operations on flags.
    // Some of the operations are shown below.
    import std.typecons: BitFlags;

    alias ComponentFlags = BitFlags!Component;
    immutable ComponentFlags flagsEmpty;

    // Value can be set with the | operator.
    immutable flagsRed = flagsEmpty | Component.red;

    immutable flagsGreen = ComponentFlags(Component.green);
    immutable flagsRedGreen = ComponentFlags(Component.red, Component.green);
    immutable flagsBlueGreen = ComponentFlags(Component.blue, Component.green);

    // Use the & operator between BitFlags for intersection.
    assert (flagsGreen == (flagsRedGreen & flagsBlueGreen));
}


const FMT=" %7.3f";

fcn ivp_euler(f,y,step,end_t){
   print(" Step %2d: ".fmt(step));
   foreach t in ([0..end_t,step]){
      if (t % 10 == 0) print(FMT.fmt(y));
      y += f(t,y) * step;
   }
   println();
}

fcn analytic{
   print("    Time: ");
   foreach t in  ([0..100,10]){ print(" %7g".fmt(t)) }
   print("\nAnalytic: ");
   foreach t in ([0..100,10]){ print(FMT.fmt(20.0 + 80.0 * (-0.07 * t).exp())) }
   println();
}

fcn cooling(_,temp){ return(-0.07 * (temp - 20)) }

analytic();
ivp_euler(cooling, 100.0, 2,  100);
ivp_euler(cooling, 100.0, 5,  100);
ivp_euler(cooling, 100.0, 10, 100);


10 LET d$="-0.07*(y-20)": LET y=100: LET a=0: LET b=100: LET s=10
20 LET t=a
30 IF t<=b THEN PRINT t;TAB 10;y: LET y=y+s*VAL d$: LET t=t+s: GO TO 30


import Data.List
import Data.List.Ordered

main :: IO ()
main = print $ head [(x0,x1,x2,x3,x4) |
                                        -- choose x0, x1, x2, x3
                                        -- so that 250 < x3 < x2 < x1 < x0
                                        x3 <- [1..250-1],
                                        x2 <- [1..x3-1],
                                        x1 <- [1..x2-1],
                                        x0 <- [1..x1-1],

                                        let p5Sum = x0^5 + x1^5 + x2^5 + x3^5,

                                        -- lazy evaluation of powers of 5
                                        let p5List = [i^5|i <- [1..]],

                                        -- is sum a power of 5 ?
                                        member p5Sum p5List,

                                        -- which power of 5 is sum ?
                                        let Just x4 = elemIndex p5Sum p5List ]


# Project : Evolutionary algorithm

target = "METHINKS IT IS LIKE A WEASEL"
parent = "IU RFSGJABGOLYWF XSMFXNIABKT"
num = 0
mutationrate = 0.5
children = len(target)
child = list(children)
while parent != target
        bestfitness = 0
        bestindex = 0
        for index = 1 to children
             child[index] = mutate(parent, mutationrate)
             fitness = fitness(target, child[index])
             if fitness > bestfitness
                bestfitness = fitness
                bestindex = index
             ok
        next
        if bestindex > 0
           parent = child[bestindex]
           num = num + 1
           see "" + num + ": " + parent + nl
        ok
end

func fitness(text, ref)
       f = 0
       for i = 1 to len(text)
            if substr(text, i, 1) = substr(ref, i, 1)
               f = f + 1
            ok
       next
       return (f / len(text))

func mutate(text, rate)
        rnd = randomf()
        if rate > rnd
           c = 63+random(27)
           if c = 64
              c = 32
           ok
           rnd2 = random(len(text))
           if rnd2 > 0
              text[rnd2] = char(c)
           ok
        ok
        return text

func randomf()
       decimals(10)
       str = "0."
       for i = 1 to 10
            nr = random(9)
            str = str + string(nr)
       next
       return number(str)


@target = "METHINKS IT IS LIKE A WEASEL"
Charset = [" ", *"A".."Z"]
COPIES = 100

def random_char; Charset.sample end

def fitness(candidate)
  sum = 0
  candidate.chars.zip(@target.chars) {|x,y| sum += (x[0].ord - y[0].ord).abs}
  100.0 * Math.exp(Float(sum) / -10.0)
end

def mutation_rate(candidate)
  1.0 - Math.exp( -(100.0 - fitness(candidate)) / 400.0)
end

def mutate(parent, rate)
  parent.each_char.collect {|ch| rand <= rate ? random_char : ch}.join
end

def log(iteration, rate, parent)
  puts "%4d %.2f %5.1f %s" % [iteration, rate, fitness(parent), parent]
end

iteration = 0
parent = Array.new(@target.length) {random_char}.join
prev = ""

while parent != @target
  iteration += 1
  rate = mutation_rate(parent)
  if prev != parent
    log(iteration, rate, parent)
    prev = parent
  end
  copies = [parent] + Array.new(COPIES) {mutate(parent, rate)}
  parent = copies.max_by {|c| fitness(c)}
end
log(iteration, rate, parent)


MODULE EvenOrOdd;
IMPORT
  S := SYSTEM,
  Out;
VAR
  x: INTEGER;
  s: SET;

BEGIN
  x := 10;Out.Int(x,0);
  IF ODD(x) THEN Out.String(" odd") ELSE Out.String(" even") END;
  Out.Ln;

  x := 11;s := S.VAL(SET,LONG(x));Out.Int(x,0);
  IF 0 IN s THEN Out.String(" odd") ELSE Out.String(" even") END;
  Out.Ln;

  x := 12;Out.Int(x,0);
  IF x MOD 2 # 0 THEN Out.String(" odd") ELSE Out.String(" even") END;
  Out.Ln
END EvenOrOdd.


a := Console->ReadString()->ToInt();
if(a % 2 = 0) {
  "even"->PrintLine();
}
else {
  "odd"->PrintLine();
};


using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    static IEnumerable<int> EquilibriumIndices(IEnumerable<int> sequence)
    {
        var left = 0;
        var right = sequence.Sum();
        var index = 0;
        foreach (var element in sequence)
        {
            right -= element;
            if (left == right)
            {
                yield return index;
            }
            left += element;
            index++;
        }
    }

    static void Main()
    {
        foreach (var index in EquilibriumIndices(new[] { -7, 1, 5, 2, -4, 3, 0 }))
        {
            Console.WriteLine(index);
        }
    }
}


#include <algorithm>
#include <iostream>
#include <numeric>
#include <vector>

template <typename T>
std::vector<size_t> equilibrium(T first, T last)
{
    typedef typename std::iterator_traits<T>::value_type value_t;

    value_t left  = 0;
    value_t right = std::accumulate(first, last, value_t(0));
    std::vector<size_t> result;

    for (size_t index = 0; first != last; ++first, ++index)
    {
        right -= *first;
        if (left == right)
        {
            result.push_back(index);
        }
        left += *first;
    }
    return result;
}

template <typename T>
void print(const T& value)
{
    std::cout << value << "\n";
}

int main()
{
    const int data[] = { -7, 1, 5, 2, -4, 3, 0 };

    std::vector<size_t> indices(equilibrium(data, data + 7));

    std::for_each(indices.begin(), indices.end(), print<size_t>);
}


void->int feedbackloop Fib {
    join roundrobin(0,1);
    body in->int filter {
        work pop 1 push 1 peek 2 { push(peek(0) + peek(1)); pop(); }
    };
    loop Identity<int>;
    split duplicate;
    enqueue(0);
    enqueue(1);
}


#!/usr/bin/perl

my %code = split ' ', <<'END';
  >  $ptr++
  <  $ptr--
  +  $memory[$ptr]++
  -  $memory[$ptr]--
  ,  $memory[$ptr]=ord(getc)
  .  print(chr($memory[$ptr]))
  [  while($memory[$ptr]){
  ]  }
END

my ($ptr, @memory) = 0;
eval join ';', map @code{ /./g }, <>;


procedure bfi(string pgm)
sequence jumptable = repeat(0,length(pgm)),
         loopstack = {},
         data = repeat(0,10)    -- size??
integer skip = 0, ch, loopstart, pc, dp
    --
    -- compile (pack/strip comments and link jumps)
    --
    for i=1 to length(pgm) do
        ch = pgm[i]
        switch ch do
            case '[': loopstack = append(loopstack,i-skip);
                      pgm[i-skip] = ch;
            case ']': loopstart = loopstack[$];
                      loopstack = loopstack[1..-2];
                      jumptable[i-skip] = loopstart;
                      jumptable[loopstart] = i-skip;
                      fallthrough
            case '+','-','<','>',',','.': pgm[i-skip] = ch;
            default: skip += 1
        end switch
    end for
    if length(loopstack) then ?9/0 end if
    pgm = pgm[1..-1-skip]

    --
    -- main execution loop
    --
    pc = 1
    dp = 1
    while pc<=length(pgm) do
        ch = pgm[pc]
        switch ch do
            case '>': dp += 1 if dp>length(data) then dp = 1 end if
            case '<': dp -= 1 if dp<1 then dp = length(data) end if
            case '+': data[dp] += 1
            case '-': data[dp] -= 1
            case ',': data[dp] = iff(platform()=JS?'?':getc(0))
            case '.': puts(1,data[dp])
            case '[': if data[dp]=0 then pc = jumptable[pc] end if
            case ']': if data[dp]!=0 then pc = jumptable[pc] end if
            default: ?9/0
        end switch
        pc += 1
    end while
end procedure

constant bf="++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<++.>---------.>------.<----.++++++++.>>+.>++.+++."
constant fb="++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<+++.>---.>------.++++++++.<--.>>+.>++.+++.,"

bfi(bf)
bfi(fb)


func entropy(s) {
    [0,
        s.chars.freq.values.map {|c|
            var f = c/s.len
            f * f.log2
        }...
    ]«-»
}

say entropy(File(__FILE__).open_r.slurp)


proc entropy {str} {
    set log2 [expr log(2)]
    foreach char [split $str ""] {dict incr counts $char}
    set entropy 0.0
    foreach count [dict values $counts] {
	set freq [expr {$count / double([string length $str])}]
	set entropy [expr {$entropy - $freq * log($freq)/$log2}]
    }
    return $entropy
}

puts [format "entropy = %.5f" [entropy [read [open [info script]]]]]


import os
import math

fn main() {
    println("Binary file entropy: ${entropy(os.args[0])?}")
}

fn entropy(file string) ?f64 {
    d := os.read_bytes(file)?

    mut f := [256]f64{}
    for b in d {
        f[b]++
    }
    mut hm := 0.0
    for c in f {
        if c > 0 {
            hm += c * math.log2(c)
        }
    }
    l := f64(d.len)
    return math.log2(l) - hm/l
}


import "os" for Process
import "io" for File

var args = Process.allArguments
var s = File.read(args[1]).trim()
var m = {}
for (c in s) {
    var d = m[c]
    m[c] = (d) ? d + 1 : 1
}
var hm = 0
for (k in m.keys) {
    var c = m[k]
    hm = hm + c * c.log2
}
var l = s.count
System.print(l.log2 - hm/l)


fac 4
where fac 0 = 1
      fac n = n * fac (n - 1)
?


class MAIN is

  -- recursive
  fact(a: INTI):INTI is
    if a < 1.inti then return 1.inti; end;
    return a * fact(a - 1.inti);
  end;

  -- iterative
  fact_iter(a:INTI):INTI is
    s ::= 1.inti;
    loop s := s * a.downto!(1.inti); end;
    return s;
  end;

  main is
    a :INTI := 10.inti;
    #OUT + fact(a) + " = " + fact_iter(a) + "\n";
  end;
end;


> (env "SHELL")
"/bin/zsh"
> (env "TERM")
"xterm"


ExpandEnvStrings $0 "%PATH%" ; Retrieve PATH and place it in builtin register 0.
ExpandEnvStrings $1 "%USERPROFILE%" ; Retrieve the user's profile location and place it in builtin register 1.
ExpandEnvStrings $2 "%USERNAME%" ; Retrieve the user's account name and place it in builtin register 2.


[[[NSProcessInfo processInfo] environment] objectForKey:@"HOME"]


{System.showInfo "This is where Mozart is installed: "#{OS.getEnv 'OZHOME'}}


type
	fruit = (apple, banana, cherry);
	ape = (gorilla = 0, chimpanzee = 1, orangutan = 5);


type TFruit = (Apple, Banana, Cherry);
type TApe = (Gorilla = 0, Chimpanzee = 1, Orangutan = 5);


def apple  { to value() { return 0 } }
def banana { to value() { return 1 } }
def cherry { to value() { return 2 } }


// Without explicit values
enumeration FruitsKind
	APPLE,
	BANANA,
	CHERRY
end

program EnumerationTest

	function main()
		whatFruitAmI(FruitsKind.CHERRY);
	end

	function whatFruitAmI(fruit FruitsKind)
		case (fruit)
			when(FruitsKind.APPLE)
				syslib.writestdout("You're an apple.");
			when(FruitsKind.BANANA)
				syslib.writestdout("You're a banana.");
			when(FruitsKind.CHERRY)
				syslib.writestdout("You're a cherry.");
			otherwise
				syslib.writestdout("I'm not sure what you are.");
		end
	end

end


fruits = [:apple, :banana, :cherry]
fruits = ~w(apple banana cherry)a                   # Above-mentioned different notation
val = :banana
Enum.member?(fruits, val)                           #=> true
val in fruits                                       #=> true


public class eulerSopConjecture
{

    static final int    MAX_NUMBER = 250;

    public static void main( String[] args )
    {
        boolean found = false;
        long[]  fifth = new long[ MAX_NUMBER ];

        for( int i = 1; i <= MAX_NUMBER; i ++ )
        {
            long i2 =  i * i;
            fifth[ i - 1 ] = i2 * i2 * i;
        } // for i

        for( int a = 0; a < MAX_NUMBER && ! found ; a ++ )
        {
            for( int b = a; b < MAX_NUMBER && ! found ; b ++ )
            {
                for( int c = b; c < MAX_NUMBER && ! found ; c ++ )
                {
                    for( int d = c; d < MAX_NUMBER && ! found ; d ++ )
                    {
                        long sum  = fifth[a] + fifth[b] + fifth[c] + fifth[d];
                        int  e = java.util.Arrays.binarySearch( fifth, sum );
                        found  = ( e >= 0 );
                        if( found )
                        {
                            // the value at e is a fifth power
                            System.out.print( (a+1) + "^5 + "
                                            + (b+1) + "^5 + "
                                            + (c+1) + "^5 + "
                                            + (d+1) + "^5 = "
                                            + (e+1) + "^5"
                                            );
                        } // if found;;
                    } // for d
                } // for c
            } // for b
        } // for a
    } // main

} // eulerSopConjecture


//! Author : Thibault Barbie
//!
//! A simple evolutionary algorithm written in Rust.

extern crate rand;

use rand::Rng;

fn main() {
    let target = "METHINKS IT IS LIKE A WEASEL";
    let copies = 100;
    let mutation_rate = 20; // 1/20 = 0.05 = 5%

    let mut rng = rand::weak_rng();

    // Generate first sentence, mutating each character
    let start = mutate(&mut rng, target, 1); // 1/1 = 1 = 100%

    println!("{}", target);
    println!("{}", start);

    evolve(&mut rng, target, start, copies, mutation_rate);
}

/// Evolution algorithm
///
/// Evolves `parent` to match `target`.  Returns the number of evolutions performed.
fn evolve<R: Rng>(
    rng: &mut R,
    target: &str,
    mut parent: String,
    copies: usize,
    mutation_rate: u32,
) -> usize {
    let mut counter = 0;
    let mut parent_fitness = target.len() + 1;

    loop {
        counter += 1;

        let (best_fitness, best_sentence) = (0..copies)
            .map(|_| {
                // Copy and mutate a new sentence.
                let sentence = mutate(rng, &parent, mutation_rate);
                // Find the fitness of the new mutation
                (fitness(target, &sentence), sentence)
            })
            .min_by_key(|&(f, _)| f) // find the closest mutation to the target
            .unwrap(); // fails if `copies == 0`

        // If the best mutation of this generation is better than `parent` then "the fittest
        // survives" and the next parent becomes the best of this generation.
        if best_fitness < parent_fitness {
            parent = best_sentence;
            parent_fitness = best_fitness;
            println!(
                "{} : generation {} with fitness {}",
                parent, counter, best_fitness
            );

            if best_fitness == 0 {
                return counter;
            }
        }
    }
}

/// Computes the fitness of a sentence against a target string, returning the number of
/// incorrect characters.
fn fitness(target: &str, sentence: &str) -> usize {
    sentence
        .chars()
        .zip(target.chars())
        .filter(|&(c1, c2)| c1 != c2)
        .count()
}

/// Mutation algorithm.
///
/// It mutates each character of a string, according to a `mutation_rate`.
fn mutate<R: Rng>(rng: &mut R, sentence: &str, mutation_rate: u32) -> String {
    let maybe_mutate = |c| {
        if rng.gen_weighted_bool(mutation_rate) {
            random_char(rng)
        } else {
            c
        }
    };
    sentence.chars().map(maybe_mutate).collect()
}

/// Generates a random letter or space.
fn random_char<R: Rng>(rng: &mut R) -> char {
    // Returns a value in the range [A, Z] + an extra slot for the space character.  (The `u8`
    // values could be cast to larger integers for a better chance of the RNG hitting the proper
    // range).
    match rng.gen_range(b'A', b'Z' + 2) {
        c if c == b'Z' + 1 => ' ', // the `char` after 'Z'
        c => c as char,
    }
}