10 GO SUB 1000
20 LET e=LEN p$
30 LET a$=p$(ip)
40 IF a$=">" THEN LET dp=dp+1
50 IF a$="<" THEN LET dp=dp-1
60 IF a$="+" THEN LET d(dp)=d(dp)+1
70 IF a$="-" THEN LET d(dp)=d(dp)-1
80 IF a$="." THEN PRINT CHR$ d(dp);
90 IF a$="," THEN INPUT d(dp)
100 IF a$="[" THEN GO SUB 500
110 IF a$="]" THEN LET bp=bp-1: IF d(dp)<>0 THEN LET ip=b(bp)-1
120 LET ip=ip+1
130 IF ip>e THEN PRINT "eof": STOP
140 GO TO 30

499 REM match close
500 LET bc=1: REM bracket counter
510 FOR x=ip+1 TO e
520 IF p$(x)="[" THEN LET bc=bc+1
530 IF p$(x)="]" THEN LET bc=bc-1
540 IF bc=0 THEN LET b(bp)=ip: LET be=x: LET x=e: REM bc will be 0 once all the subnests have been counted over
550 IF bc=0 AND d(dp)=0 THEN LET ip=be: LET bp=bp-1
560 NEXT x
570 LET bp=bp+1
580 RETURN

999 REM initialisation
1000 DIM d(100): REM data stack
1010 LET dp=1: REM data pointer
1020 LET ip=1: REM instruction pointer
1030 DIM b(30): REM bracket stack
1040 LET bp=1: REM bracket pointer
1050 LET p$="++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>+++++.": REM program, marginally modified from Wikipedia; outputs CHR$ 13 at the end instead of CHR$ 10 as ZX Spectrum Basic handles the carriage return better than the line feed
1060 RETURN


Dim lookupTable(170), returnTable(170), currentPosition, input
currentPosition = 0

Do While True
	input = InputBox("Please type a number (-1 to quit):")
	MsgBox "The factorial of " & input & " is " & factorial(CDbl(input))
Loop

Function factorial (x)
	If x = -1 Then
		WScript.Quit 0
	End If
	Dim temp
	temp = lookup(x)
	If x <= 1 Then
		factorial = 1
	ElseIf temp <> 0 Then
		factorial = temp
	Else
		temp = factorial(x - 1) * x
		store x, temp
		factorial = temp
	End If
End Function

Function lookup (x)
	Dim i
	For i = 0 To currentPosition - 1
		If lookupTable(i) = x Then
			lookup = returnTable(i)
			Exit Function
		End If
	Next
	lookup = 0
End Function

Function store (x, y)
	lookupTable(currentPosition) = x
	returnTable(currentPosition) = y
	currentPosition = currentPosition + 1
End Function


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


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


define("PI", 3.14159265358);
define("MSG", "Hello World");


*process source attributes xref;
 constants: Proc Options(main);
 Dcl three Bin Fixed(15) Value(3);
 Put Skip List(1/three);
 Put Skip List(1/3);
 End;


#i_Const1 = 11
#i_Const2 = 3.1415
#i_Const3 = "A'm a string"


function to(n, b)
    local BASE = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    if n == 0 then
        return "0"
    end

    local ss = ""
    while n > 0 do
        local idx = (n % b) + 1
        n = math.floor(n / b)
        ss = ss .. BASE:sub(idx, idx)
    end
    return string.reverse(ss)
end

function isEsthetic(n, b)
    function uabs(a, b)
        if a < b then
            return b - a
        end
        return a - b
    end

    if n == 0 then
        return false
    end
    local i = n % b
    n = math.floor(n / b)
    while n > 0 do
        local j = n % b
        if uabs(i, j) ~= 1 then
            return false
        end
        n = math.floor(n / b)
        i = j
    end
    return true
end

function listEsths(n, n2, m, m2, perLine, all)
    local esths = {}
    function dfs(n, m, i)
        if i >= n and i <= m then
            table.insert(esths, i)
        end
        if i == 0 or i > m then
            return
        end
        local d = i % 10
        local i1 = 10 * i + d - 1
        local i2 = i1 + 2
        if d == 0 then
            dfs(n, m, i2)
        elseif d == 9 then
            dfs(n, m, i1)
        else
            dfs(n, m, i1)
            dfs(n, m, i2)
        end
    end

    for i=0,9 do
        dfs(n2, m2, i)
    end
    local le = #esths
    print(string.format("Base 10: %s esthetic numbers between %s and %s:", le, math.floor(n), math.floor(m)))
    if all then
        for c,esth in pairs(esths) do
            io.write(esth.." ")
            if c % perLine == 0 then
                print()
            end
        end
        print()
    else
        for i=1,perLine do
            io.write(esths[i] .. " ")
        end
        print("\n............")
        for i = le - perLine + 1, le do
            io.write(esths[i] .. " ")
        end
        print()
    end
    print()
end

for b=2,16 do
    print(string.format("Base %d: %dth to %dth esthetic numbers:", b, 4 * b, 6 * b))
    local n = 1
    local c = 0
    while c < 6 * b do
        if isEsthetic(n, b) then
            c = c + 1
            if c >= 4 * b then
                io.write(to(n, b).." ")
            end
        end
        n = n + 1
    end
    print()
end
print()

-- the following all use the obvious range limitations for the numbers in question
listEsths(1000, 1010, 9999, 9898, 16, true)
listEsths(1e8, 101010101, 13 * 1e7, 123456789, 9, true)
listEsths(1e11, 101010101010, 13 * 1e10, 123456789898, 7, false)
listEsths(1e14, 101010101010101, 13 * 1e13, 123456789898989, 5, false)
listEsths(1e17, 101010101010101010, 13 * 1e16, 123456789898989898, 4, false)


define range = (1 ..^ 250)

var p5 = Hash()
var sum2 = Hash()

for i in (range) {
    p5{i**5} = i
    for j in (range) {
        sum2{i**5 + j**5} = [i, j]
    }
}

var sk = sum2.keys.map{ Num(_) }.sort

for p in (p5.keys.map{ Num(_) }.sort) {

    var s = sk.first {|s|
        p > s && sum2.exists(p-s)
    } \\ next

    var t = (sum2{s} + sum2{p-s} -> map{|n| "#{n}⁵" }.join(' + '))
    say "#{t} = #{p5{p}}⁵"
    break
}


extension BinaryInteger {
  @inlinable
  public func power(_ n: Self) -> Self {
    return stride(from: 0, to: n, by: 1).lazy.map({_ in self }).reduce(1, *)
  }
}

func sumOfPowers(maxN: Int = 250) -> (Int, Int, Int, Int, Int) {
  let pow5 = (0..<maxN).map({ $0.power(5) })
  let pow5ToN = {n in pow5.firstIndex(of: n)}

  for x0 in 1..<maxN {
    for x1 in 1..<x0 {
      for x2 in 1..<x1 {
        for x3 in 1..<x2 {
          let powSum = pow5[x0] + pow5[x1] + pow5[x2] + pow5[x3]

          if let idx = pow5ToN(powSum) {
            return (x0, x1, x2, x3, idx)
          }
        }
      }
    }
  }

  fatalError("Did not find solution")
}

let (x0, x1, x2, x3, y) = sumOfPowers()

print("\(x0)^5 + \(x1)^5 + \(x2)^5 \(x3)^5 = \(y)^5")


fun even n =
  n mod 2 = 0;

fun odd n =
  n mod 2 <> 0;

(* bitwise and *)

type werd = Word.word;

fun evenbitw(w: werd) =
  Word.andb(w, 0w2) = 0w0;

fun oddbitw(w: werd) =
  Word.andb(w, 0w2) <> 0w0;


mata
function iseven(n) {
	return(mod(n,2)==0)
}

function isodd(n) {
	return(mod(n,2)==1)
}
end


func isEven(n:Int) -> Bool {

    // Bitwise check
    if (n & 1 != 0) {
        return false
    }

    // Mod check
    if (n % 2 != 0) {
        return false
    }
    return true
}


def eq_indices(list)
  list.each_index.select do |i|
    list[0...i].sum == list[i+1..-1].sum
  end
end


extern crate num;

use num::traits::Zero;

fn equilibrium_indices(v: &[i32]) -> Vec<usize> {
    let mut right = v.iter().sum();
    let mut left = i32::zero();

    v.iter().enumerate().fold(vec![], |mut out, (i, &el)| {
        right -= el;
        if left == right {
            out.push(i);
        }
        left += el;

        out
    })
}

fn main() {
    let v = [-7i32, 1, 5, 2, -4, 3, 0];
    let indices = equilibrium_indices(&v);
    println!("Equilibrium indices for {:?} are: {:?}", v, indices);
}


 def getEquilibriumIndex(A: Array[Int]): Int = {
      val bigA: Array[BigInt] = A.map(BigInt(_))
      val partialSums: Array[BigInt] = bigA.scanLeft(BigInt(0))(_+_).tail
      def lSum(i: Int): BigInt = if (i == 0) 0 else partialSums(i - 1)
      def rSum(i: Int): BigInt = partialSums.last - partialSums(i)
      def isRandLSumEqual(i: Int): Boolean = lSum(i) == rSum(i)
      (0 until partialSums.length).find(isRandLSumEqual).getOrElse(-1)
    }


BEGIN

INTEGER FUNCTION HALF(I);
INTEGER I;
BEGIN
  HALF := I / 2;
END;

INTEGER FUNCTION DOUBLE(I);
INTEGER I;
BEGIN
  DOUBLE := I + I;
END;

% RETURN 1 IF EVEN, OTHERWISE 0 %
INTEGER FUNCTION EVEN(I);
INTEGER I;
BEGIN
  EVEN := 1 - (I - 2 * (I / 2));
END;

% RETURN I * J AND OPTIONALLY SHOW COMPUTATIONAL STEPS %
INTEGER FUNCTION ETHIOPIAN(I, J, SHOW);
INTEGER I, J, SHOW;
BEGIN
  INTEGER P, YES;
  YES := 1;
  P := 0;
  WHILE I >= 1 DO
    BEGIN
      IF EVEN(I) = YES THEN
        BEGIN
          IF SHOW = YES THEN WRITE(I,"  ----", J);
        END
      ELSE
        BEGIN
          IF SHOW = YES THEN WRITE(I,J);
          P := P + J;
        END;
      I := HALF(I);
      J := DOUBLE(J);
    END;
  IF SHOW = YES THEN WRITE("     =");
  ETHIOPIAN := P;
END;

% EXERCISE THE FUNCTION %
INTEGER YES;
YES := 1;
WRITE(ETHIOPIAN(17,34,YES));

END


begin
    % returns half of a %
    integer procedure halve  ( integer value a ) ; a div 2;
    % returns a doubled %
    integer procedure double ( integer value a ) ; a * 2;
    % returns true if a is even, false otherwise %
    logical procedure even   ( integer value a ) ; not odd( a );
    % returns the product of a and b using ethopian multiplication %
    % rather than keep a table of the intermediate results,        %
    % we examine then as they are generated                        %
    integer procedure ethopianMultiplication ( integer value a, b ) ;
    begin
        integer v, r, accumulator;
        v           := a;
        r           := b;
        accumulator := 0;
        i_w := 4; s_w := 0; % set output formatting %
        while begin
            write( v );
            if even( v ) then writeon( "    ---" )
            else begin
                accumulator := accumulator + r;
                writeon( "   ", r );
            end;
            v := halve( v );
            r := double( r );
            v > 0
        end do begin end;
        write( "      =====" );
        accumulator
    end ethopianMultiplication ;
    % task test case %
    begin
        integer m;
        m := ethopianMultiplication( 17, 34 );
        write( "       ", m )
    end
end.


                               0000  0000     1 .entry	main,0
                            7E 7CFD  0002     2 	clro	-(sp)			;result buffer
                            5E   DD  0005     3 	pushl	sp			;pointer to buffer
                            10   DD  0007     4 	pushl	#16			;descriptor: len of buffer
                       5B   5E   D0  0009     5 	movl	sp, r11			;-> descriptor
                                     000C     6
                       7E   01   7D  000C     7 	movq	#1, -(sp)		;init 0,1
                                     000F     8 loop:
               7E   6E   04 AE   C1  000F     9 	addl3	4(sp), (sp), -(sp)	;next element on stack
                            17   1D  0014    10 	bvs	ret			;vs - overflow set, exit
                                     0016    11
                            5B   DD  0016    12 	pushl	r11			;-> descriptor by ref
                         04 AE   DF  0018    13 	pushal	4(sp)			;-> fib on stack by ref
              00000000'GF   02   FB  001B    14 	calls	#2, g^ots$cvt_l_ti	;convert integer to string
                            5B   DD  0022    15 	pushl	r11			;
              00000000'GF   01   FB  0024    16 	calls	#1, g^lib$put_output	;show result
                            E2   11  002B    17 	brb	loop
                                     002D    18 ret:
                                 04  002D    19 	ret
                                     002E    20 .end	main
$ run fib
...
        14930352
        24157817
        39088169
        63245986
       102334155
       165580141
       267914296
       433494437
       701408733
      1134903170
      1836311903
$


module main;

  function automatic [7:0] factorial;
    input [7:0] i_Num;
    begin
      if (i_Num == 1)
        factorial = 1;
      else
        factorial = i_Num * factorial(i_Num-1);
    end
  endfunction

  initial
    begin
      $display("Factorial of 1 = %d", factorial(1));
      $display("Factorial of 2 = %d", factorial(2));
      $display("Factorial of 3 = %d", factorial(3));
      $display("Factorial of 4 = %d", factorial(4));
      $display("Factorial of 5 = %d", factorial(5));
    end
endmodule


LIBRARY ieee;
USE ieee.std_logic_1164.ALL;
USE ieee.numeric_std.ALL;

ENTITY Factorial IS
	GENERIC (
			Nbin : INTEGER := 3 ; -- number of bit to input number
			Nbou : INTEGER := 13) ; -- number of bit to output factorial

	PORT (
		clk : IN STD_LOGIC ; -- clock of circuit
		sr  : IN STD_LOGIC_VECTOR(1 DOWNTO 0); -- set and reset
		N   : IN STD_LOGIC_VECTOR(Nbin-1 DOWNTO 0) ; -- max number
	    Fn  : OUT STD_LOGIC_VECTOR(Nbou-1 DOWNTO 0)); -- factorial of "n"

