func generate_esthetic(root, upto, callback, b=10) {

    var v = root.digits2num(b)

    return nil if (v > upto)
    callback(v)

    var t = root.head

    __FUNC__([t+1, root...], upto, callback, b) if (t+1  < b)
    __FUNC__([t-1, root...], upto, callback, b) if (t-1 >= 0)
}

func between_esthetic(from, upto, b=10) {
    gather {
        for k in (1..^b) {
            generate_esthetic([k], upto, { take(_) if (_ >= from) }, b)
        }
    }.sort
}

func first_n_esthetic(n, b=10) {
    for (var m = n**2; true ; m *= b) {
        var list = between_esthetic(1, m, b)
        return list.first(n) if (list.len >= n)
    }
}

for b in (2..16) {
    say "\n#{b}-esthetic numbers with indices #{4*b}..#{6*b}: "
    say first_n_esthetic(6*b, b).last(6*b - 4*b + 1).map{.base(b)}.join(' ')
}

say "\nBase 10 esthetic numbers between 1,000 and 9,999:"
between_esthetic(1e3, 1e4).slices(20).each { .join(' ').say }

say "\nBase 10 esthetic numbers between 100,000,000 and 130,000,000:"
between_esthetic(1e8, 13e7).slices(9).each { .join(' ').say }


(defn halve [n]
  (bit-shift-right n 1))

(defn twice [n]          ; 'double' is taken
  (bit-shift-left n 1))

(defn even [n]           ; 'even?' is the standard fn
  (zero? (bit-and n 1)))

(defn emult [x y]
  (reduce +
    (map second
      (filter #(not (even (first %))) ; a.k.a. 'odd?'
        (take-while #(pos? (first %))
          (map vector
            (iterate halve x)
            (iterate twice y)))))))

(defn emult2 [x y]
  (loop [a x, b y, r 0]
    (if (= a 1)
      (+ r b)
      (if (even a)
        (recur (halve a) (twice b) r)
        (recur (halve a) (twice b) (+ r b))))))


halve = proc (n: int) returns (int)
    return(n/2)
end halve

double = proc (n: int) returns (int)
    return(n*2)
end double