END Factorial ;

ARCHITECTURE Behavior OF Factorial IS
---------------------- Program Multiplication --------------------------------
	FUNCTION Mult ( CONSTANT MFa : IN UNSIGNED ;
					CONSTANT MI   : IN UNSIGNED ) RETURN UNSIGNED IS
	VARIABLE Z : UNSIGNED(MFa'RANGE) ;
	VARIABLE U : UNSIGNED(MI'RANGE) ;
	BEGIN
	Z := TO_UNSIGNED(0, MFa'LENGTH) ; -- to obtain the multiplication
	U := MI ; -- regressive counter
		LOOP
			Z := Z + MFa ; -- make multiplication
			U := U - 1 ;
			EXIT WHEN U = 0 ;
		END LOOP ;
		RETURN Z ;
	END Mult ;
-------------------Program Factorial ---------------------------------------
	FUNCTION Fact (CONSTANT Nx : IN NATURAL ) RETURN UNSIGNED IS
	VARIABLE C  : NATURAL RANGE 0 TO 2**Nbin-1 ;
	VARIABLE I  : UNSIGNED(Nbin-1 DOWNTO 0) ;
	VARIABLE Fa : UNSIGNED(Nbou-1 DOWNTO 0) ;
	BEGIN
		C := 0 ; -- counter
		I :=  TO_UNSIGNED(1, Nbin) ;
		Fa := TO_UNSIGNED(1, Nbou) ;
		LOOP
			EXIT WHEN C = Nx ; -- end loop
			C := C + 1 ;  -- progressive couter
			Fa := Mult (Fa , I ); -- call function to make a multiplication
			I := I + 1 ; --
		END LOOP ;
		RETURN Fa ;
	END Fact ;
--------------------- Program TO Call Factorial Function ------------------------------------------------------
	TYPE Table IS ARRAY (0 TO 2**Nbin-1) OF UNSIGNED(Nbou-1 DOWNTO 0) ;
	FUNCTION Call_Fact RETURN Table IS
	VARIABLE Fc : Table ;
	BEGIN
		FOR c IN 0 TO 2**Nbin-1 LOOP
			Fc(c) := Fact(c) ;
		END LOOP ;
		RETURN Fc ;
	END FUNCTION Call_Fact;

	CONSTANT Result : Table := Call_Fact ;
 ------------------------------------------------------------------------------------------------------------
SIGNAL Nin : STD_LOGIC_VECTOR(N'RANGE) ;
BEGIN    -- start of architecture

Nin <= N               WHEN RISING_EDGE(clk) AND sr = "10" ELSE
       (OTHERS => '0') WHEN RISING_EDGE(clk) AND sr = "01" ELSE
	   UNAFFECTED;

Fn <= STD_LOGIC_VECTOR(Result(TO_INTEGER(UNSIGNED(Nin)))) WHEN RISING_EDGE(clk) ;

END Behavior ;


>>> s = "Hello"
>>> s[0] = "h"

Traceback (most recent call last):
  File "<pyshell#1>", line 1, in <module>
    s[0] = "h"
TypeError: 'str' object does not support item assignment


(struct coordinate (x y)) ; immutable struct


constant $pi = 3.14159;
constant $msg = "Hello World";

constant @arr = (1, 2, 3, 4, 5);


/*REXX program  emulates  immutable variables  (as a post-computational check).         */
call immutable '$=1'                             /* ◄─── assigns an immutable variable. */
call immutable '   pi = 3.14159'                 /* ◄───    "     "     "         "     */
call immutable 'radius= 2*pi/4 '                 /* ◄───    "     "     "         "     */
call immutable '     r=13/2    '                 /* ◄───    "     "     "         "     */
call immutable '     d=0002 * r'                 /* ◄───    "     "     "         "     */
call immutable ' f.1  = 12**2  '                 /* ◄───    "     "     "         "     */

say '       $ ='  $                              /*show the variable, just to be sure.  */
say '      pi ='  pi                             /*  "   "      "       "   "  "   "    */
say '  radius ='  radius                         /*  "   "      "       "   "  "   "    */
say '       r ='  r                              /*  "   "      "       "   "  "   "    */
say '       d ='  d                              /*  "   "      "       "   "  "   "    */

                    do radius=10  to  -10  by -1 /*perform some faux important stuff.   */
                    circum=$*pi*2*radius         /*some kind of impressive calculation. */
                    end   /*k*/                  /* [↑]  that should do it, by gum.     */
call immutable                                   /* ◄═══ see if immutable variables OK. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
immutable: if symbol('immutable.0')=='LIT'  then immutable.0= /*1st time see immutable? */
           if arg()==0 then do                                /* [↓]  chk all immutables*/
                              do __=1  for words(immutable.0); _=word(immutable.0,__)
                              if value(_)==value('IMMUTABLE.!'_)  then iterate   /*same?*/
                              call ser -12, 'immutable variable  ' _ "  compromised."
                              end   /*__*/                  /* [↑]  Error?  ERRmsg, exit*/
                            return 0                        /*return and indicate  A-OK.*/
                            end                             /* [↓] immutable must have =*/
           if pos('=',arg(1))==0  then call ser -4, "no equal sign in assignment:"  arg(1)
           parse arg _ '=' __;         upper _;    _=space(_)    /*purify variable name.*/
           if symbol("_")=='BAD'  then call ser -8,_ "isn't a valid variable symbol."
           immutable.0=immutable.0 _                        /*add immutable var to list.*/
           interpret '__='__;     call value _,__           /*assign value to a variable*/
           call value 'IMMUTABLE.!'_,__                     /*assign value to bkup var. */
           return words(immutable.0)                        /*return number immutables. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ser:       say;     say '***error***'  arg(2);     say;     exit arg(1)     /*error msg.*/


ClearAll[EstheticNumbersRangeHelper, EstheticNumbersRange]
EstheticNumbersRangeHelper[power_, mima : {mi_, max_}, b_ : 10] := Module[{steps, cands},
  steps = Tuples[{-1, 1}, power - 1];
  steps = Accumulate[Prepend[#, 0]] & /@ steps;
  cands = Table[Select[# + ConstantArray[s, power] & /@ steps, AllTrue[Between[{0, b - 1}]]], {s, 1, b - 1}];
  cands //= Catenate;
  cands //= Map[FromDigits[#, b] &];
  cands = Select[cands, Between[mima]];
  BaseForm[#, b] & /@ cands
 ]
EstheticNumbersRange[{min_, max_}, b_ : 10] := Module[{mi, ma},
  {mi, ma} = Log[b, {min, max}];
  mi //= Ceiling;
  ma //= Ceiling;
  ma = Max[ma, 1];
  mi = Max[mi, 1];
  Catenate[EstheticNumbersRangeHelper[#, {min, max}, b] & /@ Range[mi, ma]]
 ]
Table[{b, EstheticNumbersRange[{1, If[b == 2, 100000, If[b == 3, 100000, b^4]]}, b][[4 b ;; 6 b]]}, {b, 2, 16}] // Grid
EstheticNumbersRange[{1000, 9999}]
EstheticNumbersRange[{10^8, 1.3 10^8}]


import strformat

func isEsthetic(n, b: int64): bool =
  if n == 0: return false
  var i = n mod b
  var n = n div b
  while n > 0:
    let j = n mod b
    if abs(i - j) != 1:
      return false
    n = n div b
    i = j
  result = true

proc listEsths(n1, n2, m1, m2: int64; perLine: int; all: bool) =
  var esths: seq[int64]

  func dfs(n, m, i: int64) =
    if i in n..m: esths.add i
    if i == 0 or i > m: return
    let d = i mod 10
    let i1 = i * 10 + d - 1
    let i2 = i1 + 2
    case d
    of 0:
      dfs(n, m, i2)
    of 9:
      dfs(n, m, i1)
    else:
      dfs(n, m, i1)
      dfs(n, m, i2)

  for i in 0..9:
    dfs(n2, m2, i)

  echo &"Base 10: {esths.len} esthetic numbers between {n1} and {m1}:"
  if all:
    for i, esth in esths:
      stdout.write esth
      stdout.write if (i + 1) mod perLine == 0: '\n' else: ' '
    echo()
  else:
    for i in 0..<perLine:
      stdout.write esths[i], ' '
    echo "\n............"
    for i in esths.len - perLine .. esths.high:
      stdout.write esths[i], ' '
    echo()
  echo()

proc toBase(n, b: int64): string =
  const Digits = ['0', '1', '2', '3', '4', '5', '6', '7',
                  '8', '9', 'a', 'b', 'c', 'd', 'e', 'f']

  if n == 0: return "0"
  var n = n
  while n > 0:
    result.add Digits[n mod b]
    n = n div b
  for i in 0..<(result.len div 2):
    swap result[i], result[result.high - i]

for b in 2..16:
  echo &"Base {b}: {4 * b}th to {6 * b}th esthetic numbers:"
  var n = 1i64
  var c = 0i64
  while c < 6 * b:
    if n.isEsthetic(b):
      inc c
      if c >= 4 * b: stdout.write n.toBase(b), ' '
    inc n
  echo '\n'

# The following all use the obvious range limitations for the numbers in question.
listEsths(1000, 1010, 9999, 9898, 16, true)
listEsths(100_000_000, 101_010_101, 130_000_000, 123_456_789, 9, true)
listEsths(100_000_000_000, 101_010_101_010, 130_000_000_000, 123_456_789_898, 7, false)
listEsths(100_000_000_000_000, 101_010_101_010_101, 130_000_000_000, 123_456_789_898_989, 5, false)
listEsths(100_000_000_000_000_000, 101_010_101_010_101_010, 130_000_000_000_000_000, 123_456_789_898_989_898, 4, false)


proc doit {{badx 250} {complete 0}} {
    ## NB: $badx is exclusive upper limit, and also limits y!
    for {set y 1} {$y < $badx} {incr y} {
        set s [expr {$y ** 5}]
        set r5($s) $y           ;# fifth roots of valid sums
    }
    for {set a 1} {$a < $badx} {incr a} {
        set suma [expr {$a ** 5}]
        for {set b 1} {$b <= $a} {incr b} {
            set sumb [expr {$suma + ($b ** 5)}]
            for {set c 1} {$c <= $b} {incr c} {
                set sumc [expr {$sumb + ($c ** 5)}]
                for {set d 1} {$d <= $c} {incr d} {
                    set sumd [expr {$sumc + ($d ** 5)}]
                    if {[info exists r5($sumd)]} {
                        set e $r5($sumd)
                        puts "$e^5 = $a^5 + $b^5 + $c^5 + $d^5"
                        if {!$complete} {
                            return
                        }
                    }
                }
            }
        }
    }
    puts "search complete (x < $badx)"
}
doit


MAX=250
pow5=()
for (( i=1; i<MAX; ++i )); do
  pow5[i]=$(( i*i*i*i*i ))
done
for (( a=1; a<MAX; ++a )); do
  for (( b=a+1; b<MAX; ++b )); do
    for (( c=b+1; c<MAX; ++c )); do
      for (( d=c+1; d<MAX; ++d )); do
        (( sum=pow5[a]+pow5[b]+pow5[c]+pow5[d] ))
        (( low=d+3 ))
        (( high=MAX ))
        while (( low <= high )); do
          (( guess=(low+high)/2 ))
          if (( pow5[guess]  == sum )); then
            printf 'Found example: %d⁵+%d⁵+%d⁵+%d⁵=%d⁵\n' "$a" "$b" "$c" "$d" "$guess"
            exit 0
          elif (( pow5[guess] < sum )); then
            (( low=guess+1 ))
          else
            (( high=guess-1 ))
          fi
        done
      done
    done
  done
done
printf 'No examples found.\n'
exit 1


n : 23

 if n bit 0
    'n is odd' []
 else
    'n is even' []


package require Tcl 8.5

# Bitwise test is the most efficient
proc tcl::mathfunc::isOdd x  { expr {$x & 1} }
proc tcl::mathfunc::isEven x { expr {!($x & 1)} }

puts " # O E"
puts 24:[expr isOdd(24)],[expr isEven(24)]
puts 49:[expr isOdd(49)],[expr isEven(49)]


$ include "seed7_05.s7i";

const array integer: numList is [] (-7, 1, 5, 2, -4, 3, 0);

const func array integer: equilibriumIndex (in array integer: elements) is func
  result
    var array integer: indexList is 0 times 0;
  local
    var integer: element is 0;
    var integer: index is 0;
    var integer: sum is 0;
    var integer: subSum is 0;
    var integer: count is 0;
  begin
    indexList := length(elements) times 0;
    for element range elements do
      sum +:= element;
    end for;
    for element key index range elements do
      if 2 * subSum + element = sum then
        incr(count);
        indexList[count] := index;
      end if;
      subSum +:= element;
    end for;
    indexList := indexList[.. count];
  end func;

const proc: main is func
  local
    var array integer: indexList is 0 times 0;
    var integer: element is 0;
  begin
    indexList := equilibriumIndex(numList);
    write("Found:");
    for element range indexList do
      write(" " <& element);
    end for;
    writeln;
  end func;


func eq_index(nums) {
    var (i, sum, sums) = (0, 0, Hash.new);
    nums.each { |n|
        sums{2*sum + n} := [] -> append(i++);
        sum += n;
    }
    sums{sum} \\ [];
}


extension Collection where Element: Numeric {
  func equilibriumIndexes() -> [Index] {
    guard !isEmpty else {
      return []
    }

    let sumAll = reduce(0, +)
    var ret = [Index]()
    var sumLeft: Element = 0
    var sumRight: Element

    for i in indices {
      sumRight = sumAll - sumLeft - self[i]

      if sumLeft == sumRight {
        ret.append(i)
      }

      sumLeft += self[i]
    }

    return ret
  }
}

let arr = [-7, 1, 5, 2, -4, 3, 0]

print("Equilibrium indexes of \(arr): \(arr.equilibriumIndexes())")


on run
    {ethMult(17, 34), ethMult("Rhind", 9)}

    --> {578, "RhindRhindRhindRhindRhindRhindRhindRhind"}
end run

-- Int -> Int -> Int
-- or
-- Int -> String -> String
on ethMult(m, n)
    script fns
        property identity : missing value
        property plus : missing value

        on half(n) -- 1. half an integer (div 2)
            n div 2
        end half

        on double(n) -- 2. double (add to self)
            plus(n, n)
        end double

        on isEven(n) -- 3. is n even ? (mod 2 > 0)
            (n mod 2) > 0
        end isEven

        on chooseFns(c)
            if c is string then
                set identity of fns to ""
                set plus of fns to plusString of fns
            else
                set identity of fns to 0
                set plus of fns to plusInteger of fns
            end if
        end chooseFns

        on plusInteger(a, b)
            a + b
        end plusInteger

        on plusString(a, b)
            a & b
        end plusString
    end script

    chooseFns(class of m) of fns

    -- MAIN PROCESS OF CALCULATION

    set o to identity of fns
    if n < 1 then return o

    repeat while (n > 1)
        if isEven(n) of fns then -- 3. is n even ? (mod 2 > 0)
            set o to plus(o, m) of fns
        end if
        set n to half(n) of fns -- 1. half an integer (div 2)
        set m to double(m) of fns -- 2. double  (add to self)
    end repeat
    return plus(o, m) of fns
end ethMult


Public Function Fib(ByVal n As Integer) As Variant
    Dim fib0 As Variant, fib1 As Variant, sum As Variant
    Dim i As Integer
    fib0 = 0
    fib1 = 1
    For i = 1 To n
        sum = fib0 + fib1
        fib0 = fib1
        fib1 = sum
    Next i
    Fib = fib0
End Function


function! Factorial(n)
  if a:n < 2
    return 1
  else
    return a:n * Factorial(a:n-1)
  endif
endfunction


Option Explicit

Sub Main()
    Dim i As Variant
    For i = 1 To 27
        Debug.Print "Factorial(" & i & ")= , recursive : " & Format$(FactRec(i), "#,###") & " - iterative : " & Format$(FactIter(i), "#,####")
    Next
End Sub 'Main

Private Function FactRec(n As Variant) As Variant
    n = CDec(n)
    If n = 1 Then
        FactRec = 1#
    Else
        FactRec = n * FactRec(n - 1)
    End If
End Function 'FactRec

Private Function FactIter(n As Variant)
    Dim i As Variant, f As Variant
    f = 1#
    For i = 1# To CDec(n)
        f = f * i
    Next i
    FactIter = f
End Function 'FactIter


# Project : Enforced immutability

x = 10
assert( x = 10)
assert( x = 100 )


msg = "Hello World"
msg << "!"
puts msg                #=> Hello World!

puts msg.frozen?        #=> false
msg.freeze
puts msg.frozen?        #=> true
begin
  msg << "!"
rescue => e
  p e                   #=> #<RuntimeError: can't modify frozen String>
end

puts msg                #=> Hello World!
msg2 = msg

# The object is frozen, not the variable.
msg = "hello world"     # A new object was assigned to the variable.

puts msg.frozen?        #=> false
puts msg2.frozen?       #=> true


val pi = 3.14159
val msg = "Hello World"


(define-syntax define-constant
  (syntax-rules ()
    ((_ id v)
     (begin
       (define _id v)
       (define-syntax id
         (make-variable-transformer
          (lambda (stx)
            (syntax-case stx (set!)
              ((set! id _)
               (raise
                (syntax-violation
                 'set! "Cannot redefine constant" stx #'id)))
              ((id . args) #'(_id . args))
              (id #'_id)))))))))


const integer: foo is 42;
const string: bar is "bar";
const blahtype: blah is blahvalue;


define PI = 3.14159;            # compile-time defined constant
const MSG = "Hello world!";     # run-time defined constant


program Esthetic;
{$IFDEF FPC}
  {$MODE DELPHI}  {$OPTIMIZATION ON,ALL} {$codealign proc=16}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,//IntToStr
  strutils;//Numb2USA aka commatize
const
  ConvBase :array[0..15] of char= '0123456789ABCDEF';
  maxBase = 16;
type
  tErg = string[63];
  tCnt = array[0..maxBase-1] of UInt64;
  tDgtcnt = array[0..64] of tCnt;

//global
var
  Dgtcnt :tDgtcnt;

procedure CalcDgtCnt(base:NativeInt;var Dgtcnt :tDgtcnt);
var
  pCnt0,
  pCnt1 : ^tCnt;
  i,j,SumCarry: NativeUInt;
begin
  fillchar(Dgtcnt,SizeOf(Dgtcnt),#0);
  pCnt0 := @Dgtcnt[0];
  //building count for every first digit of digitcount:
  //example :count numbers starting "1" of lenght 13
  For i := 0 to Base-1 do
    pCnt0^[i] := 1;
  For j := 1 to High(Dgtcnt) do
  Begin
    pCnt1 := @Dgtcnt[j];
    //0 -> followed only by solutions of 1
    pCnt1^[0] := pCnt0^[1];
    //base-1 -> followed only by solutions of Base-2
    pCnt1^[base-1] := pCnt0^[base-2];
    //followed by solutions for i-1 and i+1
    For i := 1 to base-2 do
      pCnt1^[i]:= pCnt0^[i-1]+pCnt0^[i+1];
    //next row aka digitcnt
    pCnt0:= pCnt1;
  end;

  //converting to sum up each digit
  //example :count numbers starting "1" of lenght 13
  //-> count of all est. numbers from 1 to "1" with max lenght 13

  //delete leading "0"
  For j := 0 to High(Dgtcnt) do //High(Dgtcnt)
    Dgtcnt[j,0] := 0;

  SumCarry := Uint64(0);
  For j := 0 to High(Dgtcnt) do
  Begin
    pCnt0 := @Dgtcnt[j];
    For i := 0 to base-1 do
    begin
      SumCarry +=pCnt0^[i];
      pCnt0^[i] :=SumCarry;
    end;
  end;
end;

function ConvToBaseStr(n,base:NativeUint):tErg;
var
  idx,dgt,rst : Uint64;
Begin
  IF n = 0 then
  Begin
    result := ConvBase[0];
    EXIT;
  end;
  idx := High(result);
  repeat
    rst := n div base;
    dgt := n-rst*base;
    result[idx] := ConvBase[dgt];
    dec(idx);
    n := rst;
  until n=0;
  rst := High(result)-idx;
  move(result[idx+1],result[1],rst);
  setlength(result,rst);
end;

function isEsthetic(n,base:Uint64):boolean;
var
  lastdgt,
  dgt,
  rst : Uint64;
Begin
  result := true;
  IF n >= Base then
  Begin
    rst := n div base;
    Lastdgt := n-rst*base;
    n := rst;
    repeat
      rst := n div base;
      dgt := n-rst*base;
      IF sqr(lastDgt-dgt)<> 1 then
      Begin
        result := false;
        EXIT;
      end;
      lastDgt := dgt;
      n := rst;
    until n = 0;
  end;
end;

procedure Task1;
var
  i,base,cnt : NativeInt;
Begin
  cnt := 0;
  For base := 2 to 16 do
  Begin
    CalcDgtCnt(base,Dgtcnt);
    writeln(4*base,'th through ',6*base,'th esthetic numbers in base ',base);
    cnt := 0;
    i := 0;
    repeat
      inc(i);
      if isEsthetic(i,base) then
        inc(cnt);
    until cnt >= 4*base;

    repeat
      if isEsthetic(i,base) then
      Begin
        write(ConvToBaseStr(i,base),' ');
        inc(cnt);
      end;
      inc(i);
    until cnt > 6*base;
    writeln;
  end;
  writeln;
end;

procedure Task2;
var
  i : NativeInt;
begin
  write(' There are ',Dgtcnt[4][0]-Dgtcnt[3][0],' esthetic numbers');
  writeln(' between 1000 and 9999 ');
  For i := 1000 to 9999 do
  Begin
    if isEsthetic(i,10) then
      write(i:5);
  end;
  writeln;writeln;
end;

procedure Task3(Pot10: NativeInt);
//calculating esthetic numbers starting with "1" and Pot10+1 digits
var
  i : NativeInt;
begin
  write(' There are ',Numb2USA(IntToStr(Dgtcnt[Pot10][1]-Dgtcnt[Pot10][0])):26,' esthetic numbers');
  writeln(' between 1e',Pot10,' and 1.3e',Pot10);
  if Pot10 = 8 then
  Begin
    For i := 100*1000*1000 to 110*1000*1000-1 do
    Begin
      if isEsthetic(i,10) then
        write(i:10);
    end;
    writeln;
    //Jump over "11"
    For i := 120*1000*1000 to 130*1000*1000-1 do
    Begin
      if isEsthetic(i,10) then
        write(i:10);
    end;
    writeln;writeln;
  end;
end;

var
  i:NativeInt;
BEGIN
  Task1;
  //now only base 10 is used
  CalcDgtCnt(10,Dgtcnt);
  Task2;
  For i := 2 to 20 do
    Task3(3*i+2);
  writeln;
  write(' There are ',Numb2USA(IntToStr(Dgtcnt[64][0])),' esthetic numbers');
  writeln(' with max 65 digits ');
  writeln;
  writeln(' The count of numbers with 64 digits like https://oeis.org/A090994');
  writeln(Numb2USA(IntToStr(Dgtcnt[64][0]-Dgtcnt[63][0])):28);
end.


Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Public Sub begin()
    start_int = GetTickCount()
    main
    Debug.Print (GetTickCount() - start_int) / 1000 & " seconds"
End Sub
Private Function pow(x, y) As Variant
    pow = CDec(Application.WorksheetFunction.Power(x, y))
End Function
Private Sub main()
    For x0 = 1 To 250
        For x1 = 1 To x0
            For x2 = 1 To x1
                For x3 = 1 To x2
                    sum = CDec(pow(x0, 5) + pow(x1, 5) + pow(x2, 5) + pow(x3, 5))
                    s1 = Int(pow(sum, 0.2))
                    If sum = pow(s1, 5) Then
                        Debug.Print x0 & "^5 + " & x1 & "^5 + " & x2 & "^5 + " & x3 & "^5 = " & s1
                        Exit Sub
                    End If
                Next x3
            Next x2
        Next x1
    Next x0
End Sub


Max=250

For X0=1 To Max
	For X1=1 To X0
		For X2=1 To X1
			For X3=1 To X2
				Sum=fnP5(X0)+fnP5(X1)+fnP5(X2)+fnP5(X3)
				S1=Int(Sum^0.2)
				If Sum=fnP5(S1) Then
					WScript.StdOut.Write X0 & " " & X1 & " " & X2 & " " & X3 & " " & S1
					WScript.Quit
				End If
			Next
		Next
	Next
Next

Function fnP5(n)
	fnP5 = n ^ 5
End Function


If fPart(.5Ans
Then
Disp "ODD
Else
Disp "EVEN
End


$$ MODE TUSCRIPT
LOOP n=-5,5
x=MOD(n,2)
SELECT x
CASE 0
PRINT n," is even"
DEFAULT
PRINT n," is odd"
ENDSELECT
ENDLOOP


decl int input
set input (in int console)
if (= (mod input 2) 1)
        out "odd" endl console
else
        out "even" endl console
end if


proc listEquilibria {list} {
    set after 0
    foreach item $list {incr after $item}
    set result {}
    set idx 0
    set before 0
    foreach item $list {
	incr after [expr {-$item}]
	if {$after == $before} {
	    lappend result $idx
	}
	incr before $item
	incr idx
    }
    return $result
}


#import std
#import int

edex = [email protected]; ~&nS+ *~ ==+ ~~r sum:-0

#cast %nL

example = edex <-7,1,5,2,-4,3,0>


arr = Array(-7,1,5,2,-4,3,0)
WScript.StdOut.Write equilibrium(arr,UBound(arr))
WScript.StdOut.WriteLine

Function equilibrium(arr,n)
	sum = 0
	leftsum = 0
	'find the sum of the whole array
	For i = 0 To UBound(arr)
		sum = sum + arr(i)
	Next
	For i = 0 To UBound(arr)
		sum = sum - arr(i)
		If leftsum = sum Then
			equilibrium = equilibrium & i & ", "
		End If
		leftsum = leftsum + arr(i)
	Next
End Function


import "/fmt" for Fmt

var equilibrium = Fn.new { |a|
    var len = a.count
    var equi = []
    if (len == 0) return equi // sequence has no indices at all
    var rsum = a.reduce { |acc, x| acc + x }
    var lsum = 0
    for (i in 0...len) {
        rsum = rsum - a[i]
        if (rsum == lsum) equi.add(i)
        lsum = lsum + a[i]
    }
    return equi
}

var tests = [
    [-7, 1, 5, 2, -4, 3, 0],
    [2, 4, 6],
    [2, 9, 2],
    [1, -1, 1, -1, 1, -1, 1],
    [1],
    []
]

System.print("The equilibrium indices for the following sequences are:\n")
for (test in tests) {
    System.print("%(Fmt.s(24, test)) -> %(equilibrium.call(test))")
}


halve: function [x]-> shr x 1
double: function [x]-> shl x 1

; even? already exists

ethiopian: function [x y][
    prod: 0
    while [x > 0][
        unless even? x [prod: prod + y]
        x: halve x
        y: double y
    ]
    return prod
]

print ethiopian 17 34
print ethiopian 2 3


MsgBox % Ethiopian(17, 34) "`n" Ethiopian2(17, 34)

; func definitions:
half( x ) {
	return x >> 1
}

double( x ) {
	return x << 1
}

isEven( x ) {
	return x & 1 == 0
}

Ethiopian( a, b ) {
	r := 0
	While (a >= 1) {
		if !isEven(a)
			r += b
		a := half(a)
		b := double(b)
	}
	return r
}

; or a recursive function:
Ethiopian2( a, b, r = 0 ) { ;omit r param on initial call
	return a==1 ? r+b : Ethiopian2( half(a), double(b), !isEven(a) ? r+b : r )
}


class generator
	dim t1
	dim t2
	dim tn
	dim cur_overflow

	Private Sub Class_Initialize
		cur_overflow = false
		t1 = ccur(0)
		t2 = ccur(1)
		tn = ccur(t1 + t2)
	end sub

	public default property get generated
		on error resume next

		generated = ccur(tn)
		if err.number <> 0 then
			generated = cdbl(tn)
			cur_overflow = true
		end if
		t1 = ccur(t2)
		if err.number <> 0 then
			t1 = cdbl(t2)
			cur_overflow = true
		end if
		t2 = ccur(tn)
		if err.number <> 0 then
			t2 = cdbl(tn)
			cur_overflow = true
		end if
		tn = ccur(t1+ t2)
		if err.number <> 0 then
			tn = cdbl(t1) + cdbl(t2)
			cur_overflow = true
		end if
		on error goto 0
	end property

	public property get overflow
		overflow = cur_overflow
	end property

end class


Imports System
Imports System.Numerics
Imports System.Linq

Module Module1

    ' Type Double:

    Function DofactorialI(n As Integer) As Double ' Iterative
        DofactorialI = 1 : For i As Integer = 1 To n : DofactorialI *= i : Next
    End Function

    ' Type Unsigned Long:

    Function ULfactorialI(n As Integer) As ULong ' Iterative
        ULfactorialI = 1 : For i As Integer = 1 To n : ULfactorialI *= i : Next
    End Function

    ' Type Decimal:

    Function DefactorialI(n As Integer) As Decimal ' Iterative
        DefactorialI = 1 : For i As Integer = 1 To n : DefactorialI *= i : Next
    End Function

    ' Extends precision by "dehydrating" and "rehydrating" the powers of ten
    Function DxfactorialI(n As Integer) As String ' Iterative
        Dim factorial as Decimal = 1, zeros as integer = 0
        For i As Integer = 1 To n : factorial *= i
            If factorial Mod 10 = 0 Then factorial /= 10 : zeros += 1
        Next : Return factorial.ToString() & New String("0", zeros)
    End Function

    ' Arbitrary Precision:

    Function FactorialI(n As Integer) As BigInteger ' Iterative
        factorialI = 1 : For i As Integer = 1 To n : factorialI *= i : Next
    End Function

    Function Factorial(number As Integer) As BigInteger ' Functional
        Return Enumerable.Range(1, number).Aggregate(New BigInteger(1),
            Function(acc, num) acc * num)
    End Function

    Sub Main()
        Console.WriteLine("Double  : {0}! = {1:0}", 20, DoFactorialI(20))
        Console.WriteLine("ULong   : {0}! = {1:0}", 20, ULFactorialI(20))
        Console.WriteLine("Decimal : {0}! = {1:0}", 27, DeFactorialI(27))
        Console.WriteLine("Dec.Ext : {0}! = {1:0}", 32, DxFactorialI(32))
        Console.WriteLine("Arb.Prec: {0}! = {1}", 250, Factorial(250))
    End Sub
End Module


// you can freeze any object.
b = [1, 2, 3];
b[1] = 100; // returns [1, 100, 3]
b.freeze; // make b immutable
b[1] = 2; // throws an error ("Attempted write to immutable object.")


let a = 1
a = 1 // error: a is immutable
var b = 1
b = 1


proc constant {varName {value ""}} {
    upvar 1 $varName var
    # Allow application of immutability to an existing variable, e.g., a procedure argument
    if {[llength [info frame 0]] == 2} {set value $var} else {set var $value}
    trace add variable var write [list apply {{val v1 v2 op} {
        upvar 1 $v1 var
        set var $val; # Restore to what it should be
        return -code error "immutable"
    }} $value]
}


define Pi=3.14;
Pi:= 3.15;      \causes a compile error: statement starting with a constant


class A {
    construct new(f) {
        _f  = f  // sets field _f to the argument f
    }

    // getter property to allow access to _f
    f { _f }

    // setter property to allow _f to be mutated
    f=(other) { _f = other }
}

var a = A.new(6)
System.print(a.f)
a.f = 8
System.print(a.f)


List:
byte 2,3,4,5,6  ;this could be either mutable or immutable, it depends on the hardware.


F entropy(source)
   DefaultDict[Char, Int] hist
   L(c) source
      hist[c]++
   V r = 0.0
   L(v) hist.values()
      V c = Float(v) / source.len
      r -= c * log2(c)
   R r

print(entropy(‘1223334444’))


use 5.020;
use warnings;
use experimental qw(signatures);

use ntheory qw(fromdigits todigitstring);

sub generate_esthetic ($root, $upto, $callback, $base = 10) {

    my $v = fromdigits($root, $base);

    return if ($v > $upto);
    $callback->($v);

    my $t = $root->[-1];

    __SUB__->([@$root, $t + 1], $upto, $callback, $base) if ($t + 1 < $base);
    __SUB__->([@$root, $t - 1], $upto, $callback, $base) if ($t - 1 >= 0);
}

sub between_esthetic ($from, $upto, $base = 10) {
    my @list;
    foreach my $k (1 .. $base - 1) {
        generate_esthetic([$k], $upto,
            sub($n) { push(@list, $n) if ($n >= $from) }, $base);
    }
    sort { $a <=> $b } @list;
}

sub first_n_esthetic ($n, $base = 10) {
    for (my $m = $n * $n ; 1 ; $m *= $base) {
        my @list = between_esthetic(1, $m, $base);
        return @list[0 .. $n - 1] if @list >= $n;
    }
}

foreach my $base (2 .. 16) {
    say "\n$base-esthetic numbers at indices ${\(4*$base)}..${\(6*$base)}:";
    my @list = first_n_esthetic(6 * $base, $base);
    say join(' ', map { todigitstring($_, $base) } @list[4*$base-1 .. $#list]);
}

say "\nBase 10 esthetic numbers between 1,000 and 9,999:";
for (my @list = between_esthetic(1e3, 1e4) ; @list ;) {
    say join(' ', splice(@list, 0, 20));
}

say "\nBase 10 esthetic numbers between 100,000,000 and 130,000,000:";
for (my @list = between_esthetic(1e8, 1.3e8) ; @list ;) {
    say join(' ', splice(@list, 0, 9));
}


Module Module1

    Structure Pair
        Dim a, b As Integer
        Sub New(x as integer, y as integer)
            a = x : b = y
        End Sub
    End Structure

    Dim max As Integer = 250
    Dim p5() As Long,
        sum2 As SortedDictionary(Of Long, Pair) = New SortedDictionary(Of Long, Pair)

    Function Fmt(p As Pair) As String
        Return String.Format("{0}^5 + {1}^5", p.a, p.b)
    End Function

    Sub Init()
        p5(0) = 0 : p5(1) = 1 : For i As Integer = 1 To max - 1
            For j As Integer = i + 1 To max
                p5(j) = CLng(j) * j : p5(j) *= p5(j) * j
                sum2.Add(p5(i) + p5(j), New Pair(i, j))
            Next
        Next
    End Sub

    Sub Calc(Optional findLowest As Boolean = True)
        For i As Integer = 1 To max : Dim p As Long = p5(i)
            For Each s In sum2.Keys
                Dim t As Long = p - s : If t <= 0 Then Exit For
                If sum2.Keys.Contains(t) AndAlso sum2.Item(t).a > sum2.Item(s).b Then
                    Console.WriteLine("  {1} + {2} = {0}^5", i, Fmt(sum2.Item(s)), Fmt(sum2.Item(t)))
                    If findLowest Then Exit Sub
                End If
            Next : Next
    End Sub

    Sub Main(args As String())
        If args.Count > 0 Then
            Dim t As Integer = 0 : Integer.TryParse(args(0), t)
            If t > 0 AndAlso t < 5405 Then max = t
        End If
        Console.WriteLine("Checking from 1 to {0}...", max)
        For i As Integer = 0 To 1
            ReDim p5(max) : sum2.Clear()
            Dim st As DateTime = DateTime.Now
            Init() : Calc(i = 0)
            Console.WriteLine("{0}  Computation time to {2} was {1} seconds{0}", vbLf,
                (DateTime.Now - st).TotalSeconds, If(i = 0, "find lowest one", "check entire space"))
        Next
        If Diagnostics.Debugger.IsAttached Then Console.ReadKey()
    End Sub
End Module


முதன்மை என்பதின் வகை எண் பணி {{
        எ இன் வகை எண்{$5} = 0;
        படை வகை சரம்;

        "எண்ணைக் கொடுங்கள்? ") ஐ திரை.இடு;

        எ = எண்{$5} ஐ விசை.எடு;

        ஒருக்கால் (எ.இருமம்(0) == 1) ஆகில் {
                படை = "ஒற்றை";
        } இல்லையேல் {
                படை = "இரட்டை ";
        }

        {எ, " ஒரு ", படை, "ப்படை எண் ஆகும்"} என்பதை திரை.இடு;

        முதன்மை  = 0;
}};


4 ways = 4 Functions :
IsEven ==> Use the even and odd predicates
IsEven2 ==> Check the least significant digit. With binary integers, i bitwise-and 1 equals 0 iff i is even
IsEven3 ==> Divide i by 2. The remainder equals 0 if i is even.
IsEven4 ==> Use modular congruences


Function odd_or_even(n)
	If n Mod 2 = 0 Then
		odd_or_even = "Even"
	Else
		odd_or_even = "Odd"
	End If
End Function

WScript.StdOut.Write "Please enter a number: "
n = WScript.StdIn.ReadLine
WScript.StdOut.Write n & " is " & odd_or_even(CInt(n))
WScript.StdOut.WriteLine


code Ran=1, ChOut=8, IntOut=11;
def Size = 1_000_000;
int I, S, A(Size), Hi(Size), Lo(Size);
[for I:= 0 to Size-1 do A(I):= Ran(100) - 50;
S:= 0;
for I:= 0 to Size-1 do [S:= S+A(I);  Lo(I):= S];
S:= 0;
for I:= Size-1 downto 0 do [S:= S+A(I);  Hi(I):= S];
for I:= 0 to Size-1 do
    if Lo(I) = Hi(I) then [IntOut(0, I);  ChOut(0, ^ )];
]


func equilibrium_indices(A) {
    return where(A(psum) == A(::-1)(psum)(::-1));
}


fcn equilibrium(lst){  // two pass
   reg acc=List(), left=0,right=lst.sum(0),i=0;
   foreach x in (lst){
      right-=x;
      if(left==right) acc.write(i);
      i+=1; left+=x;
   }
   acc
}


10 DATA 7,-7,1,5,2,-4,3,0
20 READ n
30 DIM a(n): LET sum=0: LET leftsum=0: LET s$=""
40 FOR i=1 TO n: READ a(i): LET sum=sum+a(i): NEXT i
50 FOR i=1 TO n
60 LET sum=sum-a(i)
70 IF leftsum=sum THEN LET s$=s$+STR$ i+" "
80 LET leftsum=leftsum+a(i)
90 NEXT i
100 PRINT "Numbers: ";
110 FOR i=1 TO n: PRINT a(i);" ";: NEXT i
120 PRINT '"Indices: ";s$


Func Halve($x)
	Return Int($x/2)
EndFunc

Func Double($x)
	Return ($x*2)
EndFunc

Func IsEven($x)
	Return (Mod($x,2) == 0)
EndFunc

; this version also supports negative parameters
Func Ethiopian($nPlier, $nPlicand, $bTutor = True)
	Local $nResult = 0
	If ($nPlier < 0) Then
		$nPlier =- $nPlier
		$nPlicand =- $nPlicand
	ElseIf ($nPlicand > 0) And ($nPlier > $nPlicand) Then
		$nPlier = $nPlicand
		$nPlicand = $nPlier
	EndIf
	If $bTutor Then _
    ConsoleWrite(StringFormat("Ethiopian multiplication of %d by %d...\n", $nPlier, $nPlicand))
	While ($nPlier >= 1)
		If Not IsEven($nPlier) Then
			$nResult += $nPlicand
			If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tKeep\n", $nPlier, $nPlicand))
		Else
			If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tStrike\n", $nPlier, $nPlicand))
		EndIf
		$nPlier = Halve($nPlier)
		$nPlicand = Double($nPlicand)
	WEnd
	If $bTutor Then ConsoleWrite(StringFormat("Answer = %d\n", $nResult))
	Return $nResult
EndFunc

MsgBox(0, "Ethiopian multiplication of 17 by 34", Ethiopian(17, 34) )


const max_size = 10

fn factorial_i() {
  mut facs := [0].repeat(max_size + 1)
  facs[0] = 1
  println('The 0-th Factorial number is: 1')
  for i := 1; i <= max_size; i++ {
    facs[i] = i * facs[i - 1]
    num := facs[i]
    println('The $i-th Factorial number is: $num')
  }
}

fn main() {
	factorial_i()
}


def (fact n)
  if (n = 0)
    1
    (n * (fact n-1))


List(1,2,3).del(0) //--> L(2,3)
ROList(1,2,3).del(0) //-->SyntaxError : Can't find del, which means you can't call it
d:=Dictionary(); d.add("one",1)
D(one:1)
d.makeReadOnly(); d.add("2",2)  //-->AccessError(This Dictionary is read only)


with Ada.Text_IO, Ada.Float_Text_IO, Ada.Numerics.Elementary_Functions;

procedure Count_Entropy is

   package TIO renames Ada.Text_IO;

   Count: array(Character) of Natural := (others => 0);
   Sum:   Natural := 0;
   Line: String := "1223334444";

begin
   for I in Line'Range loop   -- count the characters
      Count(Line(I)) := Count(Line(I))+1;
      Sum := Sum + 1;
   end loop;

   declare   -- compute the entropy and print it
      function P(C: Character) return Float is (Float(Count(C)) / Float(Sum));
      use Ada.Numerics.Elementary_Functions, Ada.Float_Text_IO;
      Result: Float := 0.0;
   begin
      for Ch in Character loop
         Result := Result -
          (if P(Ch)=0.0 then 0.0 else P(Ch) * Log(P(Ch), Base => 2.0));
      end loop;
      Put(Result, Fore => 1, Aft => 5, Exp => 0);
   end;
end Count_Entropy;


constant aleph = "0123456789ABCDEF"

function efill(string s, integer ch, i)
    -- min-fill, like 10101 or 54321 or 32101
    s[i] = ch
    for j=i+1 to length(s) do
        ch = iff(ch>='1'?iff(ch='A'?'9':ch-1):'1')
        s[j] = ch
    end for
    return s
end function

function esthetic(string s, integer base = 10)
    -- generate the next esthetic number after s
    -- (nb unpredictable results if s is not esthetic, or "")
    for i=length(s) to 1 by -1 do
        integer ch = s[i], cp = iff(i>1?s[i-1]:'0')
        if ch<cp and cp<aleph[base] then
            return efill(s,aleph[find(ch,aleph)+2],i)
        elsif i=1 and ch<aleph[base] then
            return efill(s,iff(ch='9'?'A':ch+1),i)
        end if
    end for
    return efill("1"&s,'1',1)
end function

string s
sequence res
for base=2 to 16 do
    integer hi = base*6,
            lo = base*4
    {s,res} = {"",{}}
    for i=1 to hi do
        s = esthetic(s, base)
        if i>=lo then
            res = append(res,s)
        end if
    end for
    res = join(shorten(res,"numbers",4))
    printf(1,"Base %d esthetic numbers[%d..%d]: %s\n",{base,lo,hi,res})
end for

{s,res} = {efill("1000",'1',1),{}}
while length(s)=4 do
    res = append(res,s)
    s = esthetic(s)
end while
res = {join(shorten(res,"numbers",5))}
printf(1,"\nBase 10 esthetic numbers between 1,000 and 9,999: %s\n\n",res)

function comma(string s)
    for i=length(s)-2 to 2 by -3 do
        s[i..i-1] = ","
    end for
    return s
end function

for k=7 to 19 by 3 do
    string f = "10"&repeat('0',k),
           t = "13"&repeat('0',k)
    {s,res} = {efill(f,'1',1),{}}
    while s<t do
        res = append(res,s)
        s = esthetic(s)
    end while
    res = join(shorten(res,"numbers",1))
    printf(1,"Base 10 esthetic numbers between %s and %s: %s\n",
             {comma(f),comma(t),res})
end for


var start = System.clock
var n = 250
var m = 30

var p5 = List.filled(n+m+1, 0)
var s = 0
while (s < n) {
    var sq = s * s
    p5[s] = sq * sq * s
    s = s + 1
}
var max = p5[n-1]
while (s < p5.count) {
    p5[s] = max + 1
    s = s + 1
}
for (a in 1...n-3) {
    for (b in a + 1...n-2) {
        for (c in b + 1...n-1) {
            var d = c + 1
            var t = p5[a] + p5[b] + p5[c]
            var e = d + (t % m)
            s = t + p5[d]
            while (s <= max) {
                e = e - m
                while (p5[e+m] <= s) e = e + m
                if (p5[e] == s) {
                    System.print("%(a)⁵ + %(b)⁵ + %(c)⁵ + %(d)⁵ = %(e)⁵")
                    System.print("Took %(System.clock - start) seconds")
                    return
                }
                d = d + 1
                e = e + 1
                s = t + p5[d]
            }
        }
    }
}


module main;
  integer i;

  initial begin
        for (i = 1; i <= 10; i = i+1) begin
          if (i % 2 == 0) $display(i, " is even");
          else            $display(i, " is odd");
        end
      $finish ;
    end
endmodule


Module Module1

    Sub Main()
        Dim str As String
        Dim num As Integer
        While True
            Console.Write("Enter an integer or 0 to finish: ")
            str = Console.ReadLine()
            If Integer.TryParse(str, num) Then
                If num = 0 Then
                    Exit While
                End If
                If num Mod 2 = 0 Then
                    Console.WriteLine("Even")
                Else
                    Console.WriteLine("Odd")
                End If
            Else
                Console.WriteLine("Bad input.")
            End If
        End While
    End Sub

End Module


function halve(x)
{
  return int(x/2)
}

function double(x)
{
  return x*2
}

function iseven(x)
{
  return x%2 == 0
}

function ethiopian(plier, plicand)
{
  r = 0
  while(plier >= 1) {
    if ( !iseven(plier) ) {
      r += plicand
    }
    plier = halve(plier)
    plicand = double(plicand)
  }
  return r
}

BEGIN {
  print ethiopian(17, 34)
}


REM Ethiopian multiplication
X = 17
Y = 34
TOT = 0
WHILE X >= 1
  PRINT X;
  PRINT " ";
  A = X
  GOSUB CHECKEVEN:
  IF ISEVEN = 0 THEN
    TOT = TOT + Y
    PRINT Y;
  ENDIF
  PRINT
  A = X
  GOSUB HALVE:
  X = A
  A = Y
  GOSUB DOUBLE:
  Y = A
WEND
PRINT "=      ";
PRINT TOT
END

REM Subroutines are required, though
REM they complicate the code

DOUBLE:
A = 2 * A
RETURN

HALVE:
A = A / 2
RETURN

CHECKEVEN:
REM ISEVEN - result (0 if A odd, 1 otherwise)
ISEVEN = A MOD 2
ISEVEN = 1 - ISEVEN
RETURN


Sub fibonacci()
    Const n = 139
    Dim i As Integer
    Dim f1 As Variant, f2 As Variant, f3 As Variant 'for Decimal
    f1 = CDec(0): f2 = CDec(1) 'for Decimal setting
    Debug.Print "fibo("; 0; ")="; f1
    Debug.Print "fibo("; 1; ")="; f2
    For i = 2 To n
        f3 = f1 + f2
        Debug.Print "fibo("; i; ")="; f3
        f1 = f2
        f2 = f3
    Next i
End Sub 'fibonacci


V s = ‘’
I s.empty
   print(‘String s is empty.’)
I !s.empty
   print(‘String s is not empty.’)


(module
  ;; recursive
  (func $fac (param f64) (result f64)
    get_local 0
    f64.const 1
    f64.lt
    if (result f64)
      f64.const 1
    else
      get_local 0
      get_local 0
      f64.const 1
      f64.sub
      call $fac
      f64.mul
    end)
  (export "fac" (func $fac)))


integer c;
real h, v;
index x;
data s;

for (, c in (s = argv(1))) {
    x[c] += 1r;
}

h = 0;
for (, v in x) {
    v /= ~s;
    h -= v * log2(v);
}

o_form("/d6/\n", h);


BEGIN
    # calculate the shannon entropy of a string                                #
    PROC shannon entropy = ( STRING s )REAL:
    BEGIN
        INT string length = ( UPB s - LWB s ) + 1;
        # count the occurences of each character #
        [ 0 : max abs char ]INT char count;
        FOR char pos FROM LWB char count TO UPB char count DO
            char count[ char pos ] := 0
        OD;
        FOR char pos FROM LWB s TO UPB s DO
            char count[ ABS s[ char pos ] ] +:= 1
        OD;
        # calculate the entropy, we use log base 10 and then convert #
        # to log base 2 after calculating the sum                    #
        REAL entropy := 0;
        FOR char pos FROM LWB char count TO UPB char count DO
            IF char count[ char pos ] /= 0
            THEN
                # have a character that occurs in the string #
                REAL probability = char count[ char pos ] / string length;
                entropy -:= probability * log( probability )
            FI
        OD;
        entropy / log( 2 )
    END; # shannon entropy #

    # test the shannon entropy routine #
    print( ( shannon entropy( "1223334444" ), newline ) )

END


(de esthetic (N Base)
   (let Lst
      (make
         (loop
            (yoke (% N Base))
            (T (=0 (setq N (/ N Base)))) ) )
      (and
         (fully
            =1
            (make
               (for (L Lst (cdr L) (cdr L))
                  (link (abs (- (car L) (cadr L)))) ) ) )
         (pack
            (mapcar
               '((C)
                  (and (> C 9) (inc 'C 39))
                  (char (+ C 48)) )
               Lst ) ) ) ) )
(de genCount (Num Base)
   (let (C 0  N 0)
      (tail
         (inc (* 2 Base))
         (make
            (while (>= Num C)
               (when (esthetic N Base) (link @) (inc 'C))
               (inc 'N) ) ) ) ) )
(de genRange (A B Base)
   (make
      (while (>= B A)
         (when (esthetic A Base) (link @))
         (inc 'A) ) ) )
(for (N 2 (>= 16 N) (inc N))
   (prin "Base " N ": ")
   (mapc '((L) (prin L " ")) (genCount (* 6 N) N))
   (prinl) )
(prinl)
(prinl "Base 10: 61 esthetic numbers between 1000 and 9999:")
(let L (genRange 1000 9999 10)
   (while (cut 16 'L)
      (mapc '((L) (prin L " ")) @)
      (prinl) ) )
(prinl)
(prinl "Base 10: 126 esthetic numbers between 100000000 and 130000000:")
(let L (genRange 100000000 130000000 10)
   (while (cut 9 'L)
      (mapc '((L) (prin L " ")) @)
      (prinl) ) )


main:-
    forall(between(2, 16, Base),
            (Min_index is Base * 4, Max_index is Base * 6,
            print_esthetic_numbers1(Base, Min_index, Max_index))),
    print_esthetic_numbers2(1000, 9999, 16),
    nl,
    print_esthetic_numbers2(100000000, 130000000, 8).

print_esthetic_numbers1(Base, Min_index, Max_index):-
    swritef(Format, '~%tr ', [Base]),
    writef('Esthetic numbers in base %t from index %t through index %t:\n',
            [Base, Min_index, Max_index]),
    print_esthetic_numbers1(Base, Format, Min_index, Max_index, 0, 1).

print_esthetic_numbers1(Base, Format, Min_index, Max_index, M, I):-
    I =< Max_index,
    !,
    next_esthetic_number(Base, M, N),
    (I >= Min_index -> format(Format, [N]) ; true),
    J is I + 1,
    print_esthetic_numbers1(Base, Format, Min_index, Max_index, N, J).
print_esthetic_numbers1(_, _, _, _, _, _):-
    write('\n\n').

print_esthetic_numbers2(Min, Max, Per_line):-
    writef('Esthetic numbers in base 10 between %t and %t:\n', [Min, Max]),
    M is Min - 1,
    print_esthetic_numbers2(Max, Per_line, M, 0).

print_esthetic_numbers2(Max, Per_line, M, Count):-
    next_esthetic_number(10, M, N),
    N =< Max,
    !,
    write(N),
    Count1 is Count + 1,
    (0 is Count1 mod Per_line -> nl ; write(' ')),
    print_esthetic_numbers2(Max, Per_line, N, Count1).
print_esthetic_numbers2(_, _, _, Count):-
    writef('\nCount: %t\n', [Count]).

next_esthetic_number(Base, M, N):-
    N is M + 1,
    N < Base,
    !.
next_esthetic_number(Base, M, N):-
    A is M // Base,
    B is A mod Base,
    (B is M mod Base + 1, B + 1 < Base ->
        N is M + 2
        ;
        next_esthetic_number(Base, A, C),
        D is C mod Base,
        (D == 0 -> E = 1 ; E is D - 1),
        N is C * Base + E).


func real Pow5(N);
int  N;
real X, P;
[X:= float(N);
P:= X*X;
P:= P*P;
return P*X;
];

int  X0, X1, X2, X3, Y;
real SP;
[for X0:= 1 to 250 do
  for X1:= 1 to X0-1 do
    for X2:= 1 to X1-1 do
      for X3:= 1 to X2-1 do
        [SP:= Pow5(X0) + Pow5(X1) + Pow5(X2) + Pow5(X3);
        for Y:= X0+1 to 250 do
          if Pow5(Y) = SP then
                [IntOut(0, X0);  Text(0, "^^5 + ");
                 IntOut(0, X1);  Text(0, "^^5 + ");
                 IntOut(0, X2);  Text(0, "^^5 + ");
                 IntOut(0, X3);  Text(0, "^^5 = ");
                 IntOut(0, Y);   Text(0, "^^5^m^j");
                 exit;
                ];
        ];
]


const std = @import("std");
const stdout = std.io.getStdOut().outStream();

pub fn main() !void {
    var pow5: [250]i64 = undefined;
    for (pow5) |*e, i| {
        const n = @intCast(i64, i);
        e.* = n * n * n * n * n;
    }
    var x0: u16 = 4;
    while (x0 < pow5.len) : (x0 += 1) {
        var x1: u16 = 3;
        while (x1 < x0) : (x1 += 1) {
            var x2: u16 = 2;
            while (x2 < x1) : (x2 += 1) {
                var x3: u16 = 1;
                while (x3 < x2) : (x3 += 1) {
                    const sum = pow5[x0] + pow5[x1] + pow5[x2] + pow5[x3];
                    var y: u16 = x0 + 1;
                    while (y < pow5.len) : (y += 1) if (sum == pow5[y]) {
                        try stdout.print("{}⁵ + {}⁵ + {}⁵ + {}⁵ = {}⁵\n", .{ x0, x1, x2, x3, y });
                        return;
                    };
                }
            }
        }
    }

    try stdout.print("Sorry, no solution found.\n", .{});
}


fn test(n i64) {
    print('Testing integer $n')

    if n&1 == 0 {
        print(' even')
    }else{
        print('  odd')
    }

    if n%2 == 0 {
        println(' even')
    }else{
        println('  odd')
    }
}

fn main(){
    test(-2)
    test(-1)
    test(0)
    test(1)
    test(2)
}


let s => import 'stream';
let str => import 'strings';

let evenOrOdd n => (
	let even n => == (% n 2) 0;
	switch n {
		even => 'even';
		default => 'odd';
	};
);

s.range 10
-> s.map (@ s n => str.format '{} is {}.' n (evenOrOdd n))
-> s.map (io.writeln io.stdout)
-> s.drain;


(module
  ;; function isOdd: returns 1 if its argument is odd, 0 if it is even.
  (func $isOdd (param $n i32) (result i32)
    get_local $n
    i32.const 1
    i32.and   ;; computes (n & 1), i.e. returns low bit of n
  )
  (export "isOdd" (func $isOdd))
)


import "/fmt" for Fmt

var isEven1 = Fn.new { |i| i & 1 == 0 }

var isEven2 = Fn.new { |i| i % 2 == 0 }

var tests = [10, 11, 0,  57,  34,  -23,  -42]
System.print("Tests    : %(Fmt.v("s", -4, tests, 0, " ", ""))")
var res1 = tests.map { |t| isEven1.call(t) ? "even" : "odd" }.toList
System.print("Method 1 : %(Fmt.v("s", -4, res1, 0, " ", ""))")
var res2 = tests.map { |t| isEven2.call(t) ? "even" : "odd" }.toList
System.print("Method 2 : %(Fmt.v("s", -4, res2, 0, " ", ""))")


@echo off
:: Pick 2 random, non-zero, 2-digit numbers to send to :_main
set /a param1=%random% %% 98 + 1
set /a param2=%random% %% 98 + 1
call:_main %param1% %param2%
pause>nul
exit /b

:: This is the main function that outputs the answer in the form of "%1 * %2 = %answer%"
:_main
setlocal enabledelayedexpansion
set l0=%1
set r0=%2
set leftcount=1
set lefttempcount=0
set rightcount=1
set righttempcount=0

:: Creates an array ("l[]") with the :_halve function. %l0% is the initial left number parsed
:: This section will loop until the most recent member of "l[]" is equal to 0
:left
set /a lefttempcount=%leftcount%-1
if !l%lefttempcount%!==1 goto right
call:_halve !l%lefttempcount%!
set l%leftcount%=%errorlevel%
set /a leftcount+=1
goto left

:: Creates an array ("r[]") with the :_double function, %r0% is the initial right number parsed
:: This section will loop until it has the same amount of entries as "l[]"
:right
set /a righttempcount=%rightcount%-1
if %rightcount%==%leftcount% goto both
call:_double !r%righttempcount%!
set r%rightcount%=%errorlevel%
set /a rightcount+=1
goto right

:both
:: Creates an boolean array ("e[]") corresponding with whether or not the respective "l[]" entry is even
for /l %%i in (0,1,%lefttempcount%) do (
  call:_even !l%%i!
  set e%%i=!errorlevel!
)

:: Adds up all entries of "r[]" based on the value of "e[]", respectively
set answer=0
for /l %%i in (0,1,%lefttempcount%) do (
  if !e%%i!==1 (
    set /a answer+=!r%%i!
  :: Everything from this-----------------------------
    set iseven%%i=KEEP
  ) else (
    set iseven%%i=STRIKE
  )
  echo L: !l%%i! R: !r%%i! - !iseven%%i!
  :: To this, is for cosmetics and is optional--------

)
echo %l0% * %r0% = %answer%
exit /b

:: These are the three functions being used. The output of these functions are expressed in the errorlevel that they return
:_halve
setlocal
set /a temp=%1/2
exit /b %temp%

:_double
setlocal
set /a temp=%1*2
exit /b %temp%

:_even
setlocal
set int=%1
set /a modint=%int% %% 2
exit /b %modint%


Function Fib(ByVal n As Integer) As Decimal
    Dim fib0, fib1, sum As Decimal
    Dim i As Integer
    fib0 = 0
    fib1 = 1
    For i = 1 To n
        sum = fib0 + fib1
        fib0 = fib1
        fib1 = sum
    Next
    Fib = fib0
End Function


begin
    % calculates the shannon entropy of a string                          %
    % strings are fixed length in algol W and the length is part of the   %
    % type, so we declare the string parameter to be the longest possible %
    % string length (256 characters) and have a second parameter to       %
    % specify how much is actually used                                   %
    real procedure shannon_entropy ( string(256) value s
                                   ; integer     value stringLength
                                   );
    begin

        real    probability, entropy;

        % algol W assumes there are 256 possible characters %
        integer MAX_CHAR;
                MAX_CHAR := 256;

        % declarations must preceed statements, so we start a new         %
        % block here so we can use MAX_CHAR as an array bound             %
        begin

            % increment an integer variable                               %
            procedure incI ( integer value result a ) ; a := a + 1;

            integer array charCount( 1 :: MAX_CHAR );

            % count the occurances of each character in s                 %
            for charPos := 1 until MAX_CHAR do charCount( charPos ) := 0;
            for sPos := 0 until stringLength - 1 do incI( charCount( decode( s( sPos | 1 ) ) ) );

            % calculate the entropy, we use log base 10 and then convert  %
            % to log base 2 after calculating the sum                     %

            entropy := 0.0;
            for charPos := 1 until MAX_CHAR do
            begin
                if charCount( charPos ) not = 0
                then begin
                    % have a character that occurs in the string          %
                    probability := charCount( charPos ) / stringLength;
                    entropy     := entropy - ( probability * log( probability ) )
                end
            end charPos

        end;

        entropy / log( 2 )
    end shannon_entropy ;

    % test the shannon entropy routine                                    %
    r_format := "A"; r_w := 12; r_d := 6; % set output to fixed format    %
    write( shannon_entropy( "1223334444", 10 ) )

end.


      ENTROPY←{-+/R×2⍟R←(+⌿⍵∘.=∪⍵)÷⍴⍵}

      ⍝ How it works:
      ⎕←UNIQUE←∪X←'1223334444'
1234
      ⎕←TABLE_OF_OCCURENCES←X∘.=UNIQUE
1 0 0 0
0 1 0 0
0 1 0 0
0 0 1 0
0 0 1 0
0 0 1 0
0 0 0 1
0 0 0 1
0 0 0 1
0 0 0 1
      ⎕←COUNT←+⌿TABLE_OF_OCCURENCES
1 2 3 4
      ⎕←N←⍴X
10
      ⎕←RATIO←COUNT÷N
0.1 0.2 0.3 0.4
      -+/RATIO×2⍟RATIO
1.846439345


from collections import deque
from itertools import dropwhile, islice, takewhile
from textwrap import wrap
from typing import Iterable, Iterator

Digits = str  # Alias for the return type of to_digits()

def esthetic_nums(base: int) -> Iterator[int]:
    """Generate the esthetic number sequence for a given base

    >>> list(islice(esthetic_nums(base=10), 20))
    [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 21, 23, 32, 34, 43, 45, 54, 56, 65]
    """
    queue: deque[tuple[int, int]] = deque()
    queue.extendleft((d, d) for d in range(1, base))
    while True:
        num, lsd = queue.pop()
        yield num
        new_lsds = (d for d in (lsd - 1, lsd + 1) if 0 <= d < base)
        num *= base  # Shift num left one digit
        queue.extendleft((num + d, d) for d in new_lsds)

def to_digits(num: int, base: int) -> Digits:
    """Return a representation of an integer as digits in a given base

    >>> to_digits(0x3def84f0ce, base=16)
    '3def84f0ce'
    """
    digits: list[str] = []
    while num:
        num, d = divmod(num, base)
        digits.append("0123456789abcdef"[d])
    return "".join(reversed(digits)) if digits else "0"

def pprint_it(it: Iterable[str], indent: int = 4, width: int = 80) -> None:
    """Pretty print an iterable which returns strings

    >>> pprint_it(map(str, range(20)), indent=0, width=40)
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
    12, 13, 14, 15, 16, 17, 18, 19
    <BLANKLINE>
    """
    joined = ", ".join(it)
    lines = wrap(joined, width=width - indent)
    for line in lines:
        print(f"{indent*' '}{line}")
    print()

def task_2() -> None:
    nums: Iterator[int]
    for base in range(2, 16 + 1):
        start, stop = 4 * base, 6 * base
        nums = esthetic_nums(base)
        nums = islice(nums, start - 1, stop)  # start and stop are 1-based indices
        print(
            f"Base-{base} esthetic numbers from "
            f"index {start} through index {stop} inclusive:\n"
        )
        pprint_it(to_digits(num, base) for num in nums)

def task_3(lower: int, upper: int, base: int = 10) -> None:
    nums: Iterator[int] = esthetic_nums(base)
    nums = dropwhile(lambda num: num < lower, nums)
    nums = takewhile(lambda num: num <= upper, nums)
    print(
        f"Base-{base} esthetic numbers with "
        f"magnitude between {lower:,} and {upper:,}:\n"
    )
    pprint_it(to_digits(num, base) for num in nums)

if __name__ == "__main__":
    print("======\nTask 2\n======\n")
    task_2()

    print("======\nTask 3\n======\n")
    task_3(1_000, 9_999)

    print("======\nTask 4\n======\n")
    task_3(100_000_000, 130_000_000)


1 CLS
2 DIM k(29): DIM q(249)
5 FOR i=4 TO 249: LET q(i)=LN i : NEXT i
6 REM enhancements for the much expanded Spectrum Next:  DIM p(248,249)
7 REM FOR j=4TO 248:FOR i=j TO 249:LET p(j,i)=EXP (q(j)-q(i))*5:NEXT i:NEXT j
9 PRINT "slide rule ready"
15 FOR i=0 TO 9: LET k(i)=240+ i : NEXT i
17 FOR i=10 TO 29: LET k(i)=210+ i : NEXT i
20 FOR w=6 TO 246 STEP 3
21 LET o=w
22 FOR x=4 TO 248 STEP 2
23 IF o<x THEN LET o=x
24 FOR y=10 TO 245 STEP 5
25 IF o<y THEN LET o=y
26 FOR z=14 TO 245 STEP 7
27 IF o<z THEN LET o=z
30 LET o=o+1 : LET m=k(FN f((w+x+y+z),30))
34 IF m<o THEN GO TO 90
40 REM LET s=p(w,m)+p(x,m)+p(y,m)+p(z,m) instead of:
42 LET s=EXP((q(w)-q(m))*5)
43 LET s=EXP((q(x)-q(m))*5)+ s
45 LET s=EXP((q(y)-q(m))*5)+ s
47 LET s=EXP((q(z)-q(m))*5)+ s
50 IF s<>1 THEN GO TO 80
52 LET a=FN f(w*w,m) : LET a=FN f(a*a*w,m)
53 LET b=FN f(x*x,m) : LET b=FN f(b*b*x,m)
55 LET c=FN f(y*y,m) : LET c=FN f(c*c*y,m)
57 LET d=FN f(z*z,m) : LET d=FN f(d*d*z,m)
60 LET u=FN f((a+b+c+d),m)
65 IF u THEN GO TO 80
73 PRINT w;"^5+";x;"^5+";y;"^5+";z;"^5=";m;"^5": STOP
80 IF s<1 THEN m=m-30 : GO TO 34
90 NEXT z: NEXT y: NEXT x: NEXT w
100 DEF FN f(e,n)=e- INT(e/n)*n


#>
Typed XBS
evenOrOdd function
true = even
false = odd
<#
func evenOrOdd(a:number=0){
	send a%2==0;
}
set arr:array = [0,1,2,3,4,5,6,7,9,10];
foreach(v of arr){
	log(v+" is even? "+evenOrOdd(v))
}


get "libhdr"

let halve(i)  = i>>1
and double(i) = i<<1
and even(i)   = (i&1) = 0

let emul(x, y)      = emulr(x, y, 0)
and emulr(x, y, ac) =
    x=0 -> ac,
    emulr(halve(x), double(y), even(x) -> ac, ac + y)

let start() be writef("%N*N", emul(17, 34))


( (halve=.div$(!arg.2))
& (double=.2*!arg)
& (isEven=.mod$(!arg.2):0)
& ( mul
  =   a b as bs newbs result
    .   !arg:(?as.?bs)
      &   whl
        ' ( !as:? (%@:~1:?a)
          & !as halve$!a:?as
          & !bs:? %@?b
          & !bs double$!b:?bs
          )
      & :?newbs
      &   whl
        ' ( !as:%@?a ?as
          & !bs:%@?b ?bs
          & (isEven$!a|!newbs !b:?newbs)
          )
      & 0:?result
      &   whl
        ' (!newbs:%@?b ?newbs&!b+!result:?result)
      & !result
  )
& out$(mul$(17.34))
);


fn fib_iter(n int) int {
    if n < 2 {
      return n
    }

    mut prev, mut fib := 0, 1
    for _ in 0..(n - 1){
        prev, fib = fib, prev + fib
    }
    return fib
}

fn main() {
    for val in 0..11 {
        println('fibonacci(${val:2d}) = ${fib_iter(val):3d}')
    }
}


PROC CheckIsEmpty(CHAR ARRAY s)
  PrintF("'%S' is empty? ",s)
  IF s(0)=0 THEN
    PrintE("True")
  ELSE
    PrintE("False")
  FI
RETURN

PROC Main()
  CHAR ARRAY str1,str2

  str1=""
  str2="text"

  CheckIsEmpty(str1)
  CheckIsEmpty(str2)
RETURN


import "/fmt" for Fmt
import "/big" for BigInt

class Factorial {
    static iterative(n) {
        if (n < 2) return BigInt.one
        var fact = BigInt.one
        for (i in 2..n.toSmall) fact = fact * i
        return fact
    }

    static recursive(n) {
        if (n < 2) return BigInt.one
        return n * recursive(n-1)
    }
}

var n = BigInt.new(24)
Fmt.print("Factorial(%(n)) iterative -> $,s", Factorial.iterative(n))
Fmt.print("Factorial(%(n)) recursive -> $,s", Factorial.recursive(n))


global factorial
section .text

; Input in ECX register (greater than 0!)
; Output in EAX register
factorial:
  mov   eax, 1
.factor:
  mul   ecx
  loop  .factor
  ret


entropy: function [s][
    t: #[]
    loop s 'c [
        unless key? t c -> t\[c]: 0
        t\[c]: t\[c] + 1
    ]
    result: new 0
    loop values t 'x ->
        'result - (x//(size s)) * log x//(size s) 2

    return result
]

print entropy "1223334444"


MsgBox, % Entropy(1223334444)

Entropy(n)
{
    a := [], len := StrLen(n), m := n
    while StrLen(m)
    {
        s := SubStr(m, 1, 1)
        m := RegExReplace(m, s, "", c)
        a[s] := c
    }
    for key, val in a
    {
        m := Log(p := val / len)
        e -= p * m / Log(2)
    }
    return, e
}


use Lingua::EN::Numbers;

sub esthetic($base = 10) {
    my @s = ^$base .map: -> \s {
        ((s - 1).base($base) if s > 0), ((s + 1).base($base) if s < $base - 1)
    }

    flat [ (1 .. $base - 1)».base($base) ],
    { [ flat .map: { $_ xx * Z~ flat @s[.comb.tail.parse-base($base)] } ] } … *
}

for 2 .. 16 -> $b {
    put "\n{(4 × $b).&ordinal-digit} through {(6 × $b).&ordinal-digit} esthetic numbers in base $b";
    put esthetic($b)[(4 × $b - 1) .. (6 × $b - 1)]».fmt('%3s').batch(16).join: "\n"
}

my @e10 = esthetic;
put "\nBase 10 esthetic numbers between 1,000 and 9,999:";
put @e10.&between(1000, 9999).batch(20).join: "\n";

put "\nBase 10 esthetic numbers between {1e8.Int.&comma} and {1.3e8.Int.&comma}:";
put @e10.&between(1e8.Int, 1.3e8.Int).batch(9).join: "\n";

sub between (@array, Int $lo, Int $hi) {
    my $top = @array.first: * > $hi, :k;
    @array[^$top].grep: * > $lo
}


(defun my-evenp (x)
    (= (logand x 1) 0) )

(defun my-oddp (x)
    (/= (logand x 1) 0) )


For num As Integer = 1 To 5
  If num Mod 2 = 0 Then
    MsgBox(Str(num) + " is even.")
  Else
    MsgBox(Str(num) + " is odd.")
  End If
Next


include c:\cxpl\codes;
int I;
[for I:= -4 to +3 do
        [IntOut(0, I);
        Text(0, if I&1 then " is odd   " else " is even  ");
        Text(0, if rem(I/2)#0 then "odd" else "even");
        CrLf(0);
        ];
]


Double ← 2⊸×
Halve ← ⌊÷⟜2
Odd ← 2⊸|

EMul ← {
  times ← ↕⌈2⋆⁼𝕨
  +´(Odd Halve⍟times 𝕨)/Double⍟times 𝕩
}

17 EMul 34


#include <stdio.h>
#include <stdbool.h>

void halve(int *x) { *x >>= 1; }
void doublit(int *x)  { *x <<= 1; }
bool iseven(const int x) { return (x & 1) ==  0; }

int ethiopian(int plier,
	      int plicand, const bool tutor)
{
  int result=0;

  if (tutor)
    printf("ethiopian multiplication of %d by %d\n", plier, plicand);

  while(plier >= 1) {
    if ( iseven(plier) ) {
      if (tutor) printf("%4d %6d struck\n", plier, plicand);
    } else {
      if (tutor) printf("%4d %6d kept\n", plier, plicand);
      result += plicand;
    }
    halve(&plier); doublit(&plicand);
  }
  return result;
}

int main()
{
  printf("%d\n", ethiopian(17, 34, true));
  return 0;
}


def (fib n)
  if (n < 2)
    n
    (+ (fib n-1) (fib n-2))


procedure Empty_String is

   function Is_Empty(S: String) return Boolean is
   begin
      return S = ""; -- test that S is empty
   end Is_Empty;

   Empty: String := ""; -- Assign empty string
   XXXXX: String := "Not Empty";

begin
   if (not Is_Empty(Empty)) or Is_Empty(XXXXX) then
      raise Program_Error with "something went wrong very very badly!!!";
   end if;
end Empty_String;


# declare a string variable and assign an empty string to it                  #
STRING s := "";

# test the string is empty                                                    #
IF s = "" THEN write( ( "s is empty", newline ) ) FI;

# test the string is not empty                                                #
IF s /= "" THEN write( ( "s is not empty", newline ) ) FI;

# as a string is an array of characters, we could also test for emptyness by  #
# checking for lower bound > upper bound                                      #
IF LWB s > UPB s THEN write( ( "s is still empty", newline ) ) FI


(defun factorial (x)
	(if (< x 0)
		nil
		(if (<= x 1)
			1
			(* x (factorial (- x 1))) ) ) )


/*REXX pgm lists a bunch of esthetic numbers in bases 2 ──► 16, & base 10 in two ranges.*/
parse arg baseL baseH range                      /*obtain optional arguments from the CL*/
if baseL=='' | baseL==","  then baseL= 2         /*Not specified?  Then use the default.*/
if baseH=='' | baseH==","  then baseH=16         /* "      "         "   "   "     "    */
if range=='' | range==","  then range=1000..9999 /* "      "         "   "   "     "    */

     do radix=baseL  to baseH;  #= 0;  if radix<2  then iterate    /*process the bases. */
     start= radix * 4;                  stop = radix * 6
     $=;               do i=1  until #==stop;  y= base(i, radix)   /*convert I to base Y*/
                       if \esthetic(y, radix)  then iterate        /*not esthetic?  Skip*/
                       #= # + 1;   if #<start  then iterate        /*is  #  below range?*/
                       $= $ y                                      /*append # to $ list.*/
                       end   /*i*/
     say
     say center(' base '  radix",  the" th(start)   '──►'   th(stop) ,
                "esthetic numbers ",  max(80, length($) - 1),  '─')
     say strip($)
     end   /*radix*/
say;                                                                            g= 25
parse var  range   start  '..'  stop
say center(' base 10 esthetic numbers between' start "and" stop '(inclusive) ', g*5-1,"─")
                                                                 #= 0;        $=
     do k=start  to  stop;  if \esthetic(k, 10)  then iterate;   #= # + 1;    $= $ k
     if #//g==0  then do;   say strip($);  $=;   end
     end   /*k*/
say strip($);               say;                 say #   ' esthetic numbers listed.'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
PorA:  _= pos(z, @u);   p= substr(@u, _-1, 1);   a= substr(@u, _+1, 1);     return
th: parse arg th; return th || word('th st nd rd', 1+(th//10)*(th//100%10\==1)*(th//10<4))
vv: parse arg v,_;   vr= x2d(v) + _;   if vr==-1  then vr= r;               return d2x(vr)
/*──────────────────────────────────────────────────────────────────────────────────────*/
base: procedure expose @u;  arg x 1 #,toB,inB,,y /*Y  is assigned a  "null"  value.     */
      if tob==''  then tob= 10                   /*maybe assign a default for TObase.   */
      if inb==''  then inb= 10                   /*  "      "   "    "     "  INbase.   */
      @l= '0123456789abcdef';  @u= @l;  upper @u /*two versions of hexadecimal digits.  */
      if inB\==10  then do;   #= 0               /*only convert if  not  base 10.       */
                           do j=1  for length(x) /*convert  X:   base inB  ──► base 10. */
                           #= # * inB + pos(substr(x, j, 1), @u) -1  /*build new number.*/
                           end    /*j*/          /* [↑]  this also verifies digits.     */
                        end
      if toB==10   then return #                 /*if TOB is ten,  then simply return #.*/
         do  while  # >= toB                     /*convert #:    base 10  ──►  base toB.*/
         y= substr(@l, (# // toB) + 1, 1)y       /*construct the output number.         */
         #= # % toB                              /*      ··· and whittle  #  down also. */
         end    /*while*/                        /* [↑]  algorithm may leave a residual.*/
      return substr(@l, # + 1, 1)y               /*prepend the residual, if any.        */
/*──────────────────────────────────────────────────────────────────────────────────────*/
esthetic: procedure expose @u; arg x,r;       L= length(x);       if L==1  then return 1
          if x<2  then return 0
                 do d=0  to r-1;  _= d2x(d);        if pos(_ || _, x)\==0  then return 0
                 end   /*d*/                     /* [↑]  check for a duplicated digits. */
            do j=1  for L;  @.j= substr(x, j, 1) /*assign (base) digits to stemmed array*/
            end   /*j*/
          if L==2  then do;  z= @.1;   call PorA;      if @.2==p | @.2==a  then nop
                                                                           else return 0
                        end
            do e=2  to L-1;  z= @.e;   pe= e - 1;      ae= e + 1
            if (z==vv(@.pe,-1)|z==vv(@.pe,1))&(z==vv(@.ae,-1)|z==vv(@.ae,1))  then iterate
            return 0
            end   /*e*/;         return 1


for i = -5 to 5
    print i, and(i,1), mod(i,2)
next


[-3..4].pump(fcn(n){ println(n," is ",n.isEven and "even" or "odd") })


using System;
using System.Linq;

namespace RosettaCode.Tasks
{
	public static class EthiopianMultiplication_Task
	{
		public static void Test ( )
		{
			Console.WriteLine ( "Ethiopian Multiplication" );
			int A = 17, B = 34;
			Console.WriteLine ( "Recursion: {0}*{1}={2}", A, B, EM_Recursion ( A, B ) );
			Console.WriteLine ( "Linq: {0}*{1}={2}", A, B, EM_Linq ( A, B ) );
			Console.WriteLine ( "Loop: {0}*{1}={2}", A, B, EM_Loop ( A, B ) );
			Console.WriteLine ( );
		}

		public static int Halve ( this int p_Number )
		{
			return p_Number >> 1;
		}
		public static int Double ( this int p_Number )
		{
			return p_Number << 1;
		}
		public static bool IsEven ( this int p_Number )
		{
			return ( p_Number % 2 ) == 0;
		}

		public static int EM_Recursion ( int p_NumberA, int p_NumberB )
		{
			//     Anchor Point,                Recurse to find the next row                                 Sum it with the second number according to the rules
			return p_NumberA == 1 ? p_NumberB : EM_Recursion ( p_NumberA.Halve ( ), p_NumberB.Double ( ) ) + ( p_NumberA.IsEven ( ) ? 0 : p_NumberB );
		}
		public static int EM_Linq ( int p_NumberA, int p_NumberB )
		{
			// Creating a range from 1 to x where x the number of times p_NumberA can be halved.
			// This will be 2^x where 2^x <= p_NumberA. Basically, ln(p_NumberA)/ln(2).
			return Enumerable.Range ( 1, Convert.ToInt32 ( Math.Log ( p_NumberA, Math.E ) / Math.Log ( 2, Math.E ) ) + 1 )
				// For every item (Y) in that range, create a new list, comprising the pair (p_NumberA,p_NumberB) Y times.
				.Select ( ( item ) => Enumerable.Repeat ( new { Col1 = p_NumberA, Col2 = p_NumberB }, item )
					// The aggregate method iterates over every value in the target list, passing the accumulated value and the current item's value.
					.Aggregate ( ( agg_pair, orig_pair ) => new { Col1 = agg_pair.Col1.Halve ( ), Col2 = agg_pair.Col2.Double ( ) } ) )
				// Remove all even items
				.Where ( pair => !pair.Col1.IsEven ( ) )
				// And sum!
				.Sum ( pair => pair.Col2 );
		}
		public static int EM_Loop ( int p_NumberA, int p_NumberB )
		{
			int RetVal = 0;
			while ( p_NumberA >= 1 )
			{
				RetVal += p_NumberA.IsEven ( ) ? 0 : p_NumberB;
				p_NumberA = p_NumberA.Halve ( );
				p_NumberB = p_NumberB.Double ( );
			}
			return RetVal;
		}
	}
}


String.isBlank(record.txt_Field__c);
--Returns true if the specified String is white space, empty (''), or null; otherwise, returns false.


      ⍝⍝ Assign empty string to A
      A ← ''
      0 = ⍴∊ A
1
      ~0 = ⍴∊ A
0


-- assign empty string to str
set str to ""

-- check if string is empty
if str is "" then
	-- str is empty
end if
-- or
if id of str is {} then
	-- str is empty
end if
-- or
if (count of str) is 0 then
	-- str is empty
end if

-- check if string is not empty
if str is not "" then
	-- string is not empty
end if
-- or
if id of str is not {} then
	-- str is not empty
end if
-- or
if (count of str) is not 0 then
	-- str is not empty
end if


func FactIter(N);       \Factorial of N using iterative method
int N;                  \range: 0..12
int F, I;
[F:= 1;
for I:= 2 to N do F:= F*I;
return F;
];

func FactRecur(N);      \Factorial of N using recursive method
int N;                  \range: 0..12
return if N<2 then 1 else N*FactRecur(N-1);


// recursive
sub factorial(n)
    if n > 1 then return n * factorial(n - 1) else return 1 end if
end sub

//iterative
sub factorial2(n)
    local i, t

    t = 1
    for i = 1 to n
        t = t * i
    next
    return t
end sub

for n = 0 to 9
    print "Factorial(", n, ") = ", factorial(n)
next


REM >entropy
PRINT FNentropy("1223334444")
END
:
DEF FNentropy(x$)
LOCAL unique$, count%, n%, ratio(), u%, i%, j%
unique$ = ""
n% = LEN x$
FOR i% = 1 TO n%
  IF INSTR(unique$, MID$(x$, i%, 1)) = 0 THEN unique$ += MID$(x$, i%, 1)
NEXT
u% = LEN unique$
DIM ratio(u% - 1)
FOR i% = 1 TO u%
  count% = 0
  FOR j% = 1 TO n%
    IF MID$(unique$, i%, 1) = MID$(x$, j%, 1) THEN count% += 1
  NEXT
  ratio(i% - 1) = (count% / n%) * FNlogtwo(count% / n%)
NEXT
= -SUM(ratio())
:
DEF FNlogtwo(n)
= LN n / LN 2


org $0801                                                      ;start assembling at this address
db $0E,$08,$0A,$00,$9E,$20,$28,$32,$30,$36,$34,$29,$00,$00,$00 ;required init code
rts                                                            ;return to basic


basePlus = []
decList = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
baseList = ["0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"]

for base = 2 to 16
    see "Base " + base + ": " + (base*4) + "th to " + (base*6) + "th esthetic numbers:" + nl
    res = 0
    binList = []
for n = 1 to 10000
    str = decimaltobase(n,base)
    limit1 = base*4
    limit2 = base*6
    ln = len(str)
    flag = 0
    for m = 1 to ln-1
        nr1 = str[m]
        ind1 = find(baseList,nr1)
        num1 = decList[ind1]
        nr2 = str[m+1]
        ind2 = find(baseList,nr2)
        num2 = decList[ind2]
        num = num1-num2
        if num = 1 or num = -1
           flag = flag + 1
        ok
     next
     if flag = ln - 1
        res = res + 1
        if res > (limit1 - 1) and res < (limit2 + 1)
           see " " + str
        ok
        if base = 10 and number(str) > 1000 and number(str) < 9999
           add(basePlus,str)
        ok
     ok
next
see nl + nl
next

see "Base 10: " + len(basePlus) +" esthetic numbers between 1000 and 9999:"

for row = 1 to len(basePlus)
    if (row-1) % 16 = 0
       see nl
    else
       see " " + basePlus[row]
    ok
next

func decimaltobase(nr,base)
     binList = []
     binary = 0
     remainder = 1
     while(nr != 0)
          remainder = nr % base
          ind = find(decList,remainder)
          rem = baseList[ind]
          add(binList,rem)
          nr = floor(nr/base)
     end
     binlist = reverse(binList)
     binList = list2str(binList)
     binList = substr(binList,nl,"")
     return binList


def isEsthetic(n, b)
    if n == 0 then
        return false
    end

    i = n % b
    n2 = (n / b).floor
    while n2 > 0
        j = n2 % b
        if (i - j).abs != 1 then
            return false
        end
        n2 = n2 / b
        i = j
    end
    return true
end

def listEsths(n, n2, m, m2, perLine, all)
    esths = Array.new
    dfs = lambda {|n, m, i|
        if n <= i and i <= m then
            esths << i
        end
        if i == 0 or i > m then
            return
        end
        d = i % 10
        i1 = i * 10 + d - 1
        i2 = i1 + 2
        if d == 0 then
            dfs[n, m, i2]
        elsif d == 9 then
            dfs[n, m, i1]
        else
            dfs[n, m, i1]
            dfs[n, m, i2]
        end
    }

    for i in 0..9
        dfs[n2, m2, i]
    end

    le = esths.length
    print "Base 10: %d esthetic numbers between %d and %d:\n" % [le, n, m]
    if all then
        esths.each_with_index { |esth, idx|
            print "%d " % [esth]
            if (idx + 1) % perLine == 0 then
                print "\n"
            end
        }
        print "\n"
    else
        for i in 0 .. perLine - 1
            print "%d " % [esths[i]]
        end
        print "\n............\n"
        for i in le - perLine .. le - 1
            print "%d " % [esths[i]]
        end
        print "\n"
    end
    print "\n"
end

def main
    for b in 2..16
        print "Base %d: %dth to %dth esthetic numbers:\n" % [b, 4 * b, 6 * b]
        n = 1
        c = 0
        while c < 6 * b
            if isEsthetic(n, b) then
                c = c + 1
                if c >= 4 * b then
                    print "%s " % [n.to_s(b)]
                end
            end
            n = n + 1
        end
        print "\n"
    end
    print "\n"

    listEsths(1000, 1010, 9999, 9898, 16, true)
    listEsths(1e8, 101010101, 13 * 1e7, 123456789, 9, true)
    listEsths(1e11, 101010101010, 13 * 1e10, 123456789898, 7, false)
    listEsths(1e14, 101010101010101, 13 * 1e13, 123456789898989, 5, false)
    listEsths(1e17, 101010101010101010, 13 * 1e16, 123456789898989898, 4, false)
end

main()


program: even_or_odd
  case: 1
        input: 2
        output: even
  case: 2
        input: 4
        output: even
  case: 3
        input: 1
        output: odd
  case: 4
        input: 7
        output: odd


module Main;
var
	x: integer;
	s: set;
begin
	x := 10;writeln(x:3," is odd?",odd(x));
	s := set(s);writeln(x:3," is odd?",0 in s); (* check right bit *)
	x := 11;writeln(x:3," is odd?",odd(x));
	s := set(x);writeln(x:3," is odd?",0 in s); (* check right bit *)
end Main.


10 FOR n=-3 TO 4: GO SUB 30: NEXT n
20 STOP
30 LET odd=FN m(n,2)
40 PRINT n;" is ";("Even" AND odd=0)+("Odd" AND odd=1)
50 RETURN
60 DEF FN m(a,b)=a-INT (a/b)*b


template<int N>
struct Half
{
        enum { Result = N >> 1 };
};

template<int N>
struct Double
{
        enum { Result = N << 1 };
};

template<int N>
struct IsEven
{
        static const bool Result = (N & 1) == 0;
};

template<int Multiplier, int Multiplicand>
struct EthiopianMultiplication
{
        template<bool Cond, int Plier, int RunningTotal>
        struct AddIfNot
        {
                enum { Result = Plier + RunningTotal };
        };
        template<int Plier, int RunningTotal>
        struct AddIfNot <true, Plier, RunningTotal>
        {
                enum { Result = RunningTotal };
        };

        template<int Plier, int Plicand, int RunningTotal>
        struct Loop
        {
                enum { Result = Loop<Half<Plier>::Result, Double<Plicand>::Result,
                       AddIfNot<IsEven<Plier>::Result, Plicand, RunningTotal >::Result >::Result };
        };
        template<int Plicand, int RunningTotal>
        struct Loop <0, Plicand, RunningTotal>
        {
                enum { Result = RunningTotal };
        };

        enum { Result = Loop<Multiplier, Multiplicand, 0>::Result };
};

#include <iostream>

int main(int, char **)
{
        std::cout << EthiopianMultiplication<17, 54>::Result << std::endl;
        return 0;
}


   (func $fibonacci_nth (param $n i32) (result i32)

       ;;Declare some local registers
       (local $i i32)
       (local $a i32)
       (local $b i32)

       ;;Handle first 2 numbers as special cases
       (if (i32.eq (get_local $n) (i32.const 0))
           (return (i32.const 0))
       )
       (if (i32.eq (get_local $n) (i32.const 1))
           (return (i32.const 1))
       )

       ;;Initialize first two values
       (set_local $i (i32.const 1))
       (set_local $a (i32.const 0))
       (set_local $b (i32.const 1))

       (block
           (loop
               ;;Add two previous numbers and store the result
               local.get $a
               local.get $b
               i32.add
               (set_local $a (get_local $b))
               set_local $b

               ;;Increment counter i by one
               (set_local $i
                   (i32.add
                       (get_local $i)
                       (i32.const 1)
                   )
               )

               ;;Check if loop is done
               (br_if 1 (i32.ge_u (get_local $i) (get_local $n)))
               (br 0)
           )
       )

       ;;The result is stored in b, so push that to the stack
       get_local $b
   )


/* ARM assembly Raspberry PI  */
/*  program strEmpty.s   */

/* Constantes    */
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall
/* Initialized data */
.data
szNotEmptyString:   .asciz "String is not empty. \n"
szEmptyString:      .asciz "String is empty. \n"
@ empty string
szString:            .asciz ""   @ with zero final
szString1:           .asciz "A"  @ with zero final

/* UnInitialized data */
.bss

/*  code section */
.text
.global main
main:                /* entry of program  */
    push {fp,lr}    /* saves 2 registers */

    @ load string
    ldr r1,iAdrszString
    ldrb r0,[r1]    @ load first byte of string
    cmp r0,#0        @ compar with zero ?
    bne 1f
    ldr r0,iAdrszEmptyString
    bl affichageMess
    b 2f
1:

    ldr r0,iAdrszNotEmptyString
    bl affichageMess
	/* second string */
2:
    @ load string 1
    ldr r1,iAdrszString1
    ldrb r0,[r1]        @ load first byte of string
    cmp r0,#0            @ compar with zero ?
    bne 3f
    ldr r0,iAdrszEmptyString
    bl affichageMess
    b 100f
3:
    ldr r0,iAdrszNotEmptyString
    bl affichageMess
    b 100f

100:   /* standard end of the program */
    mov r0, #0                  @ return code
    pop {fp,lr}                 @restaur 2 registers
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call
iAdrszString:             .int szString
iAdrszString1:            .int szString1
iAdrszNotEmptyString:   .int szNotEmptyString
iAdrszEmptyString:       .int szEmptyString

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {fp,lr}    			/* save  registres */
    push {r0,r1,r2,r7}    		/* save others registers */
    mov r2,#0   				/* counter length */
1:      	/* loop length calculation */
    ldrb r1,[r0,r2]  			/* read octet start position + index */
    cmp r1,#0       			/* if 0 its over */
    addne r2,r2,#1   			/* else add 1 in the length */
    bne 1b          			/* and loop */
                                /* so here r2 contains the length of the message */
    mov r1,r0        			/* address message in r1 */
    mov r0,#STDOUT      		/* code to write to the standard output Linux */
    mov r7, #WRITE             /* code call system "write" */
    swi #0                      /* call systeme */
    pop {r0,r1,r2,r7}     		/* restaur others registers */
    pop {fp,lr}    				/* restaur des  2 registres */
    bx lr	        			/* return  */


const stdout = @import("std").io.getStdOut().outStream();

pub fn factorial(comptime Num: type, n: i8) ?Num {
    return if (@typeInfo(Num) != .Int)
        @compileError("factorial called with num-integral type: " ++ @typeName(Num))
    else if (n < 0)
        null
    else calc: {
        var i: i8 = 1;
        var fac: Num = 1;
        while (i <= n) : (i += 1) {
            if (@mulWithOverflow(Num, fac, i, &fac))
                break :calc null;
        } else break :calc fac;
    };
}

pub fn main() !void {
    try stdout.print("-1! = {}\n", .{factorial(i32, -1)});
    try stdout.print("0! = {}\n", .{factorial(i32, 0)});
    try stdout.print("5! = {}\n", .{factorial(i32, 5)});
    try stdout.print("33!(64 bit) = {}\n", .{factorial(i64, 33)}); // not vailid i64 factorial
    try stdout.print("33! = {}\n", .{factorial(i128, 33)}); // biggest facorial possible
    try stdout.print("34! = {}\n", .{factorial(i128, 34)}); // will overflow
}


fcn fact(n){[2..n].reduce('*,1)}
fcn factTail(n,N=1) {  // tail recursion
   if (n == 0) return(N);
   return(self.fcn(n-1,n*N));
}


#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <string.h>
#include <math.h>

#define MAXLEN 100 //maximum string length

int makehist(unsigned char *S,int *hist,int len){
	int wherechar[256];
	int i,histlen;
	histlen=0;
	for(i=0;i<256;i++)wherechar[i]=-1;
	for(i=0;i<len;i++){
		if(wherechar[(int)S[i]]==-1){
			wherechar[(int)S[i]]=histlen;
			histlen++;
		}
		hist[wherechar[(int)S[i]]]++;
	}
	return histlen;
}

double entropy(int *hist,int histlen,int len){
	int i;
	double H;
	H=0;
	for(i=0;i<histlen;i++){
		H-=(double)hist[i]/len*log2((double)hist[i]/len);
	}
	return H;
}

int main(void){
	unsigned char S[MAXLEN];
	int len,*hist,histlen;
	double H;
	scanf("%[^\n]",S);
	len=strlen(S);
	hist=(int*)calloc(len,sizeof(int));
	histlen=makehist(S,hist,len);
	//hist now has no order (known to the program) but that doesn't matter
	H=entropy(hist,histlen,len);
	printf("%lf\n",H);
	return 0;
}


.model small  ;.exe file
.stack 1024   ;this value doesn't matter, I chose this arbitrarily
.data
              ;not needed in an empty program
.code
mov ax,4C00h
int 21h       ;exit this program and return to MS-DOS


.text
.global _start

_start:
        mov x0, #0
        mov x8, #93
        svc #0


// [dependencies]
// radix_fmt = "1.0"

// Returns the next esthetic number in the given base after n, where n is an
// esthetic number in that base or one less than a power of base.
fn next_esthetic_number(base: u64, n: u64) -> u64 {
    if n + 1 < base {
        return n + 1;
    }
    let mut a = n / base;
    let mut b = a % base;
    if n % base + 1 == b && b + 1 < base {
        return n + 2;
    }
    a = next_esthetic_number(base, a);
    b = a % base;
    a * base + if b == 0 { 1 } else { b - 1 }
}

fn print_esthetic_numbers(min: u64, max: u64, numbers_per_line: usize) {
    let mut numbers = Vec::new();
    let mut n = next_esthetic_number(10, min - 1);
    while n <= max {
        numbers.push(n);
        n = next_esthetic_number(10, n);
    }
    let count = numbers.len();
    println!(
        "Esthetic numbers in base 10 between {} and {} ({}):",
        min, max, count
    );
    if count > 200 {
        for i in 0..numbers_per_line {
            if i != 0 {
                print!(" ");
            }
            print!("{}", numbers[i]);
        }
        println!("\n............\n");
        for i in 0..numbers_per_line {
            if i != 0 {
                print!(" ");
            }
            print!("{}", numbers[count - numbers_per_line + i]);
        }
        println!();
    } else {
        for i in 0..count {
            print!("{}", numbers[i]);
            if (i + 1) % numbers_per_line == 0 {
                println!();
            } else {
                print!(" ");
            }
        }
        if count % numbers_per_line != 0 {
            println!();
        }
    }
}

fn main() {
    for base in 2..=16 {
        let min = base * 4;
        let max = base * 6;
        println!(
            "Esthetic numbers in base {} from index {} through index {}:",
            base, min, max
        );
        let mut n = 0;
        for index in 1..=max {
            n = next_esthetic_number(base, n);
            if index >= min {
                print!("{} ", radix_fmt::radix(n, base as u8));
            }
        }
        println!("\n");
    }

    let mut min = 1000;
    let mut max = 9999;
    print_esthetic_numbers(min, max, 16);
    println!();

    min = 100000000;
    max = 130000000;
    print_esthetic_numbers(min, max, 8);
    println!();

    for i in 0..3 {
        min *= 1000;
        max *= 1000;
        let numbers_per_line = match i {
            0 => 7,
            1 => 5,
            _ => 4,
        };
        print_esthetic_numbers(min, max, numbers_per_line);
        println!();
    }
}