even = proc (n: int) returns (bool)
    return(n//2 = 0)
end even

e_mul = proc (a, b: int) returns (int)
    total: int := 0

    while (a > 0) do
        if ~even(a) then total := total + b end
        a := halve(a)
        b := double(b)
    end

    return(total)
end e_mul

start_up = proc ()
    po: stream := stream$primary_output()
    stream$putl(po, int$unparse(e_mul(17, 34)))
end start_up


s: ""

if empty? s     -> print "the string is empty"
if 0 = size s   -> print "yes, the string is empty"

s: "hello world"

if not? empty? s    -> print "the string is not empty"
if 0 < size s       -> print "no, the string is not empty"


string c;		//implicitly assigned an empty string
if (length(c) == 0) {
  write("Empty string");
} else {
  write("Non empty string");
}

string s = "";		//explicitly assigned an empty string
if (s == "")  {
  write("Empty string");
}
if (s != "")  {
  write("Non empty string");
}

string t = "not empty";
if (t != "")  {
  write("Non empty string");
} else {
  write("Empty string");
}


using System;
using System.Collections.Generic;
namespace Entropy
{
	class Program
	{
		public static double logtwo(double num)
		{
			return Math.Log(num)/Math.Log(2);
		}
		public static void Main(string[] args)
		{
		label1:
			string input = Console.ReadLine();
			double infoC=0;
			Dictionary<char,double> table = new Dictionary<char, double>();

			foreach (char c in input)
			{
				if (table.ContainsKey(c))
					table[c]++;
				    else
				    	table.Add(c,1);

			}
			double freq;
			foreach (KeyValuePair<char,double> letter in table)
			{
				freq=letter.Value/input.Length;
				infoC+=freq*logtwo(freq);
			}
			infoC*=-1;
			Console.WriteLine("The Entropy of {0} is {1}",input,infoC);
			goto label1;

		}
	}
}


extension Sequence {
  func take(_ n: Int) -> [Element] {
    var res = [Element]()

    for el in self {
      guard res.count != n else {
        return res
      }

      res.append(el)
    }

    return res
  }
}

extension String {
  func isEsthetic(base: Int = 10) -> Bool {
    zip(dropFirst(0), dropFirst())
      .lazy
      .allSatisfy({ abs(Int(String($0.0), radix: base)! - Int(String($0.1), radix: base)!) == 1 })
  }
}

func getEsthetics(from: Int, to: Int, base: Int = 10) -> [String] {
  guard base >= 2, to >= from else {
    return []
  }

  var start = ""
  var end = ""

  repeat {
    if start.count & 1 == 1 {
      start += "0"
    } else {
      start += "1"
    }
  } while Int(start, radix: base)! < from

  let digiMax = String(base - 1, radix: base)
  let lessThanDigiMax = String(base - 2, radix: base)
  var count = 0

  repeat {
    if count != base - 1 {
      end += String(count + 1, radix: base)
      count += 1
    } else {
      if String(end.last!) == digiMax {
        end += lessThanDigiMax
      } else {
        end += digiMax
      }
    }
  } while Int(end, radix: base)! < to

  if Int(start, radix: base)! >= Int(end, radix: base)! {
    return []
  }

  var esthetics = [Int]()

  func shimmer(_ n: Int, _ m: Int, _ i: Int) {
    if (n...m).contains(i) {
      esthetics.append(i)
    } else if i == 0 || i > m {
      return
    }

    let d = i % base
    let i1 = i &* base &+ d &- 1
    let i2 = i1 &+ 2

    if (i1 < i || i2 < i) {
      // overflow
      return
    }

    switch d {
    case 0: shimmer(n, m, i2)
    case base-1: shimmer(n, m, i1)
    case _:
      shimmer(n, m, i1)
      shimmer(n, m, i2)
    }
  }

  for digit in 0..<base {
    shimmer(Int(start, radix: base)!, Int(end, radix: base)!, digit)
  }

  return esthetics.filter({ $0 <= to }).map({ String($0, radix: base) })
}

for base in 2...16 {
  let esthetics = (0...)
    .lazy
    .map({ String($0, radix: base) })
    .filter({ $0.isEsthetic(base: base) })
    .dropFirst(base * 4)
    .take((base * 6) - (base * 4) + 1)

  print("Base \(base) esthetics from \(base * 4) to \(base * 6)")
  print(esthetics)
  print()
}

let base10Esthetics = (1000...9999).filter({ String($0).isEsthetic() })

print("\(base10Esthetics.count) esthetics between 1000 and 9999:")
print(base10Esthetics)
print()

func printSlice(of array: [String]) {
  print(array.take(5))
  print("...")
  print(Array(array.lazy.reversed().take(5).reversed()))
  print("\(array.count) total\n")
}

print("Esthetics between \(Int(1e8)) and \(13 * Int(1e7)):")
printSlice(of: getEsthetics(from: Int(1e8), to: 13 * Int(1e7)))

print("Esthetics between \(Int(1e11)) and \(13 * Int(1e10))")
printSlice(of: getEsthetics(from: Int(1e11), to: 13 * Int(1e10)))

print("Esthetics between \(Int(1e14)) and \(13 * Int(1e13)):")
printSlice(of: getEsthetics(from: Int(1e14), to: 13 * Int(1e13)))

print("Esthetics between \(Int(1e17)) and \(13 * Int(1e16)):")
printSlice(of: getEsthetics(from: Int(1e17), to: 13 * Int(1e16)))


import "./fmt" for Conv, Fmt

var isEsthetic = Fn.new { |n, b|
    if (n == 0) return false
    var i = n % b
    n = (n/b).floor
    while (n > 0) {
        var j = n % b
        if ((i - j).abs != 1) return false
        n = (n/b).floor
        i = j
    }
    return true
}

var esths = []

var dfs  // recursive function
dfs = Fn.new { |n, m, i|
    if (i >= n && i <= m) esths.add(i)
    if (i == 0 || i > m) return
    var d = i % 10
    var i1 = i*10 + d - 1
    var i2 = i1 + 2
    if (d == 0) {
        dfs.call(n, m, i2)
    } else if (d == 9) {
        dfs.call(n, m, i1)
    } else {
        dfs.call(n, m, i1)
        dfs.call(n, m, i2)
    }
}

var listEsths = Fn.new { |n, n2, m, m2, perLine, all|
    esths.clear()
    for (i in 0..9) dfs.call(n2, m2, i)
    var le = esths.count
    Fmt.print("Base 10: $,d esthetic numbers between $,d and $,d", le, n, m)
    if (all) {
        var c = 0
        for (esth in esths) {
            System.write("%(esth) ")
            if ((c+1)%perLine == 0) System.print()
            c = c + 1
        }
    } else {
        for (i in 0...perLine) System.write("%(Conv.dec(esths[i])) ")
        System.print("\n............\n")
        for (i in le-perLine...le) System.write("%(Conv.dec(esths[i])) ")
    }
    System.print("\n")
}

for (b in 2..16) {
    System.print("Base %(b): %(4*b)th to %(6*b)th esthetic numbers:")
    var n = 1
    var c = 0
    while (c < 6*b) {
        if (isEsthetic.call(n, b)) {
            c = c + 1
            if (c >= 4*b) System.write("%(Conv.itoa(n, b)) ")
        }
        n = n + 1
    }
    System.print("\n")
}

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


       *>* Ethiopian multiplication

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ethiopian-multiplication.
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  l                  PICTURE 9(10) VALUE 17.
       01  r                  PICTURE 9(10) VALUE 34.
       01  ethiopian-multiply PICTURE 9(20).
       01  product            PICTURE 9(20).
       PROCEDURE DIVISION.
         CALL "ethiopian-multiply" USING
           BY CONTENT l, BY CONTENT r,
           BY REFERENCE ethiopian-multiply
         END-CALL
         DISPLAY ethiopian-multiply END-DISPLAY
         MULTIPLY l BY r GIVING product END-MULTIPLY
         DISPLAY product END-DISPLAY
         STOP RUN.
       END PROGRAM ethiopian-multiplication.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ethiopian-multiply.
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  evenp   PICTURE 9.
         88 even   VALUE 1.
         88 odd    VALUE 0.
       LINKAGE SECTION.
       01  l       PICTURE 9(10).
       01  r       PICTURE 9(10).
       01  product PICTURE 9(20) VALUE ZERO.
       PROCEDURE DIVISION using l, r, product.
         MOVE ZEROES TO product
         PERFORM UNTIL l EQUAL ZERO
           CALL "evenp" USING
             BY CONTENT l,
             BY REFERENCE evenp
           END-CALL
           IF odd
             ADD r TO product GIVING product END-ADD
           END-IF
           CALL "halve" USING
             BY CONTENT l,
             BY REFERENCE l
           END-CALL
           CALL "twice" USING
             BY CONTENT r,
             BY REFERENCE r
           END-CALL
         END-PERFORM
         GOBACK.
       END PROGRAM ethiopian-multiply.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. halve.
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       LINKAGE SECTION.
       01  n   PICTURE 9(10).
       01  m   PICTURE 9(10).
       PROCEDURE DIVISION USING n, m.
         DIVIDE n BY 2 GIVING m END-DIVIDE
         GOBACK.
       END PROGRAM halve.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. twice.
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       LINKAGE SECTION.
       01  n   PICTURE 9(10).
       01  m   PICTURE 9(10).
       PROCEDURE DIVISION USING n, m.
         MULTIPLY n by 2 GIVING m END-MULTIPLY
         GOBACK.
       END PROGRAM twice.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. evenp.
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  q   PICTURE 9(10).
       LINKAGE SECTION.
       01  n   PICTURE 9(10).
       01  m   PICTURE 9(1).
         88 even   VALUE 1.
         88 odd    VALUE 0.
       PROCEDURE DIVISION USING n, m.
         DIVIDE n BY 2 GIVING q REMAINDER m END-DIVIDE
         SUBTRACT m FROM 1 GIVING m END-SUBTRACT
         GOBACK.
       END PROGRAM evenp.


DEF fib() (
    VAR seq <- [0, 1]; EVERY SUSP seq:values;
    REP SUSP seq:put(seq:pop + seq[1])[-1];
);


;; Traditional
; Assign an empty string:
var =
; Check that a string is empty:
If var =
   MsgBox the var is empty
; Check that a string is not empty
If var !=
   Msgbox the var is not empty

;; Expression mode:
; Assign an empty string:
var := ""
; Check that a string is empty:
If (var = "")
   MsgBox the var is empty
; Check that a string is not empty
If (var != "")
   Msgbox the var is not empty


emptyStringVar : string := "";
Assert: emptyStringVar = "";
Assert: emptyStringVar = <>;
Assert: emptyStringVar is empty;
Assert: |emptyStringVar| = 0;


#!/usr/bin/awk -f
BEGIN {
  # Demonstrate how to assign an empty string to a variable.
  a="";
  b="XYZ";
  print "a = ",a;
  print "b = ",b;
  print "length(a)=",length(a);
  print "length(b)=",length(b);
  # Demonstrate how to check that a string is empty.
  print "Is a empty ?",length(a)==0;
  print "Is a not empty ?",length(a)!=0;
  # Demonstrate how to check that a string is not empty.
  print "Is b empty ?",length(b)==0;
  print "Is b not empty ?",length(b)!=0;
}


#include <string>
#include <map>
#include <iostream>
#include <algorithm>
#include <cmath>

double log2( double number ) {
   return log( number ) / log( 2 ) ;
}

int main( int argc , char *argv[ ] ) {
   std::string teststring( argv[ 1 ] ) ;
   std::map<char , int> frequencies ;
   for ( char c : teststring )
     frequencies[ c ] ++ ;
   int numlen = teststring.length( ) ;
   double infocontent = 0 ;
   for ( std::pair<char , int> p : frequencies ) {
      double freq = static_cast<double>( p.second ) / numlen ;
      infocontent -= freq * log2( freq ) ;
   }

   std::cout << "The information content of " << teststring
      << " is " << infocontent << std::endl ;
   return 0 ;
}


(defn entropy [s]
  (let [len (count s), log-2 (Math/log 2)]
    (->> (frequencies s)
         (map (fn [[_ v]]
                (let [rf (/ v len)]
                  (-> (Math/log rf) (/ log-2) (* rf) Math/abs))))
         (reduce +))))


halve = (n) -> Math.floor n / 2
double = (n) -> n * 2
is_even = (n) -> n % 2 == 0

multiply = (a, b) ->
  prod = 0
  while a > 0
    prod += b if !is_even a
    a = halve a
    b = double b
  prod

# tests
do ->
  for i in [0..100]
    for j in [0..100]
      throw Error("broken for #{i} * #{j}") if multiply(i,j) != i * j


<cffunction name="double">
    <cfargument name="number" type="numeric" required="true">
	<cfset answer = number * 2>
    <cfreturn answer>
</cffunction>

<cffunction name="halve">
    <cfargument name="number" type="numeric" required="true">
	<cfset answer = int(number / 2)>
    <cfreturn answer>
</cffunction>

<cffunction name="even">
    <cfargument name="number" type="numeric" required="true">
	<cfset answer = number mod 2>
    <cfreturn answer>
</cffunction>

<cffunction name="ethiopian">
    <cfargument name="Number_A" type="numeric" required="true">
    <cfargument name="Number_B" type="numeric" required="true">
    <cfset Result = 0>

    <cfloop condition = "Number_A GTE 1">
        <cfif even(Number_A) EQ 1>
            <cfset Result = Result + Number_B>
        </cfif>
        <cfset Number_A = halve(Number_A)>
        <cfset Number_B = double(Number_B)>
    </cfloop>
    <cfreturn Result>
</cffunction>

<cfoutput>#ethiopian(17,34)#</cfoutput>


// iterative (quick)
var fibItr = Fn.new { |n|
    if (n < 2) return n
    var a = 0
    var b = 1
    for (i in 2..n) {
        var c = a + b
        a = b
        b = c
    }
    return b
}

// recursive (slow)
var fibRec
fibRec = Fn.new { |n|
    if (n < 2) return n
    return fibRec.call(n-1) + fibRec.call(n-2)
}

System.print("Iterative: %(fibItr.call(36))")
System.print("Recursive: %(fibRec.call(36))")


""→Str1
!If length(Str1)
 Disp "EMPTY",i
Else
 Disp "NOT EMPTY",i
End


10 LET A$=""
20 IF A$="" THEN PRINT "THE STRING IS EMPTY"
30 IF A$<>"" THEN PRINT "THE STRING IS NOT EMPTY"
40 END


@echo off

::set "var" as a blank string.
set var=

::check if "var" is a blank string.
if not defined var echo Var is a blank string.
::Alternatively,
if %var%@ equ @ echo Var is a blank string.

::check if "var" is not a blank string.
if defined var echo Var is defined.
::Alternatively,
if %var%@ neq @ echo Var is not a blank string.


% NOTE: when compiling with Portable CLU,
% this program needs to be merged with 'useful.lib' to get log()
%
% pclu -merge $CLUHOME/lib/useful.lib -compile entropy.clu

shannon = proc (s: string) returns (real)
    % find the frequency of each character
    freq: array[int] := array[int]$fill(0, 256, 0)
    for c: char in string$chars(s) do
        i: int := char$c2i(c)
        freq[i] := freq[i] + 1
    end

    % calculate the component for each character
    h: real := 0.0
    rlen: real := real$i2r(string$size(s))
    for i: int in array[int]$indexes(freq) do
        if freq[i] ~= 0 then
            f: real := real$i2r(freq[i]) / rlen
            h := h - f * log(f) / log(2.0)
        end
    end
    return (h)
end shannon

start_up = proc ()
    po: stream := stream$primary_output()
    stream$putl(po, f_form(shannon("1223334444"), 1, 6))
end start_up


entropy = (s) ->
    freq = (s) ->
        result = {}
        for ch in s.split ""
            result[ch] ?= 0
            result[ch]++
        return result

    frq = freq s
    n = s.length
    ((frq[f]/n for f of frq).reduce ((e, p) -> e - p * Math.log(p)), 0) * Math.LOG2E

console.log "The entropy of the string '1223334444' is #{entropy '1223334444'}"


.text
    .global _start
_start:
    mov r0, #0
    mov r7, #1
    svc #0


(defun ethiopian-multiply (l r)
  (flet ((halve (n) (floor n 2))
         (double (n) (* n 2))
         (even-p (n) (zerop (mod n 2))))
    (do ((product 0 (if (even-p l) product (+ product r)))
         (l l (halve l))
         (r r (double r)))
        ((zerop l) product))))


int ethiopian(int n1, int n2) pure nothrow @nogc
in {
    assert(n1 >= 0, "Multiplier can't be negative");
} body {
    static enum doubleNum = (in int n) pure nothrow @nogc => n * 2;
    static enum halveNum = (in int n) pure nothrow @nogc => n / 2;
    static enum isEven = (in int n) pure nothrow @nogc => !(n & 1);

    int result;
    while (n1 >= 1) {
        if (!isEven(n1))
            result += n2;
        n1 = halveNum(n1);
        n2 = doubleNum(n2);
    }

    return result;
} unittest {
    assert(ethiopian(77, 54) == 77 * 54);
    assert(ethiopian(8, 923) == 8 * 923);
    assert(ethiopian(64, -4) == 64 * -4);
}

void main() {
    import std.stdio;

    writeln("17 ethiopian 34 is ", ethiopian(17, 34));
}


TITLE i hate visual studio 4			(Fibs.asm)
;       __         __/--------\
;      >__ \      /  |        |\
;         \  \___/ @  \      /   \__________________
;           \____       \  /                         \\\
;                \____         Coded with love by:    |||
;                      \      Alexander Alvonellos    |||
;                       |          9/29/2011         / ||
;                       |                           |  MM
;                       |      |--------------|     |
;                       |<     |              |<    |
;                       |      |              |     |
;                       |mmmmmm|              |mmmmm|
;; Epic Win.

INCLUDE Irvine32.inc

.data
	BEERCOUNT = 48;
	Fibs dd 0, 1, BEERCOUNT DUP(0);

.code
main PROC
; I am not responsible for this code.
; They made me write it, against my will.
	;Here be dragons
	mov esi, offset Fibs; offset array;  ;;were to start (start)
	mov ecx, BEERCOUNT; 		;;count of items (how many)
	mov ebx, 4; 		;;size (in number of bytes)
	call DumpMem;

	mov ecx, BEERCOUNT; 	;//http://www.wolframalpha.com/input/?i=F ib%5B47%5D+%3E+4294967295
	mov esi, offset Fibs
	NextPlease:;
		mov eax, [esi]; 	;//Get me the data from location at ESI
		add eax, [esi+4];	;//add into the eax the data at esi + another double (next mem loc)
		mov [esi+8], eax;	;//Move that data into the memory location after the second number
		add esi, 4;			;//Update the pointer
	loop NextPlease;	;//Thank you sir, may I have another?

	;Here be dragons
	mov esi, offset Fibs; offset array;  ;;were to start (start)
	mov ecx, BEERCOUNT; 		;;count of items (how many)
	mov ebx, 4; 		;;size (in number of bytes)
	call DumpMem;

	exit		; exit to operating system
main ENDP

END main


      REM assign an empty string to a variable:
      var$ = ""

      REM Check that a string is empty:
      IF var$ = "" THEN PRINT "String is empty"

      REM Check that a string is not empty:
      IF var$ <> "" THEN PRINT "String is not empty"


•Show ""
•Show 0 = ≠ ""
•Show 0 ≠ ≠ ""
•Show "" ≡ ⟨⟩


( :?a
& (b=)
& abra:?c
& (d=cadabra)
& !a:           { a is empty string }
& !b:           { b is also empty string }
& !c:~          { c is not an empty string }
& !d:~          { neither is d an empty string }
)


(defun entropy (string)
  (let ((table (make-hash-table :test 'equal))
        (entropy 0))
    (mapc (lambda (c) (setf (gethash c table) (+ (gethash c table 0) 1)))
          (coerce string 'list))
    (maphash (lambda (k v)
               (decf entropy (* (/ v (length input-string))
                                (log (/ v (length input-string)) 2))))
             table)
    entropy))


# Method to calculate sum of Float64 array
def sum(array : Array(Float64))
  res = 0
  array.each do |n|
    res += n
  end
  res
end

# Method to calculate which char appears how often
def histogram(source : String)
  hist = {} of Char => Int32
  l = 0
  source.each_char do |e|
    if !hist.has_key? e
      hist[e] = 0
    end
    hist[e] += 1
  end
  return Tuple.new(source.size, hist)
end

# Method to calculate entropy from histogram
def entropy(hist : Hash(Char, Int32), l : Int32)
  elist = [] of Float64
  hist.each do |el|
    v = el[1]
    c = v / l
    elist << (-c * Math.log(c, 2))
  end
  return sum elist
end

source = "1223334444"
hist_res = histogram source
l = hist_res[0]
h = hist_res[1]
puts ".[Results]."
puts "Length: " + l.to_s
puts "Entropy: " + (entropy h, l).to_s


0k                    [ Make sure we're doing integer division  ]sx
[ 2 / ] sH            [ Define "halve" function in register H   ]sx
[ 2 * ] sD            [ Define "double" function in register D  ]sx
[ 2 % 1 r - ] sE      [ Define "even?" function in register E   ]sx

[ Entry into the main Ethiopian multiplication function is register M ]sx
[ Keeps running value for the product in register p ]sx
[ 0 sp lLx lp ] sM

[ The body of the main loop is in register L ]sx

[
  sb sa             [ First thing we do is cheat and store the parameters in
                      registers, which is safe because the only recursion is of
                      the tail variety.  This avoids tricky stack
                      manipulations, which dc doesn't have good support for
                      (unlike, say, Forth). ]sx

  la lEx sr         [ r = even?(a)  ]sx
  lr 0 =S           [ if r = 0 then call s]sx
  la lHx d          [ a = halve(a)]sx
  lb lDx            [ b = double(b)]sx
  r 0 !=L           [ if a !=0 then recurse ]
] sL

[ Utility macro that just adds the current value of b to the total in p ]sx
[ lp lb + sp ]sS

[ Demo by multiplying 17 and 34 ]sx
17 34 lMx p


proc nonrec halve(word n) word:  n >> 1     corp
proc nonrec double(word n) word: n << 1     corp
proc nonrec even(word n) bool:   n & 1 = 0  corp

proc nonrec emul(word a, b) word:
    word total;
    total := 0;
    while a > 0 do
        if not even(a) then total := total + b fi;
        a := halve(a);
        b := double(b)
    od;
    total
corp

proc nonrec main() void: writeln(emul(17, 34)) corp


h#1 h#1 h#1 o#
h#10 o$ p
>f
  o# h#10 o$ p
  ma h? jnext p
  t
jnf


blsq ) ""
""
blsq ) ""nu
1
blsq ) "a"nu
0


#include <string.h>

/* ... */

/* assign an empty string */
const char *str = "";

/* to test a null string */
if (str) { ... }

/* to test if string is empty */
if (str[0] == '\0') { ... }

/* or equivalently use strlen function
   strlen will seg fault on NULL pointer, so check first */
if ( (str == NULL) || (strlen(str) == 0)) { ... }

/* or compare to a known empty string, same thing. "== 0" means strings are equal */
if (strcmp(str, "") == 0) { ... }


using System;

class Program {
    static void Main (string[] args) {
        string example = string.Empty;
        if (string.IsNullOrEmpty(example)) { }
        if (!string.IsNullOrEmpty(example)) { }
    }
}


import std.stdio, std.algorithm, std.math;

double entropy(T)(T[] s)
pure nothrow if (__traits(compiles, s.sort())) {
    immutable sLen = s.length;
    return s
           .sort()
           .group
           .map!(g => g[1] / double(sLen))
           .map!(p => -p * p.log2)
           .sum;
}

void main() {
    "1223334444"d.dup.entropy.writeln;
}


program Entropytest;

uses
  StrUtils,
  Math;

type
  FArray = array of CARDINAL;

var
  strng: string = '1223334444';

// list unique characters in a string
function uniquechars(str: string): string;
var
  n: CARDINAL;
begin
  Result := '';
  for n := 1 to length(str) do
    if (PosEx(str[n], str, n) > 0) and (PosEx(str[n], Result, 1) = 0) then
      Result := Result + str[n];
end;

// obtain a list of character-frequencies for a string
//  given a string containing its unique characters
function frequencies(str, ustr: string): FArray;
var
  u, s, p, o: CARDINAL;
begin
  SetLength(Result, Length(ustr) + 1);
  p := 0;
  for u := 1 to length(ustr) do
    for s := 1 to length(str) do
    begin
      o := p;
      p := PosEx(ustr[u], str, s);
      if (p > o) then
        INC(Result[u]);
    end;
end;

// Obtain the Shannon entropy of a string
function entropy(s: string): EXTENDED;
var
  pf: FArray;
  us: string;
  i, l: CARDINAL;
begin
  us := uniquechars(s);
  pf := frequencies(s, us);
  l := length(s);
  Result := 0.0;
  for i := 1 to length(us) do
    Result := Result - pf[i] / l * log2(pf[i] / l);
end;

begin
  Writeln('Entropy of "', strng, '" is ', entropy(strng): 2: 5, ' bits.');
  readln;
end.


def halve(&x)  { x //= 2 }
def double(&x) { x *= 2 }
def even(x)    { return x %% 2 <=> 0 }

def multiply(var a, var b) {
    var ab := 0
    while (a > 0) {
        if (!even(a)) { ab += b }
        halve(&a)
        double(&b)
    }
    return ab
}


(DEFUN FIBONACCI (N)
    (FLOOR (+ (/ (EXPT (/ (+ (SQRT 5) 1) 2) N) (SQRT 5)) 0.5)))


#include <string>

// ...

                     // empty string declaration
std::string str;     // (default constructed)
std::string str();   // (default constructor, no parameters)
std::string str{};   // (default initialized)
std::string str(""); // (const char[] conversion)
std::string str{""}; // (const char[] initializer list)

if (str.empty()) { ... } // to test if string is empty

// we could also use the following
if (str.length() == 0) { ... }
if (str == "") { ... }

// make a std::string empty
str.clear();          // (builtin clear function)
str = "";             // replace contents with empty string
str = {};             // swap contents with temp string (empty),then destruct temp

                       // swap with empty string
std::string tmp{};     // temp empty string
str.swap(tmp);         // (builtin swap function)
std::swap(str, tmp);   // swap contents with tmp

// create an array of empty strings
std::string  s_array[100];           // 100 initialized to "" (fixed size)
std::array<std::string, 100>  arr;   // 100 initialized to "" (fixed size)
std::vector<std::string>(100,"");    // 100 initialized to "" (variable size, 100 starting size)

// create empty string as default parameter
void func( std::string& s = {} ); // {} generated default std:string instance


EMPTYSTR
    ; Demonstrate how to assign an empty string to a variable.
    set x = ""

      ; Demonstrate how to check that a string is empty.
      ; Length 0 is empty; equality/pattern check are 1=T, 0=F
      write !,"Assigned x to null value.  Tests: "
      write !,"String length: "_$length(x)_", Equals null: "_(x = "")_", Empty pattern: "_(x?."")    ; length 0 is empty

      ; Demonstrate how to check that a string is not empty.  Same as above.
      set x = " "    ;assign to a space - not null
      write !!,"Assigned x to a single blank space.  Tests: "
      write !,"String length: "_$length(x)_", Equals null: "_(x = "")_", Empty pattern: "_(x?."")

      quit


(lib 'hash)
;; counter: hash-table[key]++
(define (count++ ht k )
(hash-set ht k (1+ (hash-ref! ht k 0))))

(define (hi count n )
	(define pi (// count n))
	(- (* pi (log2 pi))))

;; (H [string|list]) → entropy (bits)
(define (H info)
	(define S (if(string? info) (string->list info) info))
	(define ht (make-hash))
	(define n (length S))

	(for ((s S)) (count++ ht s))
	(for/sum ((s (make-set S)))  (hi (hash-ref ht s) n)))


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

extension op
{
    logTwo()
        = self.ln() / 2.ln();
}

public program()
{
    var input := console.readLine();
    var infoC := 0.0r;
    var table := Dictionary.new();

    input.forEach:(ch)
    {
        var n := table[ch];
        if (nil == n)
        {
            table[ch] := 1
        }
        else
        {
            table[ch] := n + 1
        }
    };

    var freq := 0;
    table.forEach:(letter)
    {
        freq := letter.toInt().realDiv(input.Length);

        infoC += (freq * freq.logTwo())
    };

    infoC *= -1;

    console.printLine("The Entropy of ", input, " is ", infoC)
}


x = 17
y = 34
tot = 0
while x >= 1
  write x
  write "\t"
  if (x + 1) mod 2 = 0
    tot += y
    print y
  else
    print ""
  .
  x = x div 2
  y = 2 * y
.
write "=\t"
print tot


class
	APPLICATION

create
	make

feature {NONE}

	make
		do
			io.put_integer (ethiopian_multiplication (17, 34))
		end

	ethiopian_multiplication (a, b: INTEGER): INTEGER
			-- Product of 'a' and 'b'.
		require
			a_positive: a > 0
			b_positive: b > 0
		local
			x, y: INTEGER
		do
			x := a
			y := b
			from
			until
				x <= 0
			loop
				if not is_even_int (x) then
					Result := Result + y
				end
				x := halve_int (x)
				y := double_int (y)
			end
		ensure
			Result_correct: Result = a * b
		end

feature {NONE}

	double_int (n: INTEGER): INTEGER
                        --Two times 'n'.
		do
			Result := n * 2
		end

	halve_int (n: INTEGER): INTEGER
                        --'n' divided by two.
		do
			Result := n // 2
		end

	is_even_int (n: INTEGER): BOOLEAN
                        --Is 'n' an even integer?
		do
			Result := n \\ 2 = 0
		end

end


Function fibo(n As Integer) As UInt64

  Dim noOne As UInt64 = 1
  Dim noTwo As UInt64 = 1
  Dim sum As UInt64

  For i As Integer = 3 To n
      sum = noOne + noTwo
      noTwo = noOne
      noOne = sum
  Next

  Return noOne
End Function


(def x "") ;x is "globally" declared to be the empty string
(let [x ""]
  ;x is bound to the empty string within the let
  )
(= x "")    ;true if x is the empty string
(not= x "") ;true if x is not the empty string


       IDENTIFICATION DIVISION.
       PROGRAM-ID.    EMPTYSTR.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  str                     PIC X(10).

       PROCEDURE DIVISION.
       Begin.

*     *    Assign an empty string.
           INITIALIZE str.

*     *    Or
           MOVE " " TO str.

           IF (str = " ")
              DISPLAY "String is empty"
           ELSE
              DISPLAY "String is not empty"
           END-IF.

           STOP RUN.


defmodule RC do
  def entropy(str) do
    leng = String.length(str)
    String.graphemes(str)
    |> Enum.group_by(&(&1))
    |> Enum.map(fn{_,value} -> length(value) end)
    |> Enum.reduce(0, fn count, entropy ->
         freq = count / leng
         entropy - freq * :math.log2(freq)
       end)
  end
end

IO.inspect RC.entropy("1223334444")


(defun shannon-entropy (input)
  (let ((freq-table (make-hash-table))
	(entropy 0)
	(length (+ (length input) 0.0)))
    (mapcar (lambda (x)
	      (puthash x
		       (+ 1 (gethash x freq-table 0))
		       freq-table))
	    input)
    (maphash (lambda (k v)
	       (set 'entropy (+ entropy
			     (* (/ v length)
				(log (/ v length) 2)))))
	     freq-table)
  (- entropy)))


open list number

halve x = x `div` 2
double = (2*)

ethiopicmult a b = sum <| map snd <| filter (odd << fst) <| zip
  (takeWhile (>=1) <| iterate halve a)
  (iterate double b)

ethiopicmult 17 34


defmodule Ethiopian do
  def halve(n), do: div(n, 2)

  def double(n), do: n * 2

  def even(n), do: rem(n, 2) == 0

  def multiply(lhs, rhs) when is_integer(lhs) and lhs > 0 and is_integer(rhs) and rhs > 0 do
    multiply(lhs, rhs, 0)
  end

  def multiply(1, rhs, acc), do: rhs + acc
  def multiply(lhs, rhs, acc) do
    if even(lhs), do:   multiply(halve(lhs), double(rhs), acc),
                  else: multiply(halve(lhs), double(rhs), acc+rhs)
  end
end

IO.inspect Ethiopian.multiply(17, 34)


(defun even-p (n)
  (= (mod n 2) 0))
(defun halve (n)
  (floor n 2))
(defun double (n)
  (* n 2))
(defun ethiopian-multiplication (l r)
  (let ((sum 0))
    (while (>= l 1)
      (unless (even-p l)
	(setq sum (+ r sum)))
      (setq l (halve l))
      (setq r (double r)))
    sum))


func Fib1(N);   \Return Nth Fibonacci number using iteration
int N;
int Fn, F0, F1;
[F0:= 0;  F1:= 1;  Fn:= N;
while N > 1 do
        [Fn:= F0 + F1;
        F0:= F1;
        F1:= Fn;
        N:= N-1;
        ];
return Fn;
];

func Fib2(N);   \Return Nth Fibonacci number using recursion
int N;
return if N < 2 then N else Fib2(N-1) + Fib2(N-2);

int N;
[for N:= 0 to 20 do [IntOut(0, Fib1(N));  ChOut(0, ^ )];
 CrLf(0);
 for N:= 0 to 20 do [IntOut(0, Fib2(N));  ChOut(0, ^ )];
 CrLf(0);
]


isEmptyString = (s) ->
  # Returns true iff s is an empty string.
  # (This returns false for non-strings as well.)
  return true if s instanceof String and s.length == 0
  s == ''

empties = ["", '', new String()]
non_empties = [new String('yo'), 'foo', {}]
console.log (isEmptyString(v) for v in empties) # [true, true, true]
console.log (isEmptyString(v) for v in non_empties) # [false, false, false]
console.log (s = '') == "" # true
console.log new String() == '' # false, due to underlying JavaScript's distinction between objects and primitives


(defparameter *s* "") ;; Binds dynamic variable *S* to the empty string ""
(let ((s "")) ;; Binds the lexical variable S to the empty string ""
  (= (length s) 0) ;; Check if the string is empty
  (> (length s) 0)) ;; Check if length of string is over 0 (that is: non-empty)


MODULE EmptyString;
IMPORT StdLog;

PROCEDURE Do*;
VAR
	s: ARRAY 64 OF CHAR;
	(* s := "" <=> s[0] := 0X => s isEmpty*)
BEGIN
	s := "";
	StdLog.String("Is 's' empty?:>  ");StdLog.Bool(s = "");StdLog.Ln;
	StdLog.String("Is not 's' empty?:> ");StdLog.Bool(s # "");StdLog.Ln;
	StdLog.Ln;
	(* Or *)
	s := 0X;
	StdLog.String("Is 's' empty?:>  ");StdLog.Bool(s = 0X);StdLog.Ln;
	StdLog.String("Is not 's' empty?:> ");StdLog.Bool(s # 0X);StdLog.Ln;
	StdLog.Ln;
END Do;
END EmptyString.


-module( entropy ).

-export( [shannon/1, task/0] ).

shannon( String ) -> shannon_information_content( lists:foldl(fun count/2, dict:new(), String), erlang:length(String) ).

task() -> shannon( "1223334444" ).

count( Character, Dict ) -> dict:update_counter( Character, 1, Dict ).

shannon_information_content( Dict, String_length ) ->
	{_String_length, Acc} = dict:fold( fun shannon_information_content/3, {String_length, 0.0}, Dict ),
	Acc / math:log( 2 ).

shannon_information_content( _Character, How_many, {String_length, Acc} ) ->
        Frequency = How_many / String_length,
	{String_length, Acc - (Frequency * math:log(Frequency))}.


-module(ethopian).
-export([multiply/2]).

halve(N) ->
    N div 2.

double(N) ->
    N * 2.

even(N) ->
    (N rem 2) == 0.

multiply(LHS,RHS) when is_integer(Lhs) and Lhs > 0 and
			is_integer(Rhs) and Rhs > 0 ->
    multiply(LHS,RHS,0).

multiply(1,RHS,Acc) ->
    RHS+Acc;
multiply(LHS,RHS,Acc) ->
    case even(LHS) of
        true ->
            multiply(halve(LHS),double(RHS),Acc);
        false ->
            multiply(halve(LHS),double(RHS),Acc+RHS)
    end.


declare function local:fib($n as xs:integer) as xs:integer {
  if($n < 2)
  then $n
  else local:fib($n - 1) + local:fib($n - 2)
};


import std.array;

bool isEmptyNotNull(in string s) pure nothrow @safe {
    return s is "";
}

void main(){
    string s1 = null;
    string s2 = "";

    // the content is the same
    assert(!s1.length);
    assert(!s2.length);
    assert(s1 == "" && s1 == null);
    assert(s2 == "" && s2 == null);
    assert(s1 == s2);

    // but they don't point to the same memory region
    assert(s1 is null && s1 !is "");
    assert(s2 is "" && s2 !is null);
    assert(s1 !is s2);
    assert(s1.ptr == null);
    assert(*s2.ptr == '\0'); // D string literals are \0 terminated

    assert(s1.empty);
    assert(s2.isEmptyNotNull());
}


main() {
  var empty = '';

  if (empty.isEmpty) {
    print('it is empty');
  }

  if (empty.isNotEmpty) {
    print('it is not empty');
  }
}


>function entropy (s) ...
$  v=strtochar(s);
$  m=getmultiplicities(unique(v),v);
$  m=m/sum(m);
$  return sum(-m*logbase(m,2))
$endfunction
>entropy("1223334444")
 1.84643934467


open System

let ld x = Math.Log x / Math.Log 2.

let entropy (s : string) =
    let n = float s.Length
    Seq.groupBy id s
    |> Seq.map (fun (_, vals) -> float (Seq.length vals) / n)
    |> Seq.fold (fun e p -> e - p * ld p) 0.

printfn "%f" (entropy "1223334444")


PROGRAM ETHIOPIAN_MULT

FUNCTION EVEN(A)
   EVEN=(A+1) MOD 2
END FUNCTION

FUNCTION HALF(A)
   HALF=INT(A/2)
END FUNCTION

FUNCTION DOUBLE(A)
   DOUBLE=2*A
END FUNCTION

BEGIN
   X=17 Y=34 TOT=0
   WHILE X>=1 DO
     PRINT(X,)
     IF EVEN(X)=0 THEN TOT=TOT+Y PRINT(Y) ELSE PRINT END IF
     X=HALF(X) Y=DOUBLE(Y)
   END WHILE
   PRINT("=",TOT)
END PROGRAM


function emHalf(integer n)
  return floor(n/2)
end function

function emDouble(integer n)
  return n*2
end function

function emIsEven(integer n)
  return (remainder(n,2) = 0)
end function

function emMultiply(integer a, integer b)
 integer sum
  sum = 0
  while (a) do
    if (not emIsEven(a)) then sum += b end if
    a = emHalf(a)
    b = emDouble(b)
  end while

  return sum
end function

----------------------------------------------------------------
-- runtime

printf(1,"emMultiply(%d,%d) = %d\n",{17,34,emMultiply(17,34)})

printf(1,"\nPress Any Key\n",{})
while (get_key() = -1) do end while


sub fibonacci (n)
    n1 = 0
    n2 = 1
    for k = 1 to abs(n)
        sum = n1 + n2
        n1 = n2
        n2 = sum
    next k
    if n < 0 then
       return n1 * ((-1) ^ ((-n) + 1))
    else
       return n1
    end if
end sub


program EmptyString;

{$APPTYPE CONSOLE}

uses SysUtils;

function StringIsEmpty(const aString: string): Boolean;
begin
  Result := aString = '';
end;

var
  s: string;
begin
  s := '';
  Writeln(StringIsEmpty(s)); // True

  s := 'abc';
  Writeln(StringIsEmpty(s)); // False
end.


var s : String;

s := ''; // assign an empty string (can also use "")

if s = '' then
   PrintLn('empty');

s := 'hello';

if s <> '' then
   PrintLn('not empty');


USING: assocs kernel math math.functions math.statistics
prettyprint sequences ;
IN: rosetta-code.entropy

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

"1223334444" shannon-entropy .
"Factor is my favorite programming language." shannon-entropy .


: flog2 ( f -- f ) fln 2e fln f/ ;

create freq 256 cells allot

: entropy ( str len -- f )
  freq 256 cells erase
  tuck
  bounds do
    i [email protected] cells freq +
    1 swap +!
  loop
  0e
  256 0 do
    i cells freq + @ ?dup if
      s>f dup s>f f/
      fdup flog2 f* f-
    then
  loop
  drop ;

s" 1223334444" entropy f.     \ 1.84643934467102  ok


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Tue May 21 21:43:12
!
!a=./f && make $a && OMP_NUM_THREADS=2 $a 1223334444
!gfortran -std=f2008 -Wall -ffree-form -fall-intrinsics f.f08 -o f
! Shannon entropy of 1223334444 is    1.84643936
!
!Compilation finished at Tue May 21 21:43:12

program shannonEntropy
  implicit none
  integer :: num, L, status
  character(len=2048) :: s
  num = 1
  call get_command_argument(num, s, L, status)
  if ((0 /= status) .or. (L .eq. 0)) then
    write(0,*)'Expected a command line argument with some length.'
  else
    write(6,*)'Shannon entropy of '//(s(1:L))//' is ', se(s(1:L))
  endif

contains
  !     algebra
  !
  ! 2**x = y
  ! x*log(2) = log(y)
  ! x = log(y)/log(2)

  !   NB. The j solution
  !   entropy=:  +/@:[email protected](* 2&^.)@(#/.~ % #)
  !   entropy '1223334444'
  !1.84644

  real function se(s)
    implicit none
    character(len=*), intent(in) :: s
    integer, dimension(256) :: tallies
    real, dimension(256) :: norm
    tallies = 0
    call TallyKey(s, tallies)
    ! J's #/. works with the set of items in the input.
    ! TallyKey is sufficiently close that, with the merge, gets the correct result.
    norm = tallies / real(len(s))
    se = sum(-(norm*log(merge(1.0, norm, norm .eq. 0))/log(2.0)))
  end function se

  subroutine TallyKey(s, counts)
    character(len=*), intent(in) :: s
    integer, dimension(256), intent(out) :: counts
    integer :: i, j
    counts = 0
    do i=1,len(s)
      j = iachar(s(i:i))
      counts(j) = counts(j) + 1
    end do
  end subroutine TallyKey

end program shannonEntropy


let ethopian n m =
    let halve n = n / 2
    let double n = n * 2
    let even n = n % 2 = 0
    let rec loop n m result =
        if n <= 1 then result + m
        else if even n then loop (halve n) (double m) result
        else loop (halve n) (double m) (result + m)
    loop n m 0


USING: arrays kernel math multiline sequences ;
IN: ethiopian-multiplication

/*
This function is built-in
: odd? ( n -- ? ) 1 bitand 1 number= ;
*/

: double ( n -- 2*n ) 2 * ;
: halve ( n -- n/2 ) 2 /i ;

: ethiopian-mult ( a b -- a*b )
    [ 0 ] 2dip
    [ dup 0 > ] [
        [ odd? [ + ] [ drop ] if ] 2keep
        [ double ] [ halve ] bi*
    ] while 2drop ;


local :e ""

if not e:
    !print "an empty string"

if e:
    !print "not an empty string"


a$ = ""
if a$ = ""
  print "empty"
.
if a$ <> ""
  print "no empty"
.


' version 25-06-2015
' compile with: fbc -s console

Sub calc_entropy(source As String, base_ As Integer)

    Dim As Integer i, sourcelen = Len(source), totalchar(255)
    Dim As Double prop, entropy

    For i = 0 To sourcelen -1
        totalchar(source[i]) += 1
    Next

    Print "Char    count"
    For i = 0 To 255
        If totalchar(i) = 0 Then Continue For
        Print "   "; Chr(i); Using "   ######"; totalchar(i)
        prop = totalchar(i) / sourcelen
        entropy = entropy - (prop * Log (prop) / Log(base_))
    Next

    Print : Print "The Entropy of "; Chr(34); source; Chr(34); " is"; entropy

End Sub

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

calc_entropy("1223334444", 2)
Print

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


function entropy
    for arg in $argv
        set name count_$arg
        if not count $$name > /dev/null
            set $name 0
            set values $values $arg
        end
        set $name (math $$name + 1)
    end
    set entropy 0
    for value in $values
        set name count_$value
        set entropy (echo "
            scale = 50
            p = "$$name" / "(count $argv)"
            $entropy - p * l(p)
        " | bc -l)
    end
    echo "$entropy / l(2)" | bc -l
end
entropy (echo 1223334444 | fold -w1)


[2/]h:
[2*]d:
[$2/2*-]o:
[0[@$][$o;![@@\[email protected][email protected]]?h;[email protected];[email protected]]#%\%]m:
17 34m;!.  {578}


: even? ( n -- ? ) 1 and 0= ;
: e* ( x y -- x*y )
  dup 0= if nip exit then
  over 2* over 2/ recurse
  swap even? if nip else + then ;


program EthiopicMult
  implicit none

  print *, ethiopic(17, 34, .true.)

contains

  subroutine halve(v)
    integer, intent(inout) :: v
    v = int(v / 2)
  end subroutine halve

  subroutine doublit(v)
    integer, intent(inout) :: v
    v = v * 2
  end subroutine doublit

  function iseven(x)
    logical :: iseven
    integer, intent(in) :: x
    iseven = mod(x, 2) == 0
  end function iseven

  function ethiopic(multiplier, multiplicand, tutorialized) result(r)
    integer :: r
    integer, intent(in) :: multiplier, multiplicand
    logical, intent(in), optional :: tutorialized

    integer :: plier, plicand
    logical :: tutor

    plier = multiplier
    plicand = multiplicand

    if ( .not. present(tutorialized) ) then
       tutor = .false.
    else
       tutor = tutorialized
    endif

    r = 0

    if ( tutor ) write(*, '(A, I0, A, I0)') "ethiopian multiplication of ", plier, " by ", plicand

    do while(plier >= 1)
       if ( iseven(plier) ) then
          if (tutor) write(*, '(I4, " ", I6, A)') plier, plicand, " struck"
       else
          if (tutor) write(*, '(I4, " ", I6, A)') plier, plicand, " kept"
          r = r + plicand
       endif
       call halve(plier)
       call doublit(plicand)
    end do

  end function ethiopic

end program EthiopicMult


10 REM Only positive numbers
20 LET n=10
30 LET n1=0: LET n2=1
40 FOR k=1 TO n
50 LET sum=n1+n2
60 LET n1=n2
70 LET n2=sum
80 NEXT k
90 PRINT n1


import extensions;

public program()
{
    auto s := emptyString;

    if (s.isEmpty())
        { console.printLine("'", s, "' is empty") };

    if (s.isNonempty())
        { console.printLine("'", s, "' is not empty") }
}


empty_string = ""
not_empty_string = "a"

empty_string == ""
# => true
String.length(empty_string) == 0
# => true
byte_size(empty_string) == 0
# => true

not_empty_string == ""
# => false
String.length(not_empty_string) == 0
# => false
byte_size(not_empty_string) == 0
# => false


(setq str "")   ;; empty string literal

(if (= 0 (length str))
    (message "string is empty"))
(if (/= 0 (length str))
    (message "string is not empty"))


package main

import (
    "fmt"
    "math"
    "strings"
)

func main(){
    fmt.Println(H("1223334444"))
}

func H(data string) (entropy float64) {
    if data == "" {
        return 0
    }
    for i := 0; i < 256; i++ {
        px := float64(strings.Count(data, string(byte(i)))) / float64(len(data))
        if px > 0 {
	    entropy += -px * math.Log2(px)
	}
    }
    return entropy
}


package main

import "fmt"

func halve(i int) int { return i/2 }

func double(i int) int { return i*2 }

func isEven(i int) bool { return i%2 == 0 }

func ethMulti(i, j int) (r int) {
    for ; i > 0; i, j = halve(i), double(j) {
        if !isEven(i) {
            r += j
        }
    }
    return
}

func main() {
    fmt.Printf("17 ethiopian 34 = %d\n", ethMulti(17, 34))
}


1> S = "". % erlang strings are actually lists, so the empty string is the same as the empty list [].
[]
2> length(S).
0
3> case S of [] -> empty; [H|T] -> not_empty end.
empty
4> case "aoeu" of [] -> empty; [H|T] -> not_empty end.
not_empty


sequence s

-- assign an empty string
s = ""

-- another way to assign an empty string
s = {} -- "" and {} are equivalent

if not length(s) then
    -- string is empty
end if

if length(s) then
    -- string is not empty
end if


open System

[<EntryPoint>]
let main args =
    let emptyString = String.Empty  // or any of the literals "" @"" """"""
    printfn "Is empty %A: %A" emptyString (emptyString = String.Empty)
    printfn "Is not empty %A: %A" emptyString (emptyString <> String.Empty)
    0


String.metaClass.getShannonEntrophy = {
    -delegate.inject([:]) { map, v -> map[v] = (map[v] ?: 0) + 1; map }.values().inject(0.0) { sum, v ->
        def p = (BigDecimal)v / delegate.size()
        sum + p * Math.log(p) / Math.log(2)
    }
}


import Data.List

main = print $ entropy "1223334444"

entropy :: (Ord a, Floating c) => [a] -> c
entropy = sum . map lg . fq . map genericLength . group . sort
  where lg c = -c * logBase 2 c
        fq c = let sc = sum c in map (/ sc) c


T64K  [ set load point ]
GK    [ set base address ]
ZF    [ stop ]
EZPF  [ begin at load point ]


package programs;

program Empty_program type BasicProgram {}
	function main()
	end
end


import Prelude hiding (odd)
import Control.Monad (join)

halve :: Int -> Int
halve = (`div` 2)

double :: Int -> Int
double = join (+)

odd :: Int -> Bool
odd = (== 1) . (`mod` 2)

ethiopicmult :: Int -> Int -> Int
ethiopicmult a b =
  sum $
  map snd $
  filter (odd . fst) $
  zip (takeWhile (>= 1) $ iterate halve a) (iterate double b)

main :: IO ()
main = print $ ethiopicmult 17 34 == 17 * 34


   WRITE(Messagebox) ethiopian( 17, 34 )
END ! of "main"

FUNCTION ethiopian(x, y)
    ethiopian = 0
    left = x
    right = y
    DO i = x, 1, -1
      IF( isEven(left) == 0 ) ethiopian = ethiopian + right
      IF( left == 1 ) RETURN
      left = halve(left)
      right = double(right)
    ENDDO
 END

FUNCTION halve( x )
    halve = INT( x/2 )
 END

FUNCTION double( x )
    double = 2 * x
 END

FUNCTION isEven( x )
    isEven = MOD(x, 2) == 0
 END


a := ""       // assign an empty string to 'a'
a.isEmpty     // method on sys::Str to check if string is empty
a.size == 0   // what isEmpty actually checks
a == ""       // alternate check for an empty string
!a.isEmpty    // check that a string is not empty


\ string words operate on the address and count left on the stack by a string
\ ? means the word returns a true/false flag on the stack

: empty? ( c-addr u -- ? ) nip 0= ;
: filled?  ( c-addr u -- ? ) empty? 0= ;
: =""      ( c-addr u -- ) drop 0 ;  \ It's OK to copy syntax from other languages


      SUBROUTINE TASTE(T)
       CHARACTER*(*) T       !This form allows for any size.
        IF (LEN(T).LE.0) WRITE(6,*) "Empty!"
        IF (LEN(T).GT.0) WRITE(6,*) "Not empty!"
      END
      CHARACTER*24 TEXT
      CALL TASTE("")
      CALL TASTE("This")
      TEXT = ""              !Fills the entire variable with space characters.
      CALL TASTE(TEXT)       !Passes all 24 of them. Result is Not empty!
      END


procedure main(a)
    s := !a | "1223334444"
    write(H(s))
end

procedure H(s)
    P := table(0.0)
    every P[!s] +:= 1.0/*s
    every (h := 0.0) -:= P[c := key(P)] * log(P[c],2)
    return h
end


entropy=:  +/@([email protected]* 2&^.)@(#/.~ % #)


class
    ROOT

create
    make

feature
    make
        do

        end
end


--Language prints the text in " "
import Html
main =
 Html.text"empty"


procedure main(arglist)
while ethiopian(integer(get(arglist)),integer(get(arglist)))  # multiply successive pairs of command line arguments
end

procedure ethiopian(i,j)                                      # recursive Ethiopian multiplication
return ( if not even(i) then j                                # this exploits that icon control expressions return values
         else 0 ) +
       ( if i ~= 0 then ethiopian(halve(i),double(j))
         else 0 )
end

procedure double(i)
return i * 2
end

procedure halve(i)
return i / 2
end

procedure even(i)
return ( i % 2 = 0, i )
end


double =:  2&*
halve  =:  %&2           NB.  or the primitive  -:
odd    =:  2&|

ethiop =:  +/@([email protected]] # (double~ <@#)) (1>.<[email protected])^:a:


' FB 1.05.0 Win64

Sub IsEmpty(s As String)
   If Len(s) = 0 Then
     Print "String is empty"
   Else
     Print "String is not empty"
   End If
End Sub

Dim s As String  ' implicitly assigned an empty string
IsEmpty(s)
Dim t As String = "" ' explicitly assigned an empty string
IsEmpty(t)
Dim u As String = "not empty"
IsEmpty(u)
Sleep


a = ""
if a == ""
   println["empty"]

if a != ""
   println["Not empty"]


import java.lang.Math;
import java.util.Map;
import java.util.HashMap;

public class REntropy {

  @SuppressWarnings("boxing")
  public static double getShannonEntropy(String s) {
    int n = 0;
    Map<Character, Integer> occ = new HashMap<>();

    for (int c_ = 0; c_ < s.length(); ++c_) {
      char cx = s.charAt(c_);
      if (occ.containsKey(cx)) {
        occ.put(cx, occ.get(cx) + 1);
      } else {
        occ.put(cx, 1);
      }
      ++n;
    }

    double e = 0.0;
    for (Map.Entry<Character, Integer> entry : occ.entrySet()) {
      char cx = entry.getKey();
      double p = (double) entry.getValue() / n;
      e += p * log2(p);
    }
    return -e;
  }

  private static double log2(double a) {
    return Math.log(a) / Math.log(2);
  }
  public static void main(String[] args) {
    String[] sstr = {
      "1223334444",
      "1223334444555555555",
      "122333",
      "1227774444",
      "aaBBcccDDDD",
      "1234567890abcdefghijklmnopqrstuvwxyz",
      "Rosetta Code",
    };

    for (String ss : sstr) {
      double entropy = REntropy.getShannonEntropy(ss);
      System.out.printf("Shannon entropy of %40s: %.12f%n", "\"" + ss + "\"", entropy);
    }
    return;
  }
}


CREATE COMPUTE MODULE ESQL_Compute
  CREATE FUNCTION Main() RETURNS BOOLEAN
  BEGIN
    RETURN TRUE;
  END;
END MODULE;


import java.util.HashMap;
import java.util.Map;
import java.util.Scanner;
public class Mult{
  public static void main(String[] args){
    Scanner sc = new Scanner(System.in);
    int first = sc.nextInt();
    int second = sc.nextInt();

    if(first < 0){
        first = -first;
        second = -second;
    }

    Map<Integer, Integer> columns = new HashMap<Integer, Integer>();
        columns.put(first, second);
    int sum = isEven(first)? 0 : second;
    do{
      first = halveInt(first);
      second = doubleInt(second);
      columns.put(first, second);
      if(!isEven(first)){
          sum += second;
      }
    }while(first > 1);

    System.out.println(sum);
  }

  public static int doubleInt(int doubleMe){
    return doubleMe << 1; //shift left
  }

  public static int halveInt(int halveMe){
    return halveMe >>> 1; //shift right
  }

  public static boolean isEven(int num){
    return (num & 1) == 0;
  }
}


window 1, @"Empty string", (0,0,480,270)

CFStringRef s

s = @""
if ( fn StringIsEqual( s, @"" ) ) then print @"string is empty"
if ( fn StringLength( s ) == 0 ) then print @"string is empty"
if ( len(s) == 0 ) then print @"string is empty"

print

s = @"Hello"
if ( fn StringIsEqual( s, @"" ) == NO ) then print @"string not empty"
if ( fn StringLength( s ) != 0 ) then print @"string not empty"
if ( len(s) != 0 ) then print @"string not empty"

HandleEvents


Public Sub Main()
Dim sString As String[] = ["", "Hello", "world", "", "Today", "Tomorrow", "", "", "End!"]
Dim sTemp As String
Dim siCount As Short

For Each sTemp In sString
  If sString[siCount] Then
    Print "String " & siCount & " = " & sString[siCount]
  Else
    Print "String " & siCount & " is empty"
  End If
  Inc siCount
Next

End


// define and initialize an empty string
var s string
s2 := ""

// assign an empty string to a variable
s = ""

// check that a string is empty, any of:
s == ""
len(s) == 0

// check that a string is not empty, any of:
s != ""
len(s) != 0 // or > 0


// Shannon entropy in bits per symbol.
function entropy(str) {
  const len = str.length

  // Build a frequency map from the string.
  const frequencies = Array.from(str)
    .reduce((freq, c) => (freq[c] = (freq[c] || 0) + 1) && freq, {})

  // Sum the frequency of each character.
  return Object.values(frequencies)
    .reduce((sum, f) => sum - f/len * Math.log2(f/len), 0)
}

console.log(entropy('1223334444'))        // 1.8464393446710154
console.log(entropy('0'))                 // 0
console.log(entropy('01'))                // 1
console.log(entropy('0123'))              // 2
console.log(entropy('01234567'))          // 3
console.log(entropy('0123456789abcdef'))  // 4


# Input: an array of strings.
# Output: an object with the strings as keys, the values of which are the corresponding frequencies.
def counter:
  reduce .[] as $item ( {}; .[$item] += 1 ) ;

# entropy in bits of the input string
def entropy:
  (explode | map( [.] | implode ) | counter
    | [ .[] | . * log ] | add) as $sum
  | ((length|log) - ($sum / length)) / (2|log) ;


class Main
{
  public static Void main () {}
}


var eth = {

	halve : function ( n ){  return Math.floor(n/2);  },
	double: function ( n ){  return 2*n;              },
	isEven: function ( n ){  return n%2 === 0);       },

	mult: function ( a , b ){
		var sum = 0, a = [a], b = [b];

		while ( a[0] !== 1 ){
			a.unshift( eth.halve( a[0] ) );
			b.unshift( eth.double( b[0] ) );
		}

		for( var i = a.length - 1; i > 0 ; i -= 1 ){

			if( !eth.isEven( a[i] ) ){
				sum += b[i];
			}
		}
		return sum + b[0];
	}
}
// eth.mult(17,34) returns 578


def s = ''  // or "" if you wish
assert s.empty

s = '1 is the loneliest number'
assert !s.empty


10 DIM S1$     'implicitly defined empty string
20 S2$ = ""    'explicitly defined empty string
30 S3$ = "Foo bar baz"
40 S$=S1$ : GOSUB 200
50 S$=S2$ : GOSUB 200
60 S$=S3$ : GOSUB 200
70 END
200 IF LEN(S$)=0 THEN PRINT "Empty string" ELSE PRINT "Non-empty string"
210 RETURN


// in Harbour we have several functions to check emptiness of a string, f.e. hb_IsNull(), Len(), Empty() et.c.,
// we can also use comparison expressions like [cString == ""] and [cString != ""], yet the most convenient
// of them is `Empty()` (but that depends on personal coding style).
cString := ""
? Empty( cString ) // --> TRUE
IF ! Empty( cString ) // --> FALSE
   ? cString
ENDIF


/* Shannon entropy, in Jsish */

function values(obj:object):array {
    var vals = [];
        for (var key in obj) vals.push(obj[key]);
    return vals;
}

function entropy(s) {
    var split = s.split('');
    var counter = {};
    split.forEach(function(ch) {
        if (!counter[ch]) counter[ch] = 1;
        else counter[ch]++;
    });

    var lengthf = s.length * 1.0;
    var counts = values(counter);
    return -1 * counts.map(function(count) {
        return count / lengthf * (Math.log(count / lengthf) / Math.log(2));
        })
        .reduce(function(a, b) { return a + b; }
    );
};

if (Interp.conf('unitTest')) {
;    entropy('1223334444');
;    entropy('Rosetta Code');
;    entropy('password');
}


/* Ethiopian multiplication in Jsish */
var eth = {
    halve : function(n) { return Math.floor(n / 2); },
    double: function(n) { return n << 1;            },
    isEven: function(n) { return n % 2 === 0;       },

    mult: function(a, b){
        var sum = 0;
        a = [a], b = [b];

        while (a[0] !== 1) {
            a.unshift(eth.halve(a[0]));
            b.unshift(eth.double(b[0]));
        }

        for (var i = a.length - 1; i > 0; i -= 1) {
            if(!eth.isEven(a[i])) sum += b[i];
        }
        return sum + b[0];
    }
};

;eth.mult(17,34);

/*
=!EXPECTSTART!=
eth.mult(17,34) ==> 578
=!EXPECTEND!=
*/


halve(x::Integer) = x >> one(x)
double(x::Integer) = Int8(2) * x
even(x::Integer) = x & 1 != 1


import Control.Monad

-- In Haskell strings are just lists (of characters), so we can use the function
-- 'null', which applies to all lists.  We don't want to use the length, since
-- Haskell allows infinite lists.

main = do
  let s = ""
  when (null s) (putStrLn "Empty.")
  when (not $ null s) (putStrLn "Not empty.")


/* assign an empty string */
U8 *str = StrNew("");
/* or */
U8 *str = "";

/* to test if string is empty */
if (StrLen(str) == 0) { ... }
/* or compare to a known empty string. "== 0" means strings are equal */
if (StrCmp(str, "") == 0) { ... }

/* to test if string is not empty */
if (StrLen(str)) { ... }


software {
	s = ""

	// Can either compare the string to an empty string or
	// test if the length is zero.
	if s = "" or #s = 0
		print("Empty string!")
	end

	if s - "" or #s - 0
		print("Not an empty string!")
	end
}


// version 1.0.6

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

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

fun main(args: Array<String>) {
    val samples = arrayOf(
        "1223334444",
        "1223334444555555555",
        "122333",
        "1227774444",
        "aaBBcccDDDD",
        "1234567890abcdefghijklmnopqrstuvwxyz",
        "Rosetta Code"
    )
    println("            String                             Entropy")
    println("------------------------------------      ------------------")
    for (sample in samples) println("${sample.padEnd(36)}  ->  ${"%18.16f".format(shannon(sample))}")
}


// version 1.1.2

fun halve(n: Int) = n / 2

fun double(n: Int) = n * 2

fun isEven(n: Int) = n % 2 == 0

fun ethiopianMultiply(x: Int, y: Int): Int {
    var xx = x
    var yy = y
    var sum = 0
    while (xx >= 1) {
       if (!isEven(xx)) sum += yy
       xx = halve(xx)
       yy = double(yy)
    }
    return sum
}

fun main(args: Array<String>) {
    println("17 x 34 = ${ethiopianMultiply(17, 34)}")
    println("99 x 99 = ${ethiopianMultiply(99, 99)}")
}


{def halve {lambda {:n} {floor {/ :n 2}}}}
-> halve
{def double {lambda {:n} {* 2 :n}}}
-> double
{def isEven {lambda {:n} {= {% :n 2} 0}}}
-> isEven

{def mult

 {def mult.r
  {lambda {:a :b}
   {if {= {A.first :a} 1}
    then {+ {S.map {{lambda {:a :b :i}
                    {if {isEven {A.get :i :a}}
                     then else {A.get :i :b}}} :a :b}
                   {S.serie {- {A.length :a} 1} 0 -1}}}
    else {mult.r {A.addfirst! {halve {A.first :a}} :a}
                 {A.addfirst! {double {A.first :b}} :b}}}}}

 {lambda {:a :b}
  {mult.r {A.new :a} {A.new :b}}}}
-> mult

{mult 17 34}
-> 578


s := ""                 # null string
s := string('A'--'A')   # ... converted from cset difference
s := char(0)[0:0]       # ... by slicing

s1 == ""                # lexical comparison, could convert s1 to string
s1 === ""               # comparison won't force conversion
*s1 = 0                 # zero length, however, *x is polymorphic
*string(s1) = 0         # zero length string

s1 ~== ""               # non null strings comparisons
s1 ~=== ""
*string(s1) ~= 0

s := &null              # NOT a null string, null type
/s                      # test for null type
\s                      # test for non-null type


   variable=: ''
   0=#variable
1
   0<#variable
0


String s = "";
if(s != null && s.isEmpty()){//optionally, instead of "s.isEmpty()": "s.length() == 0" or "s.equals("")"
   System.out.println("s is empty");
}else{
   System.out.println("s is not empty");
}


{def entropy

 {def entropy.count
  {lambda {:s :c :i}
   {let { {:c {/ {A.get :i :c} {A.length :s}}}
        } {* :c {log2 :c}}}}}

 {def entropy.sum
  {lambda {:s :c}
   {- {+ {S.map {entropy.count :s :c}
                {S.serie 0 {- {A.length :c} 1}}}}}}}

 {lambda {:s}
         {entropy.sum {A.split :s} {cdr {W.frequency :s}}}}}
-> entropy

The W.frequency function is explained in rosettacode.org/wiki/Letter_frequency#Lambdatalk

{def txt 1223334444}
-> txt
{def F {W.frequency {txt}}}
-> F
characters:  {car {F}} -> [1,2,3,4]
frequencies: {cdr {F}} -> [1,2,3,4]
{entropy {txt}}
-> 1.8464393446710154

{entropy 0}
-> 0
{entropy 00000000000000}
-> 0
{entropy 11111111111111}
-> 0
{entropy 01}
-> 1
{entropy Lambdatalk}
-> 2.8464393446710154
{entropy entropy}
-> 2.807354922057604
{entropy abcdefgh}
-> 3
{entropy Rosetta Code}
-> 3.084962500721156
{entropy Longtemps je me suis couché de bonne heure}
-> 3.8608288771249444
{entropy abcdefghijklmnopqrstuvwxyz}
-> 4.70043971814109
{entropy abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz}
-> 4.70043971814109


implement Ethiopian;

include "sys.m";
	sys: Sys;
	print: import sys;
include "draw.m";
	draw: Draw;

Ethiopian : module
{
	init : fn(ctxt : ref Draw->Context, args : list of string);
};

init (ctxt: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;

	print("\n%d\n", ethiopian(17, 34, 0));
	print("\n%d\n", ethiopian(99, 99, 1));
}

halve(n: int): int
{
	return (n /2);
}

double(n: int): int
{
	return (n * 2);
}

iseven(n: int): int
{
	return ((n%2) == 0);
}

ethiopian(a: int, b: int, tutor: int): int
{
	product := 0;
	if (tutor)
		print("\nmultiplying %d x %d", a, b);
	while (a >= 1) {
		if (!(iseven(a))) {
			if (tutor)
				print("\n%3d   %d", a, b);
			product += b;
		} else
			if (tutor)
				print("\n%3d   ----", a);
		a = halve(a);
		b = double(b);
	}
	return product;
}


10 DEF FNiseven(a)=(a+1) MOD 2
20 DEF FNhalf(a)=INT(a/2)
30 DEF FNdouble(a)=2*a
40 x=17:y=34:tot=0
50 WHILE x>=1
60 PRINT x,
70 IF FNiseven(x)=0 THEN tot=tot+y:PRINT y ELSE PRINT
80 x=FNhalf(x):y=FNdouble(y)
90 WEND
100 PRINT "=", tot


/* Empty string, in Jsish */
var em1 = '';
var em2 = new String();

var str = 'non-empty';

;'Empty string tests';
;em1 == '';
;em1 === '';
;em1.length == 0;
;!em1;
;(em1) ? false : true;
;Object.is(em1, '');
;Object.is(em1, new String());

;'Non empty string tests';
;str != '';
;str !== '';
;str.length != 0;
;str.length > 0;
;!!str;
;(str) ? true : false;

;'Compare two empty strings';
;(em1 == em2);
;(em1 === em2);

/*
=!EXPECTSTART!=
'Empty string tests'
em1 == '' ==> true
em1 === '' ==> true
em1.length == 0 ==> true
!em1 ==> true
(em1) ? false : true ==> true
Object.is(em1, '') ==> true
Object.is(em1, new String()) ==> true
'Non empty string tests'
str != '' ==> true
str !== '' ==> true
str.length != 0 ==> true
str.length > 0 ==> true
!!str ==> true
(str) ? true : false ==> true
'Compare two empty strings'
(em1 == em2) ==> true
(em1 === em2) ==> true
=!EXPECTEND!=
*/


: -rot rot rot ; [] '__A set : dip swap __A swap 1 compress append '__A
set execute __A -1 extract nip ; : nip swap drop ; : sum '+ reduce ;
: 2array 2 compress ; : comb "" split ; : lensize length nip ;
: <group> #( a -- 'a )
    grade subscript dup 's dress distinct strip
    length 1 2array reshape swap
    'A set
    : `filter(*)  A in A swap select ;
    '`filter apply
    ;

: elements(*)  lensize ;
: entropy #( s -- n )
    length "<group> 'elements apply" dip /
    dup neg swap log * 2 log / sum ;

"1223334444" comb entropy . # 1.84643934467102


dim countOfChar( 255) ' all possible one-byte ASCII chars

    source$    ="1223334444"
    charCount  =len( source$)
    usedChar$  =""

    for i =1 to len( source$)   '   count which chars are used in source
        ch$             =mid$( source$, i, 1)
        if not( instr( usedChar$, ch$)) then usedChar$ =usedChar$ +ch$
        'currentCh$      =mid$(
        j               =instr( usedChar$, ch$)
        countOfChar( j) =countOfChar( j) +1
    next i

    l =len( usedChar$)
    for i =1 to l
        probability =countOfChar( i) /charCount
        entropy     =entropy -( probability *logBase( probability, 2))
    next i

    print " Characters used and the number of occurrences of each "
    for i =1 to l
        print " '"; mid$( usedChar$, i, 1); "'", countOfChar( i)
    next i

    print " Entropy of '"; source$; "' is  "; entropy; " bits."
    print " The result should be around 1.84644 bits."

    end
    function logBase( x, b) '   in LB log() is base 'e'.
        logBase =log( x) /log( 2)
    end function


class Program {
    static function main() {
    }
}


to double :x
  output ashift :x  1
end
to halve :x
  output ashift :x -1
end
to even? :x
  output equal? 0 bitand 1 :x
end
to eproduct :x :y
  if :x = 0 [output 0]
  ifelse even? :x ~
    [output      eproduct halve :x double :y] ~
    [output :y + eproduct halve :x double :y]
end


HAI 1.3

HOW IZ I Halve YR Integer
  FOUND YR QUOSHUNT OF Integer AN 2
IF U SAY SO

HOW IZ I Dubble YR Integer
  FOUND YR PRODUKT OF Integer AN 2
IF U SAY SO

HOW IZ I IzEven YR Integer
  FOUND YR BOTH SAEM 0 AN MOD OF Integer AN 2
IF U SAY SO

HOW IZ I EthiopianProdukt YR a AN YR b
  I HAS A Result ITZ 0
  IM IN YR LOOP UPPIN YR x WILE DIFFRINT a AN 0
    NOT I IZ IzEven YR a MKAY
    O RLY?
      YA RLY
        Result R SUM OF Result AN b
    OIC
    a R I IZ Halve YR a MKAY
    b R I IZ Dubble YR b MKAY
  IM OUTTA YR LOOP
  FOUND YR Result
IF U SAY SO

VISIBLE I IZ EthiopianProdukt YR 17 AN YR 34 MKAY
KTHXBYE


blank = ""
nonblank = "!"

println("The length of blank is ", length(blank))
println("That blank is empty is ", isempty(blank))
println("That blank is not empty is ", !isempty(blank))

println()
println("The length of nonblank is ", length(nonblank))
println("That nonblank is empty is ", isempty(nonblank))
println("That nonblank is not empty is ", !isempty(nonblank))


   variable: ""
   0=#variable
1
   0<#variable
0


fun main(args: Array<String>) {
    val s = ""
    println(s.isEmpty())    // true
    println(s.isNotEmpty()) // false
    println(s.length)       // 0
    println(s.none())       // true
    println(s.any())        // false
}


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

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

print(entropy("1223334444"))


shE[s_String] := -Plus @@ ((# Log[2., #]) & /@ ((Length /@ Gather[#])/
         Length[#]) &[Characters[s]])


END ! looks better, but is not really needed


function halve(a)
    return a/2
end

function double(a)
    return a*2
end

function isEven(a)
    return a%2 == 0
end

function ethiopian(x, y)
    local result = 0

    while (x >= 1) do
        if not isEven(x) then
            result = result + y
        end

        x = math.floor(halve(x))
        y = double(y)
    end

    return result;
end

print(ethiopian(17, 34))


Module EthiopianMultiplication{
	Form 60, 25
	Const Center=2, ColumnWith=12
	Report Center,"Ethiopian Method of Multiplication"
	// using decimals as unsigned integers
	Def Decimal leftval, rightval, sum
	(leftval, rightval)=(random(1, 65535), random(1, 65536))
	Print $( , ColumnWith), "Target:", leftval*rightval,
	Hex  leftval*rightval
	sum=0
	if @IsEven(leftval) Else sum+=rightval
	Print leftval, rightval,
	Hex  leftval, rightval
	while leftval>1
		[email protected](leftval)
		[email protected](rightval)
		Print leftval, rightval,
		Hex  leftval, rightval
		if @IsEven(leftval) Else sum+=rightval
	End while
	Print "", sum
	Hex  "", sum
	Function HalveInt(i)
		=Binary.Shift(i,-1)
	End Function
	Function DoubleInt(i)
		=Binary.Shift(i,1)
	End Function
	Function IsEven(i)
		=Binary.And(i, 1)=0
	End Function
}
EthiopianMultiplication


'{def emptyString }
-> emptyString

'{S.empty? {emptyString}}
-> true

'{S.empty? hello}
-> false

'{= {S.length {emptyString}} 0}
-> true


val .zls = ZLS
writeln .zls == ""
writeln .zls != ""
writeln len(.zls)


function E = entropy(d)
	if ischar(d), d=abs(d); end;
        [Y,I,J] = unique(d);
	H = sparse(J,1,1);
	p = full(H(H>0))/length(d);
	E = -sum(p.*log2(p));
end;


entropy = function(s)
    count = {}
    for c in s
        if count.hasIndex(c) then count[c] = count[c]+1 else count[c] = 1
    end for
    sum = 0
    for x in count.values
        countOverN = x / s.len
        sum = sum + countOverN * log(countOverN, 2)
    end for
    return -sum
end function

print entropy("1223334444")


procedure main()   # a null file will compile but generate a run-time error for missing main
end


IntegerHalving[x_]:=Floor[x/2]
IntegerDoubling[x_]:=x*2;
OddInteger           OddQ
Ethiopian[x_, y_] :=
Total[Select[NestWhileList[{IntegerHalving[#[[1]]],IntegerDoubling[#[[2]]]}&, {x,y}, (#[[1]]>1&)], OddQ[#[[1]]]&]][[2]]

Ethiopian[17, 34]


function result = halveInt(number)

    result = idivide(number,2,'floor');

end


//Demonstrate how to assign an empty string to a variable.
local(str = string)
local(str = '')

//Demonstrate how to check that a string is empty.
#str->size == 0 	// true
not #str->size		// true

//Demonstrate how to check that a string is not empty.
local(str = 'Hello, World!')
#str->size > 0 		// true
#str->size		// true


> (set str "")
()
> (length str)
0
> (=:= 0 (length str))
true
> (=:= 0 (length "apple"))
false
> (=:= "apple" "")
false
> (=/= "apple" "")
true
> (=:= str "")
true
> (=:= "apple" '())
false
> (=/= "apple" '())
true
> (=:= str '())
true
> (case str  ('() 'empty) ((cons head tail) 'not-empty))
empty
> (case "apple"  ('() 'empty) ((cons head tail) 'not-empty))
not-empty


MODULE Entropy;
FROM InOut IMPORT WriteString, WriteLn;
FROM RealInOut IMPORT WriteReal;
FROM Strings IMPORT Length;
FROM MathLib IMPORT ln;

PROCEDURE entropy(s: ARRAY OF CHAR): REAL;
    VAR freq: ARRAY [0..255] OF CARDINAL;
        i, length: CARDINAL;
        h, f: REAL;
BEGIN
    (* the entropy of the empty string is zero *)
    length := Length(s);
    IF length = 0 THEN RETURN 0.0; END;

    (* find the frequency of each character *)
    FOR i := 0 TO 255 DO freq[i] := 0; END;
    FOR i := 0 TO length-1 DO
        INC(freq[ORD(s[i])]);
    END;

    (* calculate the component for each character *)
    h := 0.0;
    FOR i := 0 TO 255 DO
        IF freq[i] # 0 THEN
            f := FLOAT(freq[i]) / FLOAT(length);
            h := h - f * (ln(f) / ln(2.0));
        END;
    END;
    RETURN h;
END entropy;

BEGIN
    WriteReal(entropy("1223334444"), 14);
    WriteLn;
END Entropy.


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

runSample(Arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/* REXX ***************************************************************
 * 28.02.2013 Walter Pachl
 **********************************************************************/
method getShannonEntropy(s = "1223334444") public static
--trace var occ c chars n cn i e p pl
  Numeric Digits 30
  occ = 0
  chars = ''
  n = 0
  cn = 0
  Loop i = 1 To s.length()
    c = s.substr(i, 1)
    If chars.pos(c) = 0 Then Do
      cn = cn + 1
      chars = chars || c
      End
    occ[c] = occ[c] + 1
    n = n + 1
    End i
  p = ''
  Loop ci = 1 To cn
    c = chars.substr(ci, 1)
    p[c] = occ[c] / n
    End ci
  e = 0
  Loop ci = 1 To cn
    c = chars.substr(ci, 1)
    pl = log2(p[c])
    e = e + p[c] * pl
    End ci
  Return -e

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method log2(a = double) public static binary returns double
  return Math.log(a) / Math.log(2)

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(Arg) public static
  parse Arg sstr
  if sstr = '' then
    sstr = '1223334444' -
           '1223334444555555555' -
           '122333' -
           '1227774444' -
           'aaBBcccDDDD' -
           '1234567890abcdefghijklmnopqrstuvwxyz' -
           'Rosetta_Code'
  say 'Calculating Shannon''s entropy for the following list:'
  say '['(sstr.space(1, ',')).changestr(',', ', ')']'
  say
  entropies = 0
  ssMax = 0
  -- This crude sample substitutes a '_' character for a space in the input strings
  loop w_ = 1 to sstr.words()
    ss = sstr.word(w_)
    ssMax = ssMax.max(ss.length())
    ss_ = ss.changestr('_', ' ')
    entropy = getShannonEntropy(ss_)
    entropies[ss] = entropy
    end w_
  loop report = 1 to sstr.words()
    ss = sstr.word(report)
    ss_ = ss.changestr('_', ' ')
    Say 'Shannon entropy of' ('"'ss_'"').right(ssMax + 2)':' entropies[ss].format(null, 12)
    end report
  return


public class EmptyApplet extends java.applet.Applet {
    @Override public void init() {
    }
}


vardef halve(expr x) = floor(x/2) enddef;
vardef double(expr x) = x*2 enddef;
vardef iseven(expr x) = if (x mod 2) = 0: true else: false fi enddef;

primarydef a ethiopicmult b =
  begingroup
    save r_, plier_, plicand_;
    plier_ := a; plicand_ := b;
    r_ := 0;
    forever: exitif plier_ < 1;
      if not iseven(plier_): r_ := r_ + plicand_; fi
      plier_ := halve(plier_);
      plicand_ := double(plicand_);
    endfor
    r_
  endgroup
enddef;

show( (17 ethiopicmult 34) );
end


A	IS	17
B	IS	34

pliar	IS 	$255		% designating main registers
pliand	GREG
acc	GREG
str	IS	pliar		% reuse reg $255 for printing

	LOC	Data_Segment
	GREG	@
BUF	OCTA	#3030303030303030 % reserve a buffer that is big enough to hold
	OCTA	#3030303030303030 % a max (signed) 64 bit integer:
	OCTA	#3030300a00000000 %   2^63 - 1 = 9223372036854775807
				  % string is terminated with NL, 0

	LOC	#1000		% locate program at address
	GREG	@
halve	SR	pliar,pliar,1
	GO	$127,$127,0

double	SL	pliand,pliand,1
	GO	$127,$127,0

odd	DIV	$77,pliar,2
	GET	$78,rR
	GO	$127,$127,0

				% Main is the entry point of the program
Main 	SET	pliar,A		% initialize registers for calculation
	SET	pliand,B
	SET	acc,0
1H	GO	$127,odd
	BZ	$78,2F		% if pliar is even skip incr. acc with pliand
	ADD	acc,acc,pliand	%
2H	GO	$127,halve	% halve pliar
	GO	$127,double	% and double pliand
	PBNZ	pliar,1B	% repeat from 1H while pliar > 0
// result: acc = 17 x 34
// next: print result --> stdout
// $0 is a temp register
	LDA	str,BUF+19	% points after the end of the string
2H	SUB	str,str,1	% update buffer pointer
	DIV	acc,acc,10	% do a divide and mod
	GET	$0,rR		% get digit from special purpose reg. rR
				% containing the remainder of the division
	INCL	$0,'0'		% convert to ascii
	STBU	$0,str		% place digit in buffer
	PBNZ	acc,2B		% next
				% 'str' points to the start of the result
	TRAP	0,Fputs,StdOut	% output answer to stdout
	TRAP	0,Halt,0	% exit


make "str " ;make null-string word
print empty? :str ;prints 'true'
print not empty? :str ;prints 'false'


'assign empty string to variable
a$ = ""
'check for empty string
if a$="" then print "Empty string."
if len(a$)=0 then print "Empty string."
'check for non-empty string
if a$<>"" then print "Not empty."
if len(a$)>0 then print "Not empty."


str = EMPTY -- same as: str = ""
put str=EMPTY
-- 1
put str<>EMPTY
-- 0


import tables, math

proc entropy(s: string): float =
  var t = initCountTable[char]()
  for c in s: t.inc(c)
  for x in t.values: result -= x/s.len * log2(x/s.len)

echo entropy("1223334444")


use Collection;

class Entropy {
  function : native : GetShannonEntropy(result : String) ~ Float {
    frequencies := IntMap->New();

    each(i : result) {
      c := result->Get(i);

      if(frequencies->Has(c)) {
        count := frequencies->Find(c)->As(IntHolder);
        count->Set(count->Get() + 1);
      }
      else {
        frequencies->Insert(c, IntHolder->New(1));
      };
    };

    length := result->Size();
    entropy := 0.0;

    counts := frequencies->GetValues();
    each(i : counts) {
      count := counts->Get(i)->As(IntHolder)->Get();
      freq := count->As(Float) / length;
      entropy += freq * (freq->Log() / 2.0->Log());
    };

    return -1 * entropy;
  }

  function : Main(args : String[]) ~ Nil {
    inputs := [
      "1223334444",
      "1223334444555555555",
      "122333",
      "1227774444",
      "aaBBcccDDDD",
      "1234567890abcdefghijklmnopqrstuvwxyz",
      "Rosetta Code"];

    each(i : inputs) {
      input := inputs[i];
      "Shannon entropy of '{$input}': "->Print();
      GetShannonEntropy(inputs[i])->PrintLine();
    };
  }
}


MODULE EthiopianMultiplication;

FROM SWholeIO IMPORT
  WriteCard;
FROM STextIO IMPORT
  WriteString, WriteLn;

PROCEDURE Halve(VAR A: CARDINAL);
BEGIN
  A := A / 2;
END Halve;

PROCEDURE Double(VAR A: CARDINAL);
BEGIN
  A := 2 * A;
END Double;

PROCEDURE IsEven(A: CARDINAL): BOOLEAN;
BEGIN
  RETURN A REM 2 = 0;
END IsEven;

VAR
  X, Y, Tot: CARDINAL;

BEGIN
  X := 17;
  Y := 34;
  Tot := 0;
  WHILE X >= 1 DO
    WriteCard(X, 9);
    WriteString(" ");
    IF NOT(IsEven(X)) THEN
      INC(Tot, Y);
      WriteCard(Y, 9)
    END;
    WriteLn;
    Halve(X);
    Double(Y);
  END;
  WriteString("=         ");
  WriteCard(Tot, 9);
  WriteLn;
END EthiopianMultiplication.


MODULE Ethiopian EXPORTS Main;

IMPORT IO, Fmt;

PROCEDURE IsEven(n: INTEGER): BOOLEAN =
  BEGIN
    RETURN n MOD 2 = 0;
  END IsEven;

PROCEDURE Double(n: INTEGER): INTEGER =
  BEGIN
    RETURN n * 2;
  END Double;

PROCEDURE Half(n: INTEGER): INTEGER =
  BEGIN
    RETURN n DIV 2;
  END Half;

PROCEDURE Multiply(a, b: INTEGER): INTEGER =
  VAR
    temp := 0;
    plier := a;
    plicand := b;
  BEGIN
    WHILE plier >= 1 DO
      IF NOT IsEven(plier) THEN
        temp := temp + plicand;
      END;
      plier := Half(plier);
      plicand := Double(plicand);
    END;
    RETURN temp;
  END Multiply;

BEGIN
  IO.Put("17 times 34 = " & Fmt.Int(Multiply(17, 34)) & "\n");
END Ethiopian.


HAI 1.3

I HAS A string ITZ ""
string, O RLY?
    YA RLY, VISIBLE "STRING HAZ CONTENZ"
    NO WAI, VISIBLE "Y U NO HAS CHARZ?!"
OIC

KTHXBYE


-- create an empty string 3 different ways
str = ""
str = ''
str = [[]]

-- test for empty string
if str == "" then
  print "The string is empty"
end

-- test for nonempty string
if str ~= "" then
  print "The string is not empty"
end

-- several different ways to check the string's length
if string.len(str) == 0 then
  print "The library function says the string is empty."
end
if str:len() == 0 then
  print "The method call says the string is empty."
end
if #str == 0 then
  print "The unary operator says the string is empty."
end


(* generic OCaml, using a mutable Hashtbl *)

(* pre-bake & return an inner-loop function to bin & assemble a character frequency map *)
let get_fproc (m: (char, int) Hashtbl.t) :(char -> unit)  =
  (fun (c:char) -> try
                     Hashtbl.replace m c ( (Hashtbl.find m c) + 1)
                   with Not_found -> Hashtbl.add m c 1)

(* pre-bake and return an inner-loop function to do the actual entropy calculation *)
let get_calc (slen:int) :(float -> float) =
  let slen_float = float_of_int slen in
  let log_2 = log 2.0 in

  (fun v -> let pt = v /. slen_float in
                pt *. ((log pt) /. log_2) )

(* main function, given a string argument it:
       builds a (mutable) frequency map (initial alphabet size of 255, but it's auto-expanding),
       extracts the relative probability values into a list,
       folds-in the basic entropy calculation and returns the result. *)
let shannon (s:string) :float  =
  let freq_hash = Hashtbl.create 255 in
  String.iter (get_fproc freq_hash) s;

  let relative_probs = Hashtbl.fold (fun k v b -> (float v)::b) freq_hash [] in
  let calc = get_calc (String.length s) in

   -1.0 *. List.fold_left (fun b x -> b +. calc x) 0.0 relative_probs


using System;
using System.Console;

module Ethiopian
{
    Multiply(x : int, y : int) : int
    {
        def halve(a)  {a / 2}
        def doble(a)  {a * 2}
        def isEven(a) {a % 2 == 0}
        def multiply(p, q)
        {
            match(p)
            {
                |p when (p < 1) => 0
                |p when (isEven(p)) => 0 + multiply(halve(p), doble(q))
                |_ => q + multiply(halve(p), doble(q))
            }
        }
        multiply(x, y)
    }

    Main() : void
    {
        WriteLine("By Ethiopian multiplication, 17 * 34 = {0}", Multiply(17, 34));
    }
}


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

/*REXX program multiplies 2 integers by Ethiopian/Russian peasant method*/
numeric digits 1000              /*handle extremely large integers.     */
                                 /*handles zeroes and negative integers.*/
                                 /*A & B  should be checked if integers.*/
parse arg a b .
say 'a=' a
say 'b=' b
say 'product=' emult(a,b)
return

method emult(x,y) private static
  parse x x 1 ox
  prod=0
  loop while x\==0
    if \iseven(x) then prod=prod+y
    x=halve(x)
    y=dubble(y)
    end
  return prod*ox.sign

method halve(x) private static
  return x % 2

method dubble(x) private static
  return x + x

method iseven(x) private static
  return x//2 == 0


s := ""; # Create an empty string
evalb(s = ""); # test if the string is empty
evalb(s <> ""); # test if the string is not empty


str=""; (*Create*)
str==="" (*test empty*)
str=!="" (*test not empty*)


   % Demonstrate how to assign an empty string to a variable.
    str = '';
    % Demonstrate how to check that a string is empty.
    isempty(str)
    (length(str)==0)
    % Demonstrate how to check that a string is not empty.
    ~isempty(str)
    (length(str)>0)


s: ""$

/* check using string contents */
sequal(s, "");
not sequal(s, "");

/* check using string length */
slength(s) = "";
slength(s) # "";


: entropy(s) -- f
| freq sz |
   s size dup ifZero: [ return ] asFloat ->sz
   ListBuffer initValue(255, 0) ->freq
   s apply( #[ dup freq at 1+ freq put ] )
   0.0 freq applyIf( #[ 0 <> ], #[ sz / dup ln * - ] ) Ln2 / ;

entropy("1223334444") .


/* REXX */
Numeric Digits 16
Parse Arg s
If s='' Then
  s="1223334444"
occ.=0
chars=''
n=0
cn=0
Do i=1 To length(s)
  c=substr(s,i,1)
  If pos(c,chars)=0 Then Do
    cn=cn+1
    chars=chars||c
    End
  occ.c=occ.c+1
  n=n+1
  End
do ci=1 To cn
  c=substr(chars,ci,1)
  p.c=occ.c/n
  /* say c p.c */
  End
e=0
Do ci=1 To cn
  c=substr(chars,ci,1)
  e=e+p.c*rxcalclog(p.c)/rxcalclog(2)
  End
Say s 'Entropy' format(-e,,12)
Exit

::requires 'rxmath' LIBRARY


proc halve(x: int): int = x div 2
proc double(x: int): int = x * 2
proc odd(x: int): bool = x mod 2 != 0

proc ethiopian(x, y: int): int =
  var x = x
  var y = y

  while x >= 1:
    if odd(x):
      result += y
    x = halve x
    y = double y

echo ethiopian(17, 34)


use Collection;

class EthiopianMultiplication {
  function : Main(args : String[]) ~ Nil {
    first := IO.Console->ReadString()->ToInt();
    second := IO.Console->ReadString()->ToInt();
    "----"->PrintLine();
    Mul(first, second)->PrintLine();
  }

  function : native : Mul(first : Int, second : Int) ~ Int {
    if(first < 0){
      first := -1 * first;
      second := -1 * second;
    };

    sum := isEven(first)? 0 : second;
    do {
      first := halveInt(first);
      second := doubleInt(second);
      if(isEven(first) = false){
        sum += second;
      };
    }
    while(first > 1);

    return sum;
  }

  function : halveInt(num : Int) ~ Bool {
    return num >> 1;
  }

  function : doubleInt(num : Int) ~ Bool {
    return num << 1;
  }

  function : isEven(num : Int) ~ Bool {
    return (num and 1) = 0;
  }
}


S = "",  % assignment

( if S = "" then ... else ... ),  % checking if a string is empty

( if not S = "" then ... else ... ),  % checking if a string is not empty


(bool not) :empty?
"" empty? puts!
"Rosetta Code" empty? puts!


empty_string1 = ""
empty_string2 = String.new

puts "empty string is empty" if empty_string1.isEmpty()
puts "empty string has no length" if empty_string2.length() == 0
puts "empty string is not nil" unless empty_string1 == nil


s = ""

if len(s)=0
        println "s is empty"
else
        println "s is not empty"
end


PROGRAM entropytest;

USES StrUtils, Math;

TYPE FArray = ARRAY of CARDINAL;

VAR	 strng: STRING = '1223334444';

// list unique characters in a string
FUNCTION uniquechars(str: STRING): STRING;
	VAR n: CARDINAL;
	BEGIN
		uniquechars := '';
		FOR n := 1 TO length(str) DO
			IF (PosEx(str[n],str,n)>0)
				AND (PosEx(str[n],uniquechars,1)=0)
					THEN uniquechars += str[n];
	END;

// obtain a list of character-frequencies for a string
//  given a string containing its unique characters
FUNCTION frequencies(str,ustr: STRING): FArray;
	VAR u,s,p,o: CARDINAL;
	BEGIN
		SetLength(frequencies, Length(ustr)+1);
		p := 0;
		FOR u := 1 TO length(ustr) DO
			FOR s := 1 TO length(str) DO BEGIN
				o := p;	p := PosEx(ustr[u],str,s);
				IF (p>o) THEN INC(frequencies[u]);
			END;
	END;

// Obtain the Shannon entropy of a string
FUNCTION entropy(s: STRING): EXTENDED;
	VAR pf : FArray;
		us : STRING;
		i,l: CARDINAL;
	BEGIN
		us := uniquechars(s);
		pf := frequencies(s,us);
		l  := length(s);
		entropy := 0.0;
		FOR i := 1 TO length(us) DO
			entropy -= pf[i]/l * log2(pf[i]/l);
	END;

BEGIN
	Writeln('Entropy of "',strng,'" is ',entropy(strng):2:5, ' bits.');
END.


unit Multiplication;
interface

function Double(Number: Integer): Integer;
function Halve(Number: Integer): Integer;
function Even(Number: Integer): Boolean;
function Ethiopian(NumberA, NumberB: Integer): Integer;

implementation
  function Double(Number: Integer): Integer;
  begin
    result := Number * 2
  end;

  function Halve(Number: Integer): Integer;
  begin
    result := Number div 2
  end;

  function Even(Number: Integer): Boolean;
  begin
    result := Number mod 2 = 0
  end;

  function Ethiopian(NumberA, NumberB: Integer): Integer;
  begin
    result := 0;
    while NumberA >= 1 do
    begin
      if not Even(NumberA) then
        result := result + NumberB;
      NumberA := Halve(NumberA);
      NumberB := Double(NumberB)
    end
  end;
begin
end.


#import <stdio.h>

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

@interface EthiopicMult : NSObject
+ (int)mult: (int)plier by: (int)plicand;
+ (int)halve: (int)a;
+ (int)double: (int)a;
@end

@implementation EthiopicMult
+ (int)mult: (int)plier by: (int)plicand
{
  int r = 0;
  while(plier >= 1) {
    if ( !iseven(plier) ) r += plicand;
    plier = [EthiopicMult halve: plier];
    plicand = [EthiopicMult double: plicand];
  }
  return r;
}

+ (int)halve: (int)a
{
  return (a>>1);
}

+ (int)double: (int)a
{
  return (a<<1);
}
@end

int main()
{
  @autoreleasepool {
    printf("%d\n", [EthiopicMult mult: 17 by: 34]);
  }
  return 0;
}


def empty = "";
mutable fill_later = "";


my_empty_string = "";

% To make sure it is empty, we can ask whether its length is equal to zero. %

#my_empty_string == 0;


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

s1 = '' -- assignment
s2 = "" -- equivalent to s1
parse '.' . s3 . -- parsing a token that doesn't exist results in an empty string

strings = [s1, s2, s3, ' ']

loop s_ = 0 to strings.length - 1
  say (Rexx s_).right(3)':\-'
  select
    when strings[s_] == ''      then say ' "'strings[s_]'" is really empty'
    when strings[s_].length = 0 then say ' "'strings[s_]'" is empty'
    when strings[s_] = ''       then say ' "'strings[s_]'" looks empty but may not be'
    when strings[s_].length > 0 then say ' "'strings[s_]'" is not empty'
    otherwise nop
    end
  end s_

return


sub entropy {
    my %count; $count{$_}++ for @_;
    my $entropy = 0;
    for (values %count) {
        my $p = $_/@_;
        $entropy -= $p * log $p;
    }
    $entropy / log 2
}

print entropy split //, "1223334444";


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

?entropy("1223334444")


function [varargout] = emptyprogram(varargin)


(* We optimize a bit by not keeping the intermediate lists, and summing
   the right column on-the-fly, like in the C version.
   The function takes "halve" and "double" operators and "is_even" predicate as arguments,
   but also "is_zero", "zero" and "add". This allows for more general uses of the
   ethiopian multiplication. *)
let ethiopian is_zero is_even halve zero double add b a =
  let rec g a b r =
    if is_zero a
    then (r)
    else g (halve a) (double b) (if not (is_even a) then (add b r) else (r))
  in
  g a b zero
;;

let imul =
  ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 0 (( * ) 2) ( + );;

imul 17 34;;
(* - : int = 578 *)

(* Now, we have implemented the same algorithm as "rapid exponentiation",
   merely changing operator names *)
let ipow =
  ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 1 (fun x -> x*x) ( * )
;;

ipow 2 16;;
(* - : int = 65536 *)

(* still renaming operators, if "halving" is just subtracting one,
   and "doubling", adding one, then we get an addition *)
let iadd a b =
  ethiopian (( = ) 0) (fun x -> false) (pred) b (function x -> x) (fun x y -> succ y) 0 a
;;

iadd 421 1000;;
(* - : int = 1421 *)

(* One can do much more with "ethiopian multiplication",
   since the two "multiplicands" and the result may be of three different types,
   as shown by the typing system of ocaml *)

ethiopian;;
- : ('a -> bool) ->          (* is_zero *)
    ('a -> bool) ->          (* is_even *)
    ('a -> 'a) ->            (* halve *)
    'b ->                    (* zero *)
    ('c -> 'c) ->            (* double *)
    ('c -> 'b -> 'b) ->      (* add *)
    'c ->                    (* b *)
    'a ->                    (* a *)
    'b                       (* result *)
= <fun>

(* Here zero is the starting value for the accumulator of the sums
   of values in the right column in the original algorithm. But the "add"
   me do something else, see for example the RosettaCode page on
   "Exponentiation operator". *)


var x = ""

if x == "":
  echo "empty"
if x != "":
  echo "not empty"

# Alternatively:
if x.len == 0:
  echo "empty"
if x.len > 0:
  echo "not empty"


10 S$=""
20 IF S$<>"" THEN O$="NOT "
30 PRINT "THE STRING IS "O$"EMPTY."


(setf emptystring "") ;binds variable'emptystring' to the empty string ""

(let ((emptystring "")) ;; Binds local variable 'emptystring' to the empty string ""
  (when (string-equal emptystring "")  ;;case insensitive string comparison
    (print "Is an empty string"))  ;;bad argument error if not a string
  (when (stringp emptystring)
    (print "Is a string"))
  (when (not (stringp emptystring))
    (print "Is not a string"))
  (when (and (stringp emptystring)(= (length emptystring) 0))
    (print "Is an empty string"))
  (when (and (stringp emptystring)(> (length emptystring) 0))
    (print "Is a non-empty string")))


<?php

function shannonEntropy($string) {
    $h = 0.0;
    $len = strlen($string);
    foreach (count_chars($string, 1) as $count) {
        $h -= (double) ($count / $len) * log((double) ($count / $len), 2);
    }
    return $h;
}

$strings = array(
    '1223334444',
    '1225554444',
    'aaBBcccDDDD',
    '122333444455555',
    'Rosetta Code',
    '1234567890abcdefghijklmnopqrstuvwxyz',
);

foreach ($strings AS $string) {
    printf(
        '%36s : %s' . PHP_EOL,
        $string,
        number_format(shannonEntropy($string), 6)
    );
}


go =>
  ["1223334444",
   "Rosetta Code is the best site in the world!",
   "1234567890abcdefghijklmnopqrstuvwxyz",
   "Picat is fun"].map(entropy).println(),
  nl.

% probabilities of each element/character in L
entropy(L) = Entropy =>
  Len = L.length,
  Occ = new_map(), % # of occurrences
  foreach(E in L)
    Occ.put(E, Occ.get(E,0) + 1)
  end,
  Entropy = -sum([P2*log2(P2) : _C=P in Occ, P2 = P/Len]).


function r = halve(a)
  r = floor(a/2);
endfunction

function r = doublit(a)
  r = a*2;
endfunction

function r = iseven(a)
  r = mod(a,2) == 0;
endfunction

function r = ethiopicmult(plier, plicand, tutor=false)
  r = 0;
  if (tutor)
    printf("ethiopic multiplication of %d and %d\n", plier, plicand);
  endif
  while(plier >= 1)
    if ( iseven(plier) )
      if (tutor)
	printf("%4d %6d struck\n", plier, plicand);
      endif
    else
      r = r + plicand;
      if (tutor)
	printf("%4d %6d kept\n", plier, plicand);
      endif
    endif
    plier = halve(plier);
    plicand = doublit(plicand);
  endwhile
endfunction

disp(ethiopicmult(17, 34, true))


: halve   2 / ;
: double  2 * ;

: ethiopian
   dup ifZero: [ nip return ]
   over double over halve ethiopian
   swap isEven ifTrue: [ nip ] else: [ + ] ;


MODULE EmptyString;
IMPORT Out;
VAR
  str: ARRAY 64 OF CHAR;
BEGIN
  str := "";
  Out.String("for str := ");Out.Char('"');Out.Char('"');Out.Char(';');Out.Ln;
  Out.String("checking str = ");Out.Char('"');Out.Char('"');Out.String(" Is Empty? ");Out.Bool(str = "");Out.Ln;
  Out.String("checking str[0] = 0X. Is Empty? ");Out.Bool(str[0] = 0X);Out.Ln;
  str := "Hello Rossetta";
  Out.String("for str :=");Out.Char('"');Out.String(str);Out.Char('"');Out.Char(";");Out.Ln;
  Out.String("checking str = ");Out.Char('"');Out.String(str);Out.Char('"');Out.String(" Is Empty? ");Out.Bool(str = "");Out.Ln;
  Out.String("checking str[0] = 0X. Is Empty? ");Out.Bool(str[0] = 0X);Out.Ln;
END EmptyString.


s := "";
if(s->IsEmpty()) {
   "s is empty"->PrintLine();
} else{
   "s is not empty"->PrintLine();
};


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

(setq LN2 0.693147180559945309417)

(de tabulate-chars (Str)
   (let Map NIL
      (for Ch (chop Str)
         (if (assoc Ch Map)
            (con @ (inc (cdr @)))
            (setq Map (cons (cons Ch 1) Map))))
   Map))

(de entropy (Str)
   (let (
      Sz    (length Str)
      Hist  (tabulate-chars Str)
   )
   (*/
      (sum
         '((Pair)
            (let R (*/ (cdr Pair) 1. Sz)
               (- (*/ R (log R) 1.))))
         Hist)
      1. LN2)))


*process source xref attributes or(!);
 /*--------------------------------------------------------------------
 * 08.08.2014 Walter Pachl  translated from REXX version 1
 *-------------------------------------------------------------------*/
 ent: Proc Options(main);
 Dcl (index,length,log2,substr) Builtin;
 Dcl sysprint Print;
 Dcl occ(100) Bin fixed(31) Init((100)0);
 Dcl (n,cn,ci,i,pos) Bin fixed(31) Init(0);
 Dcl chars Char(100) Var Init('');
 Dcl s Char(100) Var Init('1223334444');
 Dcl c Char(1);
 Dcl (occf,p(100)) Dec Float(18);
 Dcl e Dec Float(18) Init(0);
 Do i=1 To length(s);
   c=substr(s,i,1);
   pos=index(chars,c);
   If pos=0 Then Do;
     pos=length(chars)+1;
     cn+=1;
     chars=chars!!c;
     End;
   occ(pos)+=1;
   n+=1;
   End;
  do ci=1 To cn;
    occf=occ(ci);
    p(ci)=occf/n;
    End;
  Do ci=1 To cn;
    e=e+p(ci)*log2(p(ci));
    End;
  Put Edit('s='''!!s!!''' Entropy=',-e)(Skip,a,f(15,12));
  End;


	LOC	#100
Main	TRAP	0,Halt,0	// main (argc, argv) {}


(define (ethiopian-multiplication l r)
   (let ((even? (lambda (n)
                  (eq? (mod n 2) 0))))

   (let loop ((sum 0) (l l) (r r))
      (print "sum: " sum ", l: " l ", r: " r)
      (if (eq? l 0)
         sum
         (loop
            (if (even? l) (+ sum r) sum)
            (floor (/ l 2)) (* r 2))))))

(print (ethiopian-multiplication 17 34))


declare
  fun {Halve X}   X div 2             end
  fun {Double X}  X * 2               end
  fun {Even X}    {Abs X mod 2} == 0  end  %% standard function: Int.isEven

  fun {EthiopicMult X Y}
     X >= 0 = true %% assert: X must not be negative

     Rows = for
               L in X; L>0;  {Halve L}  %% C-like iterator: "Init; While; Next"
               R in Y; true; {Double R}
               collect:Collect
	    do
	       {Collect L#R}
	    end

     OddRows = {Filter Rows LeftIsOdd}
     RightColumn = {Map OddRows SelectRight}
  in
     {Sum RightColumn}
  end

  %% Helpers
  fun {LeftIsOdd L#_}   {Not {Even L}}          end
  fun {SelectRight _#R} R                       end
  fun {Sum Xs}          {FoldL Xs Number.'+' 0} end
in
  {Show {EthiopicMult 17 34}}


let is_string_empty s =
  (s = "")

let () =
  let s1 = ""
  and s2 = "not empty" in
  Printf.printf "s1 empty? %B\n" (is_string_empty s1);
  Printf.printf "s2 empty? %B\n" (is_string_empty s2);
;;


; define the empty string
(define empty-string "")

; three simplest tests for 'the-string emptiness
(if (or
      (string-eq? the-string "")
      (string=?   the-string "")
      (eq? (string-length the-string) 0))
   (print "the-string is empty")

; four simplest tests for 'the-string not emptiness
(if (or
      (not (string-eq? the-string ""))
      (not (string=?   the-string ""))
      (not (eq? (string-length the-string) 0))
      (less? 0 (string-length the-string)))
   (print "the-string is NOT empty))


function entropy ($string) {
    $n = $string.Length
    $string.ToCharArray() | group | foreach{
        $p = $_.Count/$n
        $i = [Math]::Log($p,2)
        -$p*$i
    } | measure -Sum | foreach Sum
}
entropy "1223334444"