:-module(shannon_entropy, [shannon_entropy/2]).

%!	shannon_entropy(+String, -Entropy) is det.
%
%	Calculate the Shannon Entropy of String.
%
%	Example query:
%	==
%	?- shannon_entropy(1223334444, H).
%	H = 1.8464393446710154.
%	==
%
shannon_entropy(String, Entropy):-
	atom_chars(String, Cs)
	,relative_frequencies(Cs, Frequencies)
	,findall(CI
		,(member(_C-F, Frequencies)
		 ,log2(F, L)
		 ,CI is F * L
		 )
		,CIs)
	,foldl(sum, CIs, 0, E)
	,Entropy is -E.

%!	frequencies(+Characters,-Frequencies) is det.
%
%	Calculates the relative frequencies of elements in the list of
%	Characters.
%
%	Frequencies is a key-value list with elements of the form:
%	C-F, where C a character in the list and F its relative
%	frequency in the list.
%
%	Example query:
%	==
%	?- relative_frequencies([a,a,a,b,b,b,b,b,b,c,c,c,a,a,f], Fs).
%	Fs = [a-0.3333333333333333, b-0.4, c-0.2,f-0.06666666666666667].
%	==
%
relative_frequencies(List, Frequencies):-
	run_length_encoding(List, Rle)
        % Sort Run-length encoded list and aggregate lengths by element
	,keysort(Rle, Sorted_Rle)
	,group_pairs_by_key(Sorted_Rle, Elements_Run_lengths)
	,length(List, Elements_in_list)
	,findall(E-Frequency_of_E
		,(member(E-RLs, Elements_Run_lengths)
                 % Sum the list of lengths of runs of E
		 ,foldl(plus, RLs, 0, Occurences_of_E)
		 ,Frequency_of_E is Occurences_of_E / Elements_in_list
		 )
		,Frequencies).

%!	run_length_encoding(+List, -Run_length_encoding) is det.
%
%	Converts a list to its run-length encoded form where each "run"
%	of contiguous repeats of the same element is replaced by that
%	element and the length of the run.
%
%	Run_length_encoding is a key-value list, where each element is a
%	term:
%
%	Element:term-Repetitions:number.
%
%	Example query:
%	==
%       ?- run_length_encoding([a,a,a,b,b,b,b,b,b,c,c,c,a,a,f], RLE).
%	RLE = [a-3, b-6, c-3, a-2, f-1].
%	==
%
run_length_encoding([], []-0):-
	!. % No more results needed.

run_length_encoding([Head|List], Run_length_encoded_list):-
	run_length_encoding(List, [Head-1], Reversed_list)
	% The resulting list is in reverse order due to the head-to-tail processing
	,reverse(Reversed_list, Run_length_encoded_list).

%!	run_length_encoding(+List,+Initialiser,-Accumulator) is det.
%
%	Business end of run_length_encoding/3. Calculates the run-length
%	encoded form of a list and binds the result to the Accumulator.
%	Initialiser is a list [H-1] where H is the first element of the
%	input list.
%
run_length_encoding([], Fs, Fs).

% Run of F consecutive occurrences of C
run_length_encoding([C|Cs],[C-F|Fs], Acc):-
        % Backtracking would produce successive counts
	% of runs of C at different indices in the list.
	!
	,F_ is F + 1
	,run_length_encoding(Cs, [C-F_| Fs], Acc).

% End of a run of consecutive identical elements.
run_length_encoding([C|Cs], Fs, Acc):-
	run_length_encoding(Cs,[C-1|Fs], Acc).

/* Arithmetic helper predicates */

%!	log2(N, L2_N) is det.
%
%	L2_N is the logarithm with base 2 of N.
%
log2(N, L2_N):-
	L_10 is log10(N)
	,L_2 is log10(2)
	,L2_N is L_10 / L_2.

%!	sum(+A,+B,?Sum) is det.
%
%	True when Sum is the sum of numbers A and B.
%
%	Helper predicate to allow foldl/4 to do addition. The following
%	call will raise an error (because there is no predicate +/3):
%	==
%	foldl(+, [1,2,3], 0, Result).
%	==
%
%	This will not raise an error:
%	==
%	foldl(sum, [1,2,3], 0, Result).
%	==
%
sum(A, B, Sum):-
	must_be(number, A)
	,must_be(number, B)
	,Sum is A + B.


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}}


halve(n)=n\2;
double(n)=2*n;
even(n)=!(n%2);
multE(a,b)={ my(d=0);
     while(a,
          if(!even(a),
               d+=b);
          a=halve(a);
          b=double(b));
     d
};


v=''
w=' '
if v=='' Then Say 'v contains the empty string'<
If length(w)>0 Then Say 'Variable w does not contain the empty string'
If w='' Then Say 'this is not a good test'


DEFINE VARIABLE cc AS CHARACTER.

IF cc > '' THEN
   MESSAGE 'not empty' VIEW-AS ALERT-BOX.
ELSE IF cc = ? THEN
   MESSAGE 'unknown' VIEW-AS ALERT-BOX.
ELSE /* IF cc = '' */
   MESSAGE 'empty' VIEW-AS ALERT-BOX.


a="";
isEmpty(s)=s==""    \\ Alternately:
isEmpty(s)=#s==0
isNonempty(s)=s!=""    \\ Alternatively:
isNonempty(s)=#s


#TESTSTR="1223334444"
NewMap uchar.i() : Define.d e

Procedure.d nlog2(x.d) : ProcedureReturn Log(x)/Log(2) : EndProcedure

Procedure countchar(s$, Map uchar())
  If Len(s$)
    uchar(Left(s$,1))=CountString(s$,Left(s$,1))
    s$=RemoveString(s$,Left(s$,1))
    ProcedureReturn countchar(s$, uchar())
  EndIf
EndProcedure

countchar(#TESTSTR,uchar())

ForEach uchar()
  e-uchar()/Len(#TESTSTR)*nlog2(uchar()/Len(#TESTSTR))
Next

OpenConsole()
Print("Entropy of ["+#TESTSTR+"] = "+StrD(e,15))
Input()


from __future__ import division
import math

def hist(source):
    hist = {}; l = 0;
    for e in source:
        l += 1
        if e not in hist:
            hist[e] = 0
        hist[e] += 1
    return (l,hist)

def entropy(hist,l):
    elist = []
    for v in hist.values():
        c = v / l
        elist.append(-c * math.log(c ,2))
    return sum(elist)

def printHist(h):
    flip = lambda (k,v) : (v,k)
    h = sorted(h.iteritems(), key = flip)
    print 'Sym\thi\tfi\tInf'
    for (k,v) in h:
        print '%s\t%f\t%f\t%f'%(k,v,v/l,-math.log(v/l, 2))

source = "1223334444"
(l,h) = hist(source);
print '.[Results].'
print 'Length',l
print 'Entropy:', entropy(h, l)
printHist(h)


bundle Default {
  class Empty {
    function : Main(args : String[]) ~ Nil {
    }
}


program EthiopianMultiplication;
  {$IFDEF FPC}
    {$MODE DELPHI}
  {$ENDIF}
  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
  Write(Ethiopian(17, 34))
end.


use strict;

sub halve { int((shift) / 2); }
sub double { (shift) * 2; }
sub iseven { ((shift) & 1) == 0; }

sub ethiopicmult
{
    my ($plier, $plicand, $tutor) = @_;
    print "ethiopic multiplication of $plier and $plicand\n" if $tutor;
    my $r = 0;
    while ($plier >= 1)
    {
	$r += $plicand unless iseven($plier);
	if ($tutor) {
	    print "$plier, $plicand ", (iseven($plier) ? " struck" : " kept"), "\n";
	}
	$plier = halve($plier);
	$plicand = double($plicand);
    }
    return $r;
}

print ethiopicmult(17,34, 1), "\n";


if ($s eq "") {    # Test for empty string
  print "The string is empty";
}
if ($s ne "") {    # Test for non empty string
  print "The string is not empty";
}


with javascript_semantics
string s

s = ""                  -- assign an empty string

if length(s)=0 then     -- string is empty
if s="" then            -- string is empty

if length(s)!=0 then    -- string is not empty
if s!="" then           -- string is not empty


entropy = function(s)
   {freq = prop.table(table(strsplit(s, '')[1]))
    -sum(freq * log(freq, base = 2))}

print(entropy("1223334444"))   # 1.846439


#lang racket
(require math)
(provide entropy hash-entropy list-entropy digital-entropy)

(define (hash-entropy h)
  (define (log2 x) (/ (log x) (log 2)))
  (define n (for/sum [(c (in-hash-values h))] c))
  (- (for/sum ([c (in-hash-values h)] #:unless (zero? c))
       (* (/ c n) (log2 (/ c n))))))

(define (list-entropy x) (hash-entropy (samples->hash x)))

(define entropy         (compose list-entropy string->list))
(define digital-entropy (compose entropy number->string))

(module+ test
  (require rackunit)
  (check-= (entropy "1223334444") 1.8464393446710154 1E-8)
  (check-= (digital-entropy 1223334444) (entropy "1223334444") 1E-8)
  (check-= (digital-entropy 1223334444) 1.8464393446710154 1E-8)
  (check-= (entropy "xggooopppp") 1.8464393446710154 1E-8))

(module+ main (entropy "1223334444"))


sub entropy(@a) {
    [+] map -> \p { p * -log p }, bag(@a).values »/» +@a;
}

say log(2) R/ entropy '1223334444'.comb;


int main(int argc, const char **argv) {
    return 0;
}


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 = 0
    while a!=0 do
        if not emIsEven(a) then sum += b end if
        a = emHalf(a)
        b = emDouble(b)
    end while
    return sum
end function

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


<?php
function halve($x)
{
  return floor($x/2);
}

function double($x)
{
  return $x*2;
}

function iseven($x)
{
  return !($x & 0x1);
}

function ethiopicmult($plier, $plicand, $tutor)
{
  if ($tutor) echo "ethiopic multiplication of $plier and $plicand\n";
  $r = 0;
  while($plier >= 1) {
    if ( !iseven($plier) ) $r += $plicand;
    if ($tutor)
      echo "$plier, $plicand ", (iseven($plier) ? "struck" : "kept"), "\n";
    $plier = halve($plier);
    $plicand = double($plicand);
  }
  return $r;
}

echo ethiopicmult(17, 34, true), "\n";

?>


<?php

$str = ''; // assign an empty string to a variable

// check that a string is empty
if (empty($str)) { ... }

// check that a string is not empty
if (! empty($str)) { ... }

// we could also use the following
if ($str == '') { ... }
if ($str != '') { ... }

if (strlen($str) == 0) { ... }
if (strlen($str) != 0) { ... }


main =>
  S = "",            % assign an empty string to a variable
  S == "",           % check that a string is empty,
  "not empty" != "". % check that a string is not empty


# To assign a variable an empty string:
(off String)
(setq String "")
(setq String NIL)

# To check for an empty string:
(or String ..)
(ifn String ..)
(unless String ..)

# or a non-empty string:
(and String ..)
(if String ..)
(when String ..)


/* REXX ***************************************************************
* 28.02.2013 Walter Pachl
* 12.03.2013 Walter Pachl  typo in log corrected. thanx for testing
* 22.05.2013 -"- extended the logic to accept other strings
* 25.05.2013 -"- 'my' log routine is apparently incorrect
* 25.05.2013 -"- problem identified & corrected
**********************************************************************/
Numeric Digits 30
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*log(p.c,30,2)
  End
Say 'Version 1:' s 'Entropy' format(-e,,12)
Exit

log: Procedure
/***********************************************************************
* Return log(x) -- with specified precision and a specified base
* Three different series are used for the ranges  0 to 0.5
*                                                 0.5 to 1.5
*                                                 1.5 to infinity
* 03.09.1992 Walter Pachl
* 25.05.2013 -"- 'my' log routine is apparently incorrect
* 25.05.2013 -"- problem identified & corrected
***********************************************************************/
  Parse Arg x,prec,b
  If prec='' Then prec=9
  Numeric Digits (2*prec)
  Numeric Fuzz   3
  Select
    When x<=0 Then r='*** invalid argument ***'
    When x<0.5 Then Do
      z=(x-1)/(x+1)
      o=z
      r=z
      k=1
      Do i=3 By 2
        ra=r
        k=k+1
        o=o*z*z
        r=r+o/i
        If r=ra Then Leave
        End
      r=2*r
      End
    When x<1.5 Then Do
      z=(x-1)
      o=z
      r=z
      k=1
      Do i=2 By 1
        ra=r
        k=k+1
        o=-o*z
        r=r+o/i
        If r=ra Then Leave
        End
      End
    Otherwise /* 1.5<=x */ Do
      z=(x+1)/(x-1)
      o=1/z
      r=o
      k=1
      Do i=3 By 2
        ra=r
        k=k+1
        o=o/(z*z)
        r=r+o/i
        If r=ra Then Leave
        End
      r=2*r
      End
    End
  If b<>'' Then
    r=r/log(b,prec)
  Numeric Digits (prec)
  r=r+0
  Return r


ethiopian(Multiplier, Multiplicand) = ethiopian(Multiplier, Multiplicand,false).

ethiopian(Multiplier, Multiplicand,Tutor) = Result =>
  if Tutor then
    printf("\n%d * %d:\n",Multiplier, Multiplicand)
  end,
  Result1 = 0,
  while (Multiplier >= 1)
    OldResult = Result1,
    if not even(Multiplier) then
       Result1 := Result1 + Multiplicand
    end,
    if Tutor then
      printf("%6d  % 8s\n",Multiplier,cond(OldResult=Result1,"--",Multiplicand.to_string()))
    end,
    Multiplier := halve(Multiplier),
    Multiplicand := double(Multiplicand)
  end,
  if Tutor then
    println("         ======="),
    printf("        %8s\n",Result1.to_string()),
    nl
  end,
  Result = Result1.


(de halve (N)
   (/ N 2) )

(de double (N)
   (* N 2) )

(de even? (N)
   (not (bit? 1 N)) )

(de ethiopian (X Y)
   (let R 0
      (while (>= X 1)
         (or (even? X) (inc 'R Y))
         (setq
            X (halve X)
            Y (double Y) ) )
      R ) )


int main() {
	string s;

	if (!s == 1 || sizeof(s) == 0 || s == "") {
		write("String is empty\n");
	}
	else {
		write("String not empty\n");
	}

	return 0;
}


Dcl s Char(10) Varying;
s = '';                   /* assign an empty string to a variable. */
if length(s) = 0 then ... /* To test whether a string is empty */
if length(s) > 0 then ... /* to test for a non-empty string */


To run:
Start up.
Put "" into a string.
If the string is blank, write "Empty!" on the console.
If the string is not blank, write "Not empty!" on the console.
Wait for the escape key.
Shut down.


[string]$alpha = "abcdefghijklmnopqrstuvwxyz"
[string]$empty = ""
# or...
[string]$empty = [String]::Empty


decimals(8)
entropy = 0
countOfChar = list(255)

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

for i =1 to len( source)
     ch =substr(source, i, 1)
     if not(substr( usedChar, ch)) usedChar =usedChar +ch ok
     j  =substr( usedChar, ch)
    countOfChar[j] =countOfChar[j] +1
next

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

see "Characters used and the number of occurrences of each " + nl
for i =1 to l
      see "'" + substr(usedChar, i, 1) + "' " + countOfChar[i] + nl
next

see " Entropy of " + source + " is  " + entropy + " bits." + nl
see " The result should be around 1.84644 bits." + nl

func logBase (x, b)
        logBase =log( x) /log( 2)
        return logBase


def entropy(s)
  counts = Hash.new(0.0)
  s.each_char { |c| counts[c] += 1 }
  leng = s.length

  counts.values.reduce(0) do |entropy, count|
    freq = count / leng
    entropy - freq * Math.log2(freq)
  end
end

p entropy("1223334444")


dim chrCnt( 255) 			' possible ASCII chars

source$		= "1223334444"
numChar		= len(source$)

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

lc	= len(chrUsed$)
for i = 1 to lc
	odds	= chrCnt(i) /numChar
	entropy	= entropy - (odds * (log(odds) / log(2)))
next i

print " Characters used and times used of each "
for i = 1 to lc
	print " '"; mid$(chrUsed$,i,1); "'";chr$(9);chrCnt(i)
next i

print " Entropy of '"; source$; "' is  "; entropy; " bits."

end


#include default-libraries

#author .

class .:


int ethopian_multiply(int l, int r)
{
    int halve(int n) { return n/2; };
    int double(int n) { return n*2; };
    int(0..1) evenp(int n) { return !(n%2); };

    int product = 0;
    do
    {
        write("%5d %5d\n", l, r);
        if (!evenp(l))
            product += r;
        l = halve(l);
        r = double(r);
    }
    while(l);
    return product;
}


   declare (L(30), R(30)) fixed binary;
   declare (i, s) fixed binary;

   L, R = 0;
   put skip list
      ('Hello, please type two values and I will print their product:');
   get list (L(1), R(1));
   put edit ('The product of ', trim(L(1)), ' and ', trim(R(1)), ' is ') (a);
   do i = 1 by 1 while (L(i) ^= 0);
      L(i+1) = halve(L(i));
      R(i+1) = double(R(i));
   end;
   s = 0;
   do i = 1 by 1 while (L(i) > 0);
      if odd(L(i)) then s = s + R(i);
   end;
   put edit (trim(s)) (a);

halve: procedure (k) returns (fixed binary);
   declare k fixed binary;
   return (k/2);
end halve;
double: procedure (k) returns (fixed binary);
   declare k fixed binary;
   return (2*k);
end;
odd: procedure (k) returns (bit (1));
   return (iand(k, 1) ^= 0);
end odd;


assign_empty_string(Variable) :- Variable = "".

is_empty_string(String)  :- String ==  "".
not_empty_string(String) :- String \== "".


Procedure.s isStringEmpty(a.s)
  If a
    ProcedureReturn "String is not empty, it contains '" + a + "'."
  Else
    ProcedureReturn "String is empty, or null."
  EndIf
EndProcedure

If OpenConsole()
  Define a.s = ""
  Define b.s = "stuff"
  PrintN(isStringEmpty(a))
  PrintN(isStringEmpty(b))

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


s = ''
# or:
s = str()

if not s or s == '':
   print("String is empty")

if len(s) == 0:
    print("String is empty")
else:
    print("String not empty")

# boolean test function for python2 and python3
# test for regular (non-unicode) strings
# unicode strings
# None
def emptystring(s):
   if isinstance(s, (''.__class__ , u''.__class__) ):
      if len(s) == 0:
         return True
      else
         return False

   elif s is None:
        return True


fn entropy(s: &[u8]) -> f32 {
    let mut histogram = [0u64; 256];

    for &b in s {
        histogram[b as usize] += 1;
    }

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

fn main() {
    let arg = std::env::args().nth(1).expect("Need a string.");
    println!("Entropy of {} is {}.", arg, entropy(arg.as_bytes()));
}


import scala.math._

def entropy( v:String ) = { v
  .groupBy (a => a)
  .values
  .map( i => i.length.toDouble / v.length )
  .map( p => -p * log10(p) / log10(2))
  .sum
}

// Confirm that "1223334444" has an entropy of about 1.84644
assert( math.round( entropy("1223334444") * 100000 ) * 0.00001 == 1.84644 )


CREATE OR REPLACE PACKAGE ethiopian IS

  FUNCTION multiply
    ( left    IN  INTEGER,
      right   IN  INTEGER)
  RETURN INTEGER;

END ethiopian;
/

CREATE OR REPLACE PACKAGE BODY ethiopian IS

  FUNCTION is_even(item  IN INTEGER) RETURN BOOLEAN IS
  BEGIN
    RETURN item MOD 2 = 0;
  END is_even;

  FUNCTION double(item  IN INTEGER) RETURN INTEGER IS
  BEGIN
    RETURN item * 2;
  END double;

  FUNCTION half(item  IN INTEGER) RETURN INTEGER IS
  BEGIN
    RETURN TRUNC(item / 2);
  END half;

  FUNCTION multiply
    ( left   IN INTEGER,
      right  IN INTEGER)
    RETURN INTEGER
  IS
    temp     INTEGER := 0;
    plier    INTEGER := left;
    plicand  INTEGER := right;
  BEGIN

    LOOP
      IF NOT is_even(plier) THEN
        temp := temp + plicand;
      END IF;
      EXIT WHEN plier <= 1;
      plier := half(plier);
      plicand := double(plicand);
    END LOOP;

    RETURN temp;

  END multiply;

END ethiopian;
/

/* example call */
BEGIN
  DBMS_OUTPUT.put_line(ethiopian.multiply(17, 34));
END;
/


DIM s1 AS STRING 'initialized empty
IF LEN(s1) = 0 THEN PRINT "Empty"

s2$ = ""
IF s2$ = "" THEN PRINT "Empty"

s3$ = "cat"
IF LEN(s3$) <> 0 THEN PRINT "Not empty"
IF s3$ <> "" THEN PRINT "Still not empty"


Welcome to Quackery.

Enter "leave" to leave the shell.

/O> $ "" temp put ( move an empty string to temp                                     )
... temp share    ( copy the empty string on temp to the stack                       )
... $ '' =        ( compare the top of stack to an empty string, and replace it with
...                 1 (true) if it is an empty string and 0 (false) if it is not.    )
... temp take     ( move the empty string on temp to the stack                       )
... $ '' !=       ( compare the top of stack to an empty string, and replace it with
...                 1 (true) if it is not an empty string and 0 (false) if it is.    )
...

Stack: 1 0

/O> leave
...

Aloha.


10 let s=""
20 if s="" then let o=""
30 if s<>"" then let o="not "
40 print "The string is ";o;"empty."


s <- ''

if (s == '') cat('Empty\n')
#or
if (nchar(s) == 0) cat('Empty\n')

if (s != '') cat('Not empty\n')
#or
if (nchar(s) > 0) cat('Not empty\n')


(define (entropy input)
  (define (close? a b)
    (define (norm x y)
      (define (infinite_norm m n)
        (define (absminus p q)
             (cond ((null? p) '())
                (else (cons (abs (- (car p) (car q))) (absminus (cdr p) (cdr q))))))
        (define (mm l)
             (cond ((null? (cdr l)) (car l))
                   ((> (car l) (cadr l)) (mm (cons (car l) (cddr l))))
                   (else (mm (cdr l)))))
        (mm (absminus m n)))
      (if (pair? x) (infinite_norm x y) (abs (- x y))))
    (let ((epsilon 0.2))
      (< (norm a b) epsilon)))
  (define (freq-list x)
    (define (f x)
      (define (count a b)
        (cond ((null? b) 1)
              (else (+ (if (close? a (car b)) 1 0) (count a (cdr b))))))
      (let ((t (car x)) (tt (cdr x)))
        (count t tt)))
    (define (g x)
      (define (filter a b)
        (cond ((null? b) '())
              ((close? a (car b)) (filter a (cdr b)))
              (else (cons (car b) (filter a (cdr b))))))
      (let ((t (car x)) (tt (cdr x)))
        (filter t tt)))
    (cond ((null? x) '())
          (else (cons (f x) (freq-list (g x))))))
  (define (scale x)
    (define (sum x)
      (if (null? x) 0.0 (+ (car x) (sum (cdr x)))))
    (let ((z (sum x)))
      (map (lambda(m) (/ m z)) x)))
  (define (cal x)
    (if (null? x) 0 (+ (* (car x) (/ (log (car x)) (log 2))) (cal (cdr x)))))
  (- (cal (scale (freq-list input)))))

(entropy (list 1 2 2 3 3 3 4 4 4 4))
(entropy (list (list 1 1) (list 1.1 1.1) (list 1.2 1.2) (list 1.3 1.3) (list 1.5 1.5) (list 1.6 1.6)))


;;; This is a valid Pop11 program that does absolutely nothing.


\All required helper routines already exist in Plain English:
\
\To cut a number in half:
\Divide the number by 2.
\
\To double a number:
\Add the number to the number.
\
\To decide if a number is odd:
\Privatize the number.
\Bitwise and the number with 1.
\If the number is 0, say no.
\Say yes.

To run:
Start up.
Put 17 into a number.
Multiply the number by 34 (Ethiopian).
Convert the number to a string.
Write the string to the console.
Wait for the escape key.
Shut down.

To multiply a number by another number (Ethiopian):
Put 0 into a sum number.
Loop.
If the number is 0, break.
If the number is odd, add the other number to the sum.
Cut the number in half.
Double the other number.
Repeat.
Put the sum into the number.


public function boolean wf_iseven (long al_arg);return mod(al_arg, 2 ) = 0
end function

public function long wf_halve (long al_arg);RETURN int(al_arg / 2)
end function

public function long wf_double (long al_arg);RETURN al_arg * 2
end function

public function long wf_ethiopianmultiplication (long al_multiplicand, long al_multiplier);// calculate result
long ll_product

DO WHILE al_multiplicand >= 1
	IF wf_iseven(al_multiplicand) THEN
		// do nothing
	ELSE
		ll_product += al_multiplier
	END IF
	al_multiplicand = wf_halve(al_multiplicand)
	al_multiplier = wf_double(al_multiplier)
LOOP

return ll_product
end function

// example call
long ll_answer
ll_answer = wf_ethiopianmultiplication(17,34)


#lang racket

(define empty-string "")
(define (string-null? s) (string=? "" s))
(define (string-not-null? s) (string<? "" s))


my $s = '';
say 'String is empty' unless $s;
say 'String is not empty' if $s;


str s = "";
if (s=="") print("string s is empty");
if (s!="") print("string s is not empty");


Red []
s: copy ""   ;; assign empty string
?? s
if empty? s [print "string is empty "]          ;; check if string is empty
s: "abc"
prin s unless empty? s  [print " not empty"]


function E = entropy(d)
    d=strsplit(d);
    n=unique(string(d));
    N=size(d,'r');

    count=zeros(n);
    n_size = size(n,'r');
    for i = 1:n_size
       count(i) = sum ( d == n(i) );
    end

    E=0;
    for i=1:length(count)
        E = E - count(i)/N * log(count(i)/N) / log(2);
    end
endfunction

word ='1223334444';
E = entropy(word);
disp('The entropy of '+word+' is '+string(E)+'.');


$ include "seed7_05.s7i";
  include "float.s7i";
  include "math.s7i";

const func float: entropy (in string: stri) is func
  result
    var float: entropy is 0.0;
  local
    var hash [char] integer: count is (hash [char] integer).value;
    var char: ch is ' ';
    var float: p is 0.0;
  begin
    for ch range stri do
      if ch in count then
        incr(count[ch]);
      else
        count @:= [ch] 1;
      end if;
    end for;
    for key ch range count do
      p := flt(count[ch]) / flt(length(stri));
      entropy -:= p * log(p) / log(2.0);
    end for;
  end func ;

const proc: main is func
  begin
    writeln(entropy("1223334444") digits 5);
  end func;


func entropy(s) {
  var counts = Hash.new;
  s.each { |c| counts{c} := 0 ++ };
  var len = s.len;
  [0, counts.values.map {|count|
    var freq = count/len; freq * freq.log2 }...
  ]«-»;
}

say entropy("1223334444");


function isEven {
	param ([int]$value)
	return [bool]($value % 2 -eq 0)
}

function doubleValue {
	param ([int]$value)
	return [int]($value * 2)
}

function halveValue {
	param ([int]$value)
	return [int]($value / 2)
}

function multiplyValues {
	param (
		[int]$plier,
		[int]$plicand,
		[int]$temp = 0
	)

	while ($plier -ge 1)
	{
		if (!(isEven $plier)) {
			$temp += $plicand
		}
		$plier = halveValue $plier
		$plicand = doubleValue $plicand
	}

return $temp
}

multiplyValues 17 34


halve(X,Y) :- Y is X // 2.
double(X,Y) :- Y is 2*X.
is_even(X) :- 0 is X mod 2.

% columns(First,Second,Left,Right) is true if integers First and Second
% expand into the columns Left and Right, respectively
columns(1,Second,[1],[Second]).
columns(First,Second,[First|Left],[Second|Right]) :-
    halve(First,Halved),
    double(Second,Doubled),
    columns(Halved,Doubled,Left,Right).

% contribution(Left,Right,Amount) is true if integers Left and Right,
% from their respective columns contribute Amount to the final sum.
contribution(Left,_Right,0) :-
    is_even(Left).
contribution(Left,Right,Right) :-
    \+ is_even(Left).

ethiopian(First,Second,Product) :-
    columns(First,Second,Left,Right),
    maplist(contribution,Left,Right,Contributions),
    sumlist(Contributions,Product).


( by creating a variable )
"" keepString variable: foo

( by setting an existing variable 'foo' )
"" keepString !foo


/*REXX program shows how to assign an empty string, & then check for empty/not-empty str*/

                /*─────────────── 3 simple ways to assign an empty string to a variable.*/
auk=''          /*uses two single quotes (also called  apostrophes);  easier to peruse. */
ide=""          /*uses two quotes,  sometimes called a  double quote.                   */
doe=            /*··· nothing at all   (which in this case, a null value is assigned.   */

                /*─────────────── assigning multiple null values to vars, 2 methods are:*/
parse var doe emu pug yak nit moa owl pas jay koi ern ewe fae gar hob

                /*where  emu, pug, yak, ···  (and the rest) are all set to a null value.*/

                /*───or─── (with less clutter ─── or more, depending on your perception)*/
parse value 0 with . ant ape ant imp fly tui paa elo dab cub bat ayu
                /*where the value of  zero  is skipped,  and  the rest are set to  null,*/
                /*which is the next value  AFTER  the  0  (zero):   nothing (or a null).*/

                /*─────────────── how to check that a string is empty, several methods: */
if cat==''         then say "the feline is not here."
if pig==""         then say 'no ham today.'
if length(gnu)==0  then say "the wildebeest's stomach is empty and hungry."
if length(ips)=0   then say "checking with   ==   instead of  =  is faster"
if length(hub)<1   then method = "this is rather obtuse,  don't do as I do ···"

nit=''                                           /*assign an empty string to a lice egg.*/
if cow==nit        then say 'the cow has no milk today.'

                /*─────────────── how to check that a string isn't empty, several ways: */
if dog\==''        then say "the dogs are out!"
                                                 /*most REXXes support the ¬ character. */
if fox¬==''        then say "and the fox is in the henhouse."
if length(rat)>0   then say "the rat is singing" /*an obscure-ish (or ugly) way to test.*/

if elk==''         then nop; else say "long way obtuse for an elk to be tested."

if length(eel)\==0 then fish=eel                 /*a fast compare (than below), & quick.*/
if length(cod)\=0  then fish=cod                 /*a not-as-fast compare.               */

                /*────────────────────────── anyway, as they say: "choose your poison." */


val Entropy = fn input =>
 let
   val   N     = Real.fromInt (String.size input) ;
   val  term   = fn a => Math.ln (a/N) * a  /  ( Math.ln 2.0 * N ) ;
   val   v0    = Vector.tabulate (255,fn i=>0)   ;
   val  freq   = Vector.map Real.fromInt                                         (* List.foldr:  count occurrences  *)
                   (List.foldr   (fn (i,v) => Vector.update( v, ord i, Vector.sub(v,ord i) + 1) ) v0 (explode input) )
 in

      ~ (Vector.foldr  (fn (a,s) => if a > 0.0 then term a  + s else s)  0.0  freq )

end ;


import Foundation

func entropy(of x: String) -> Double {
  return x
    .reduce(into: [String: Int](), {cur, char in
      cur[String(char), default: 0] += 1
    })
    .values
    .map({i in Double(i) / Double(x.count) } as (Int) -> Double)
    .map({p in -p * log2(p) } as (Double) -> Double)
    .reduce(0.0, +)
}

print(entropy(of: "1223334444"))


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


tutor = True

def halve(x):
    return x // 2

def double(x):
    return x * 2

def even(x):
    return not x % 2

def ethiopian(multiplier, multiplicand):
    if tutor:
        print("Ethiopian multiplication of %i and %i" %
              (multiplier, multiplicand))
    result = 0
    while multiplier >= 1:
        if even(multiplier):
            if tutor:
                print("%4i %6i STRUCK" %
                      (multiplier, multiplicand))
        else:
            if tutor:
                print("%4i %6i KEPT" %
                      (multiplier, multiplicand))
            result += multiplicand
        multiplier   = halve(multiplier)
        multiplicand = double(multiplicand)
    if tutor:
        print()
    return result


[ 1 & not ]                is even   (   n --> b )

[ 1 << ]                   is double (   n --> n )

[ 1 >> ]                   is halve  (   n --> n )

[ dup 0 < unrot abs
  [ dup 0 = iff nip done
    over double over halve
    recurse
    swap even
    iff nip else + ]
  swap if negate ]         is e*     ( n n --> n )


cStr = NULL # empty string
if cStr = NULL
   see "cstr is an empty string!" + nl
else
   see "cstr is not empty string!" + nl
ok


set "$string" to ""
if "$string.length" = 0 then "empty"
* "Not an empty string."
end

: "empty"
* "Empty string"
end


s = ""
s = String.new
s = "any string"; s.clear


var$ = ""
' --------------
'empty string
' -------------
if var$=""	then print "String is Empty"
if len(var$)=0	then print "String is Empty"
' -------------
'not empty string
' -------------
if var$<>"" 	then print "String Not empty."
if len(var$)>0	then print "String Not empty."


let s = "";
println!("is empty: {}", s.is_empty());
let t = "x";
println!("is empty: {}", t.is_empty());
let a = String::new();
println!("is empty: {}", a.is_empty());
let b = "x".to_string();
println!("is empty: {}", b.is_empty());
println!("is not empty: {}", !b.is_empty());


import math
import arrays

fn hist(source string) map[string]int {
    mut hist := map[string]int{}
    for e in source.split('') {
        if e !in hist {
            hist[e] = 0
        }
        hist[e]+=1
    }
    return hist
}

fn entropy(hist map[string]int, l int) f64 {
    mut elist := []f64{}
    for _,v in hist {
        c := f64(v) / f64(l)
        elist << -c * math.log2(c)
    }
    return arrays.sum<f64>(elist) or {-1}
}

fn main(){
    input := "1223334444"
    h := hist(input)
    e := entropy(h, input.len)
    println(e)
}


var s = "1223334444"
var m = {}
for (c in s) {
    var d = m[c]
    m[c] = (d) ? d + 1 : 1
}
var hm = 0
for (k in m.keys) {
    var c = m[k]
    hm = hm + c * c.log2
}
var l = s.count
System.print(l.log2 - hm/l)


code real RlOut=48, Ln=54;      \intrinsic routines
string 0;                       \use zero-terminated strings

func StrLen(A);                 \Return number of characters in an ASCIIZ string
char A;
int  I;
for I:= 0, -1>>1-1 do
    if A(I) = 0 then return I;

func real Entropy(Str);         \Return Shannon entropy of string
char Str;
int  Len, I, Count(128);
real Sum, Prob;
[Len:= StrLen(Str);
for I:= 0 to 127 do Count(I):= 0;
for I:= 0 to Len-1 do           \count number of each character in string
    Count(Str(I)):= Count(Str(I)) + 1;
Sum:= 0.0;
for I:= 0 to 127 do
    if Count(I) # 0 then        \(avoid Ln(0.0) error)
        [Prob:= float(Count(I)) / float(Len);   \probability of char in string
        Sum:= Sum + Prob*Ln(Prob);
        ];
return -Sum/Ln(2.0);
];

RlOut(0, Entropy("1223334444"))


halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0

ethiopicmult <- function(plier, plicand, tutor=FALSE) {
  if (tutor) { cat("ethiopic multiplication of", plier, "and", plicand, "\n") }
  result <- 0
  while(plier >= 1) {
    if (!iseven(plier)) { result <- result + plicand }
    if (tutor) {
      cat(plier, ", ", plicand, " ", ifelse(iseven(plier), "struck", "kept"), "\n", sep="")
    }
    plier <- halve(plier)
    plicand <- double(plicand)
  }
  result
}

print(ethiopicmult(17, 34, TRUE))


#lang racket

(define (halve  i) (quotient i 2))
(define (double i) (* i 2))
;; `even?' is built-in

(define (ethiopian-multiply x y)
  (cond [(zero? x) 0]
        [(even? x) (ethiopian-multiply (halve x) (double y))]
        [else (+ y (ethiopian-multiply (halve x) (double y)))]))

(ethiopian-multiply 17 34) ; -> 578


sub halve  (Int $n is rw)    { $n div= 2 }
sub double (Int $n is rw)    { $n *= 2 }
sub even   (Int $n --> Bool) { $n %% 2 }

sub ethiopic-mult (Int $a is copy, Int $b is copy --> Int) {
    my Int $r = 0;
    while $a {
	even $a or $r += $b;
	halve $a;
	double $b;
    }
    return $r;
}

say ethiopic-mult(17,34);


// assign empty string to a variable
val s=""
// check that string is empty
s.isEmpty    // true
s==""        // true
s.size==0    // true
// check that string is not empty
s.nonEmpty   // false
s!=""        // false
s.size>0     // false


(define empty-string "")
(define (string-null? s) (string=? "" s))
(define (string-not-null? s) (string<? "" s))


# assign empty string to a variable
s := ""

# check that string is empty
s = ""

# check that string is not empty
s <> ""


"Put an empty string in a slot called 'str'"
str: ''.

"Check that string is empty"
str isEmpty.

"Check that string is not empty"
str isEmpty not.


const std = @import("std");
const math = std.math;

pub fn main() !void {
    const stdout = std.io.getStdOut().outStream();
    try stdout.print("{d:.12}\n", .{H("1223334444")});
}

fn H(s: []const u8) f64 {
    var counts = [_]u16{0} ** 256;
    for (s) |ch|
        counts[ch] += 1;

    var h: f64 = 0;
    for (counts) |c|
        if (c != 0) {
            const p = @intToFloat(f64, c) / @intToFloat(f64, s.len);
            h -= p * math.log2(p);
        };

    return h;
}


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

entropy("1223334444").println(" bits");


10 LET s$="1223334444": LET base=2: LET entropy=0
20 LET sourcelen=LEN s$
30 DIM t(255)
40 FOR i=1 TO sourcelen
50 LET number= CODE s$(i)
60 LET t(number)=t(number)+1
70 NEXT i
80 PRINT "Char";TAB (6);"Count"
90 FOR i=1 TO 255
100 IF t(i)<>0 THEN PRINT CHR$ i;TAB (6);t(i): LET prop=t(i)/sourcelen: LET entropy=entropy-(prop*(LN prop)/(LN base))
110 NEXT i
120 PRINT '"The Entropy of """;s$;""" is ";entropy


import IO;

public int halve(int n) = n/2;

public int double(int n) = n*2;

public bool uneven(int n) = (n % 2) != 0);

public int ethiopianMul(int n, int m) {
	result = 0;
	while(n >= 1) {
		if(uneven(n))
			result += m;
		n = halve(n);
		m = double(m);
	}
	return result;
}


Red["Ethiopian multiplication"]

halve: function [n][n >> 1]
double: function [n][n << 1]
;== even? already exists

ethiopian-multiply: function [
    "Returns the product of two integers using Ethiopian multiplication"
    a [integer!] "The multiplicand"
    b [integer!] "The multiplier"
][
    result: 0
    while [a <> 0][
        if odd? a [result: result + b]
        a: halve a
        b: double b
    ]
    result
]

print ethiopian-multiply 17 34


set emptyString to ""

put emptyString

put emptyString is empty

put emptyString is not empty


"Assign empty string to a variable"
  str := ''.

"Check that string is empty"
  str isEmpty.

"Check that string is not empty"
  str isEmpty not.
"alternatives:"
  str notEmpty
  str size = 0
  str = ''


* ASSIGN THE NULL STRING TO X
        X =
* CHECK THAT X IS INDEED NULL
        EQ(X, NULL)         :S(YES)
        OUTPUT = 'NOT NULL' :(END)
YES     OUTPUT = 'NULL'
END


$ include "seed7_05.s7i";

const proc: main is noop;


function half(x)
set result = floor(x/2)
end function

function double(x)
set result = 2*x
end function

function even(x)
set result = (x/2 > floor(x/2))
end function

program ethiopian_mul(a,b)
relation first, second
while a >= 1
insert a, b
set a = half(a)
set b = double(b)
end while
extend third = even(first) *  second
project third sum
end program

run ethiopian_mul(17,34)
print


/*REXX program multiplies two integers by the  Ethiopian  (or Russian peasant)  method. */
numeric digits 3000                              /*handle some gihugeic integers.       */
parse arg a b .                                  /*get two numbers from the command line*/
say  'a=' a                                      /*display a formatted value of  A.     */
say  'b='   b                                    /*   "    "     "       "    "  B.     */
say  'product='    eMult(a, b)                   /*invoke eMult & multiple two integers.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
eMult:   procedure;  parse arg x,y;  s=sign(x)   /*obtain the two arguments; sign for X.*/
         $=0                                     /*product of the two integers (so far).*/
                      do  while x\==0            /*keep processing while   X   not zero.*/
                      if \isEven(x)  then $=$+y  /*if odd,  then add   Y   to product.  */
                      x= halve(x)                /*invoke the  HALVE   function.        */
                      y=double(y)                /*   "    "   DOUBLE      "            */
                      end   /*while*/            /* [↑]  Ethiopian multiplication method*/
         return $*s/1                            /*maintain the correct sign for product*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
double:  return  arg(1)  * 2                     /*   *   is REXX's  multiplication.    */
halve:   return  arg(1)  % 2                     /*   %    "   "     integer division.  */
isEven:  return  arg(1) // 2 == 0                /*   //   "   "     division remainder.*/


(* Assign empty string to a variable *)
val s = ""
(* Check that a string is empty*)
s = ""
(* Check that a string is nonempty *)
s <> ""


scalar s=""

display s==""

* Alternatively, check the length
display length(s)==0


var s = ""
if s.isEmpty { // alternately, s == ""
  println("s is empty")
} else {
  println("s is not empty")
}


set s ""
if {$s eq ""} {puts "s contains an empty string"}
if {$s ne ""} {puts "s contains a non-empty string"}


x = 17
y = 34
p = 0
while x != 0
      if not even(x)
         p += y
         see "" + x + " " + " " + y + nl
      else
         see "" + x + "  ---" + nl ok
         x = halve(x)
         y = double(y)
end
see " " + "  ===" + nl
see "   " + p

func double n return (n * 2)
func halve n return floor(n / 2)
func even n return ((n & 1) = 0)


def halve(x)   x/2  end
def double(x)  x*2  end

# iterative
def ethiopian_multiply(a, b)
  product = 0
  while a >= 1
    p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG
    product += b unless a.even?
    a = halve(a)
    b = double(b)
  end
  product
end

# recursive
def rec_ethiopian_multiply(a, b)
  return 0 if a < 1
  p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG
  (a.even? ? 0 : b) + rec_ethiopian_multiply(halve(a), double(b))
end

$DEBUG = true   # $DEBUG also set to true if "-d" option given
a, b = 20, 5
puts "#{a} * #{b} = #{ethiopian_multiply(a,b)}"; puts


$$ MODE TUSCRIPT
s=""
IF (s=="") PRINT "s is an empty string"
IF (s!="") PRINT "s is a non-empty string"


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

# the "test" command can determine truth by examining the string itself
if [ "$s" ]; then echo "not empty"; else echo "empty"; fi

# compare the string to the empty string
if [ "$s" = "" ]; then echo "s is the empty string"; fi
if [ "$s" != "" ]; then echo "s is not empty"; fi

# examine the length of the string
if [ -z "$s" ]; then echo "the string has length zero: it is empty"; fi
if [ -n "$s" ]; then echo "the string has length non-zero: it is not empty"; fi


program define nop
        version 15
end


fn double(a: i32) -> i32 {
    2*a
}

fn halve(a: i32) -> i32 {
    a/2
}

fn is_even(a: i32) -> bool {
    a % 2 == 0
}

fn ethiopian_multiplication(mut x: i32, mut y: i32) -> i32 {
    let mut sum = 0;

    while x >= 1 {
        print!("{} \t {}", x, y);
        match is_even(x) {
            true  => println!("\t Not Kept"),
            false => {
                println!("\t Kept");
                sum += y;
            }
        }
        x = halve(x);
        y = double(y);
    }
    sum
}

fn main() {
    let output = ethiopian_multiplication(17, 34);
    println!("---------------------------------");
    println!("\t {}", output);
}


$constant true  =  0FFFFH
$constant false =  0

function half(n = integer) = integer
end = n / 2

function twice(n = integer) = integer
end = n + n

rem - return true (-1) if n is even, otherwise false
function even(n = integer) = integer
var one = integer
one = 1   rem - only variables are compared bitwise
end = ((n and one) = 0)

rem - return i * j, optionally showing steps
function ethiopian(i, j, show = integer) = integer
  var p = integer
  p = 0
  while i >= 1 do
    begin
      if even(i) then
        begin
          if show then print i;" ---";j
        end
      else
        begin
          if show then print i;"    ";j;"+"
          p = p + j
        end
      i = half(i)
      j = twice(j)
    end
  if show then
    begin
      print "----------"
      print "     =";
    end
end = p

rem - exercise the function
print "Multiplying 17 times 34"
print ethiopian(17,34,true)

end


def ethiopian(i:Int, j:Int):Int=
   pairIterator(i,j).filter(x=> !isEven(x._1)).map(x=>x._2).foldLeft(0){(x,y)=>x+y}

def ethiopian2(i:Int, j:Int):Int=
   pairIterator(i,j).map(x=>if(isEven(x._1)) 0 else x._2).foldLeft(0){(x,y)=>x+y}

def ethiopian3(i:Int, j:Int):Int=
{
   var res=0;
   for((h,d) <- pairIterator(i,j) if !isEven(h)) res+=d;
   res
}

def ethiopian4(i: Int, j: Int): Int = if (i == 1) j else ethiopian(halve(i), double(j)) + (if (isEven(i)) 0 else j)

def isEven(x:Int)=(x&1)==0
def halve(x:Int)=x>>>1
def double(x:Int)=x<<1

// generates pairs of values (halve,double)
def pairIterator(x:Int, y:Int)=new Iterator[(Int, Int)]
{
   var i=(x, y)
   def hasNext=i._1>0
   def next={val r=i; i=(halve(i._1), double(i._2)); r}
}


decl string s
set s ""

if (= s "")
	out "empty" endl console
else
	out "not empty" endl console
end if


desc:  .ascid "not empty"         ;descriptor (len+addr) and text
.entry empty, ^m<>
       tstw desc                  ;check length field
       beql is_empty
       ;... not empty
       clrw desc                  ;set length to zero -> empty
is_empty:
       ;... empty
       ret
.end empty


dim s as string

' assign an empty string to a variable (six bytes):
s = ""
' assign null string pointer to a variable (zero bytes, according to RubberduckVBA):
s = vbNullString
' if your VBA code interacts with non-VBA code, this difference may become significant!

' test if a string is empty:
if s = "" then Debug.Print "empty!"
' or:
if Len(s) = 0 then Debug.Print "still empty!"

'test if a string is not empty:
if s <> "" then Debug.Print "not an empty string"
'or:
if Len(s) > 0 then Debug.Print "not empty."


Dim s As String

' Assign empty string:
s = ""
' or
s = String.Empty

' Check for empty string only (false if s is null):
If s IsNot Nothing AndAlso s.Length = 0 Then
End If

' Check for null or empty (more idiomatic in .NET):
If String.IsNullOrEmpty(s) Then
End If


(define (halve num)
  (quotient num 2))

(define (double num)
  (* num 2))

(define (*mul-eth plier plicand acc)
  (cond ((zero? plier) acc)
        ((even? plier) (*mul-eth (halve plier) (double plicand) acc))
        (else (*mul-eth (halve plier) (double plicand) (+ acc plicand)))))

(define (mul-eth plier plicand)
  (*mul-eth plier plicand 0))

(display (mul-eth 17 34))
(newline)


const proc: double (inout integer: a) is func
  begin
    a *:= 2;
  end func;

const proc: halve (inout integer: a) is func
  begin
    a := a div 2;
  end func;

const func boolean: even (in integer: a) is
  return not odd(a);

const func integer: peasantMult (in var integer: a, in var integer: b) is func
  result
    var integer: result is 0;
  begin
    while a <> 0 do
      if not even(a) then
        result +:= b;
      end if;
      halve(a);
      double(b);
    end while;
  end func;


// define and initialize an empty string
mut s := ""

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

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

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


0000  0000     1 .entry	main,0	;register save mask
  04  0002     2 	ret	;return from main procedure
      0003     3 .end	main	;start address for linker


func double (n) { n << 1 }
func halve  (n) { n >> 1 }
func isEven (n) { n&1 == 0 }

func ethiopian_mult(a, b) {
    var r = 0
    while (a > 0) {
        r += b if !isEven(a)
        a = halve(a)
        b = double(b)
    }
    return r
}

say ethiopian_mult(17, 34)


Number extend [
  double [ ^ self * 2 ]
  halve  [ ^ self // 2 ]
  ethiopianMultiplyBy: aNumber withTutor: tutor [
    |result multiplier multiplicand|
    multiplier := self.
    multiplicand := aNumber.
    tutor ifTrue: [ ('ethiopian multiplication of %1 and %2' %
                      { multiplier. multiplicand }) displayNl ].
    result := 0.
    [ multiplier >= 1 ]
      whileTrue: [
        multiplier even ifFalse: [
                           result := result + multiplicand.
                           tutor ifTrue: [
                              ('%1, %2 kept' % { multiplier. multiplicand })
                                displayNl
                           ]
                        ]
                        ifTrue: [
                           tutor ifTrue: [
                             ('%1, %2 struck' % { multiplier. multiplicand })
			       displayNl
                           ]
                        ].
        multiplier := multiplier halve.
        multiplicand := multiplicand double.
      ].
    ^result
  ]
  ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ]
].


let string$=""
if string$=""
print 1 "The string is empty."
elseif string$<>""
print 1 "The string is not empty."
endif
end


var isEmpty = Fn.new { |s| s == "" }

var s = ""
var t = "0"
System.print("'s' is empty? %(isEmpty.call(s))")
System.print("'t' is empty? %(isEmpty.call(t))")


option casemap:none

printf    proto :qword, :VARARG
exit      proto :dword

.data
e_str   db 1 dup (0)

.code
main proc
  xor rcx, rcx
  lea rax, e_str
  cmp byte ptr [rax+rcx],0          ;; Is e_str[0] equal to 0?
  je _isempty                       ;; Yes so goto isEmpty
  jne _notempty                     ;; No, got notEmpty
  jmp _exit                         ;; Neither condition is met, so exit.

  _isempty:
    invoke printf, CSTR("e_str is empty",10)
    lea rax, e_str
    mov byte ptr [rax+0], 's'       ;; Copy a char into e_str[0]
    jmp main                        ;; Test again..

  _notempty:
    invoke printf, CSTR("e_str is NOT empty",10)
    ;; Fall though to exit here..
 _exit:
    xor rsi, rsi
    call exit
    ret
main endp
end


entity dummy is
end;

architecture empty of dummy is
begin
end;


Module General
    Sub Main()
    End Sub
End Module


	define('halve(num)')	:(halve_end)
halve	eq(num,1)	:s(freturn)
	halve = num / 2	:(return)
halve_end

	define('double(num)')	:(double_end)
double	double = num * 2	:(return)
double_end

	define('odd(num)')	:(odd_end)
odd	eq(num,1)	:s(return)
	eq(num,double(halve(num)))	:s(freturn)f(return)

odd_end	l = trim(input)
	r = trim(input)
	s = 0
next	s = odd(l) s + r
	r = double(r)
	l = halve(l)	:s(next)
stop  	output = s
end


##########################################
# multiply takes ^left and ^right numbers
# and a ^return-to
sp {multiply*elaborate*initialize
   (state <s> ^superstate.operator <o>)
   (<o> ^name multiply
        ^left <x>
        ^right <y>
        ^return-to <r>)
-->
   (<s> ^name multiply
        ^left <x>
        ^right <y>
        ^return-to <r>)}

sp {multiply*propose*recurse
   (state <s> ^name multiply
              ^left <x> > 0
              ^right <y>
              ^return-to <r>
             -^multiply-done)
-->
   (<s> ^operator <o> +)
   (<o> ^name multiply
        ^left (div <x> 2)
        ^right (* <y> 2)
        ^return-to <s>)}

sp {multiply*elaborate*mod
   (state <s> ^name multiply
              ^left <x>)
-->
   (<s> ^left-mod-2 (mod <x> 2))}

sp {multiply*elaborate*recursion-done-even
   (state <s> ^name multiply
              ^left <x>
              ^right <y>
              ^multiply-done <temp>
              ^left-mod-2 0)
-->
   (<s> ^answer <temp>)}

sp {multiply*elaborate*recursion-done-odd
   (state <s> ^name multiply
              ^left <x>
              ^right <y>
              ^multiply-done <temp>
              ^left-mod-2 1)
-->
   (<s> ^answer (+ <temp> <y>))}

sp {multiply*elaborate*zero
   (state <s> ^name multiply
              ^left 0)
-->
   (<s> ^answer 0)}

sp {multiply*elaborate*done
   (state <s> ^name multiply
              ^return-to <r>
              ^answer <a>)
-->
   (<r> ^multiply-done <a>)}


[1] (define my-empty-string "") ;; assign an empty string to a variable

MY-EMPTY-STRING
[2] (string-null? my-empty-string)

#T
[3] (string-null? "A non-empty string")

()


code Text=12;
string 0;       \use zero-terminated convention, instead of MSb set
char S;
[S:= "";        \assign an empty string
if S(0) = 0 then Text(0, "empty
");
S:= "Hello";
if S(0) # 0 then Text(0, "not empty
");
]


s:="";     // or s:=String, String is the object ""
s.toBool() //-->False
if (s) println("not empty")


(module
    ;;The entry point for WASI is called _start
    (func $main (export "_start")

    )
)


section .text
	global _start

	_start:
		mov eax, 1
		int 0x80
		ret


import Darwin

func ethiopian(var #int1:Int, var #int2:Int) -> Int {
  var lhs = [int1], rhs = [int2]

  func isEven(#n:Int) -> Bool {return n % 2 == 0}
  func double(#n:Int) -> Int {return n * 2}
  func halve(#n:Int) -> Int {return n / 2}

  while int1 != 1 {
    lhs.append(halve(n: int1))
    rhs.append(double(n: int2))
    int1 = halve(n: int1)
    int2 = double(n: int2)
  }

  var returnInt = 0
  for (a,b) in zip(lhs, rhs) {
    if (!isEven(n: a)) {
      returnInt += b
    }
  }
  return returnInt
}

println(ethiopian(int1: 17, int2: 34))


# This is how to declare functions - the mathematical entities - as opposed to procedures
proc function {name arguments body} {
    uplevel 1 [list proc tcl::mathfunc::$name $arguments [list expr $body]]
}

function double n {$n * 2}
function halve n {$n / 2}
function even n {($n & 1) == 0}
function mult {a b} {
    $a < 1 ? 0 :
    even($a) ? [logmult STRUCK] + mult(halve($a), double($b))
	     : [logmult KEPT]   + mult(halve($a), double($b)) + $b
}

# Wrapper to set up the logging
proc ethiopianMultiply {a b {tutor false}} {
    if {$tutor} {
	set wa [expr {[string length $a]+1}]
	set wb [expr {$wa+[string length $b]-1}]
	puts stderr "Ethiopian multiplication of $a and $b"
	interp alias {} logmult {} apply {{wa wb msg} {
	    upvar 1 a a b b
	    puts stderr [format "%*d %*d %s" $wa $a $wb $b $msg]
	    return 0
	}} $wa $wb
    } else {
	proc logmult args {return 0}
    }
    return [expr {mult($a,$b)}]
}


var string
string = ""
if eq string ""
	print "The string is empty."
else
	print "The string is not empty."
endif


const std = @import("std");

pub fn main() !void {
    // default is [:0]const u8, which is a 0-terminated string with len field
    const str = "";
    if (str.len == 0) {
        std.debug.print("string empty\n", .{});
    }
    if (str.len != 0) {
        std.debug.print("string empty\n", .{});
    }
}


<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
   <!-- code goes here -->
</xsl:stylesheet>


$$ MODE TUSCRIPT
ASK "insert number1", nr1=""
ASK "insert number2", nr2=""

SET nrs=APPEND(nr1,nr2),size_nrs=SIZE(nrs)
IF (size_nrs!=2) ERROR/STOP "insert two numbers"
LOOP n=nrs
IF (n!='digits') ERROR/STOP n, " is not a digit"
ENDLOOP

PRINT "ethopian multiplication of ",nr1," and ",nr2

SET sum=0
SECTION checkifeven
SET even=MOD(nr1,2)
 IF (even==0) THEN
   SET action="struck"
 ELSE
   SET action="kept"
   SET sum=APPEND (sum,nr2)
 ENDIF
SET nr1=CENTER (nr1,+6),nr2=CENTER (nr2,+6),action=CENTER (action,8)
PRINT nr1,nr2,action
ENDSECTION

SECTION halve_i
SET nr1=nr1/2
ENDSECTION

SECTION double_i
nr2=nr2*2
ENDSECTION

DO checkifeven

LOOP
DO halve_i
DO double_i
DO checkifeven
IF (nr1==1) EXIT
ENDLOOP

SET line=REPEAT ("=",20), sum = sum(sum),sum=CENTER (sum,+12)
PRINT line
PRINT sum


// Ethiopian multiplication

function intToString(n: number, wdth: number): string {
  sn = Math.floor(n).toString();
  len = sn.length;
  return (wdth < len ? "#".repeat(wdth) : " ".repeat(wdth - len) + sn);
}

function double(a: number): number {
  return 2 * a;
}

function halve(a: number): number {
  return Math.floor(a / 2);
}

function isEven(a: number): bool {
  return a % 2 == 0;
}

function showEthiopianMultiplication(x: number, y: number): void {
  var tot = 0;
  while (x >= 1) {
    process.stdout.write(intToString(x, 9) + " ");
    if (!isEven(x)) {
      tot += y;
      process.stdout.write(intToString(y, 9));
    }
    console.log();
    x = halve(x);
    y = double(y);
  }
  console.log("=" + " ".repeat(9) + intToString(tot, 9));
}

showEthiopianMultiplication(17, 34);


halve()
{
    expr "$1" / 2
}

double()
{
    expr "$1" \* 2
}

is_even()
{
    expr "$1" % 2 = 0 >/dev/null
}

ethiopicmult()
{
    plier=$1
    plicand=$2
    r=0
    while [ "$plier" -ge 1 ]; do
	is_even "$plier" || r=`expr $r + "$plicand"`
	plier=`halve "$plier"`
	plicand=`double "$plicand"`
    done
    echo $r
}

ethiopicmult 17 34
# => 578


odd    = ~&ihB
double = ~&iNiCB
half   = ~&itB


Private Function lngHalve(Nb As Long) As Long
    lngHalve = Nb / 2
End Function

Private Function lngDouble(Nb As Long) As Long
    lngDouble = Nb * 2
End Function

Private Function IsEven(Nb As Long) As Boolean
    IsEven = (Nb Mod 2 = 0)
End Function


option explicit

class List
	private theList
	private nOccupiable
	private nTop

	sub class_initialize
		nTop = 0
		nOccupiable = 100
		redim theList( nOccupiable )
	end sub

	public sub store( x )
		if nTop >= nOccupiable then
			nOccupiable = nOccupiable + 100
			redim preserve theList( nOccupiable )
		end if
		theList( nTop ) = x
		nTop = nTop + 1
	end sub

	public function recall( n )
		if n >= 0 and n <= nOccupiable then
			recall = theList( n )
		else
			err.raise vbObjectError + 1000,,"Recall bounds error"
		end if
	end function

	public sub replace( n, x )
		if n >= 0 and n <= nOccupiable then
			theList( n )  = x
		else
			err.raise vbObjectError + 1001,,"Replace bounds error"
		end if
	end sub

	public property get listCount
		listCount = nTop
	end property

end class

function halve( n )
	halve = int( n / 2 )
end function

function twice( n )
	twice = int( n * 2 )
end function

function iseven( n )
	iseven = ( ( n mod 2 ) = 0 )
end function

function multiply( n1, n2 )
	dim LL
	set LL = new List

	dim RR
	set RR = new List

	LL.store n1
	RR.store n2

	do while n1 <> 1
		n1 = halve( n1 )
		LL.store n1
		n2 = twice( n2 )
		RR.store n2
	loop

	dim i
	for i = 0 to LL.listCount
		if iseven( LL.recall( i ) ) then
			RR.replace i, 0
		end if
	next

	dim total
	total = 0
	for i = 0 to RR.listCount
		total = total + RR.recall( i )
	next

	multiply = total
end function


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

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

fn is_even(i int) bool { return i%2 == 0 }

fn eth_multi(ii int, jj int) int {
    mut r := 0
    mut i, mut j := ii, jj
    for ; i > 0; i, j = halve(i), double(j) {
        if !is_even(i) {
            r += j
        }
    }
    return r
}

fn main() {
    println("17 ethiopian 34 = ${eth_multi(17, 34)}")
}


var halve = Fn.new { |n| (n/2).truncate }

var double = Fn.new { |n| n * 2 }

var isEven = Fn.new { |n| n%2 == 0 }

var ethiopian = Fn.new { |x, y|
    var sum = 0
    while (x >= 1) {
        if (!isEven.call(x)) sum = sum + y
        x = halve.call(x)
        y = double.call(y)
    }
    return sum
}

System.print("17 x 34 = %(ethiopian.call(17, 34))")
System.print("99 x 99 = %(ethiopian.call(99, 99))")


	extern 	printf
	global	main

	section	.text

halve
	shr	ebx, 1
	ret

double
	shl	ebx, 1
	ret

iseven
	and	ebx, 1
	cmp	ebx, 0
	ret			; ret preserves flags

main
	push	1		; tutor = true
	push	34		; 2nd operand
	push	17		; 1st operand
	call	ethiopicmult
	add	esp, 12

	push	eax		; result of 17*34
	push	fmt
	call	printf
	add	esp, 8

	ret

%define plier 8
%define plicand 12
%define tutor 16

ethiopicmult
	enter	0, 0
	cmp	dword [ebp + tutor], 0
	je	.notut0
	push	dword [ebp + plicand]
	push	dword [ebp + plier]
	push	preamblefmt
	call	printf
	add	esp, 12
.notut0

	xor	eax, eax		; eax -> result
	mov	ecx, [ebp + plier] 	; ecx -> plier
	mov	edx, [ebp + plicand]    ; edx -> plicand

.whileloop
	cmp	ecx, 1
	jl	.multend
	cmp	dword [ebp + tutor], 0
	je	.notut1
	call	tutorme
.notut1
	mov	ebx, ecx
	call	iseven
	je	.iseven
	add	eax, edx	; result += plicand
.iseven
	mov	ebx, ecx	; plier >>= 1
	call	halve
	mov	ecx, ebx

	mov	ebx, edx	; plicand <<= 1
	call	double
	mov	edx, ebx

	jmp	.whileloop
.multend
	leave
	ret

tutorme
	push	eax
	push	strucktxt
	mov	ebx, ecx
	call	iseven
	je	.nostruck
	mov	dword [esp], kepttxt
.nostruck
	push	edx
	push	ecx
	push	tutorfmt
	call	printf
	add	esp, 4
	pop	ecx
	pop	edx
	add	esp, 4
	pop	eax
	ret

	section .data

fmt
	db	"%d", 10, 0
preamblefmt
	db	"ethiopic multiplication of %d and %d", 10, 0
tutorfmt
	db	"%4d %6d %s", 10, 0
strucktxt
	db	"struck", 0
kepttxt
	db	"kept", 0


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

func Halve(N);          \Return half of N
int  N;
return N>>1;

func Double(N);         \Return N doubled
int  N;
return N<<1;

func IsEven(N);         \Return 'true' if N is an even number
int  N;
return (N&1)=0;

func EthiopianMul(A, B); \Multiply A times B using Ethiopian method
int  A, B;
int  I, J, S, Left(100), Right(100);
[Left(0):= A;  Right(0):= B;            \1. write numbers to be multiplied
I:= 1;                                  \2. repeatedly halve number on left
repeat  A:= Halve(A);
        Left(I):= A;  I:= I+1;
until   A=1;
J:= 1;                                  \3. repeatedly double number on right
repeat  B:= Double(B);
        Right(J):= B;  J:= J+1;
until   J=I;                            \stop where left column = 1
for J:= 0 to I-1 do                     \4. discard right value if left is even
        if IsEven(Left(J)) then Right(J):= 0;
S:= 0;                                  \5. sum remaining values on right
for J:= 0 to I-1 do
        S:= S + Right(J);
for J:= 0 to I-1 do                     \show this insanity
        [IntOut(0, Left(J));  ChOut(0, 9\tab\);  IntOut(0, Right(J));  CrLf(0)];
Text(0, "       --------
");
return S;                               \sum = product
];

int Product;
[Product:= EthiopianMul(17, 34);
ChOut(0, 9);  IntOut(0, Product);  CrLf(0);  CrLf(0);
Product:= EthiopianMul(1234, 5678);
ChOut(0, 9);  IntOut(0, Product);  CrLf(0);
]


fcn ethiopianMultiply(l,r){ // l is a non-negative integer
   halve  :=fcn(n){ n/2 };
   double :=fcn(n){ n+n };
   lr:=List(T(l,r)); // ( (l,r) .. (1,r*n) )
   while(l>1){ lr.write( T(l=halve(l),r=double(r)) ) }
   lr.filter(fcn([(l,r)]){ (not l.isEven) }); // strike out even left rows
   .reduce(fcn(sum,[(l,r)]){ sum + r },0);  // sum right column
}


	org &8000

	ld hl,17
	call Halve_Until_1

	push bc
	ld hl,34
	call Double_Until_1
	pop bc

	call SumOddEntries
	;returns Ethiopian product in IX.

	call NewLine

	call Primm
	byte "0x",0

	push ix
	pop hl

	ld a,H
	call ShowHex
	;Output should be in decimal but hex is easier.
	ld a,L
	call ShowHex

	ret

Halve_Until_1:
	;input: HL = number you wish to halve. HL is unsigned.
	ld de,Column_1
	ld a,1
	ld (Column_1),HL
	inc de
	inc de
loop_HalveUntil_1:
	SRL H
	RR L
	inc b
	push af
		ld a,L
		ld (de),a
		inc de
		ld a,H
		ld (de),a
		inc de
	pop af
	CP L
	jr nz,loop_HalveUntil_1
	;b tracks how many times to double the second factor.
	ret

Double_Until_1:
	;doubles second factor B times. B is calculated by Halve_until_1
	ld de,Column_2
	ld (Column_2),HL
	inc de
	inc de
loop_double_until_1:
	SLA L
	RL H
	PUSH AF
		LD A,L
		LD (DE),A
		INC DE
		LD A,H
		LD (DE),A
		INC DE
	POP AF
	DJNZ loop_double_until_1
	ret

SumOddEntries:
	sla b			;double loop counter, this is also the offset to the "last" entry of
					;each table
	ld h,>Column_1
	ld d,>Column_2	;aligning the tables lets us get away with this.
	ld l,b
	ld e,b
	ld ix,0
loop:
	ld a,(hl)
	rrca	;we only need the result of the odd/even test.
	jr nc,skipEven
	push hl
	push de
		ld a,(de)
		ld L,a
		inc de
		ld a,(de)
		ld H,a
		ex de,hl
		add ix,de
	pop de
	pop hl
skipEven:
	dec de
	dec de
	dec hl
	dec hl
	djnz loop
	ret	;ix should contain the answer

	align 8		;aligns Column_1 to the nearest 256 byte boundary. This makes offsetting easier.
Column_1:
	ds 16,0

	align 8		;aligns Column_2 to the nearest 256 byte boundary. This makes offsetting easier.
Column_2:
	ds 16,0


10 DEF FN e(a)=a-INT (a/2)*2-1
20 DEF FN h(a)=INT (a/2)
30 DEF FN d(a)=2*a
40 LET x=17: LET y=34: LET tot=0
50 IF x<1 THEN GO TO 100
60 PRINT x;TAB (4);
70 IF FN e(x)=0 THEN LET tot=tot+y: PRINT y: GO TO 90
80 PRINT "---"
90 LET x=FN h(x): LET y=FN d(y): GO TO 50
100 PRINT TAB (4);"===",TAB (4);tot


V n = 64

F pow2(x)
   R UInt64(1) << x

F evolve(UInt64 =state; rule)
   L 10
      V b = UInt64(0)
      L(q) (7 .. 0).step(-1)
         V st = state
         b [|]= (st [&] 1) << q
         state = 0
         L(i) 0 .< :n
            V t = ((st >> (i - 1)) [|] (st << (:n + 1 - i))) [&] 7
            I (rule [&] pow2(t)) != 0
               state [|]= pow2(i)
      print(‘ ’b, end' ‘’)
   print()

evolve(1, 30)


#include <stdio.h>
#include <limits.h>

typedef unsigned long long ull;
#define N (sizeof(ull) * CHAR_BIT)
#define B(x) (1ULL << (x))

void evolve(ull state, int rule)
{
	int i, p, q, b;

	for (p = 0; p < 10; p++) {
		for (b = 0, q = 8; q--; ) {
			ull st = state;
			b |= (st&1) << q;

			for (state = i = 0; i < N; i++)
				if (rule & B(7 & (st>>(i-1) | st<<(N+1-i))))
					state |= B(i);
		}
		printf(" %d", b);
	}
	putchar('\n');
	return;
}

int main(void)
{
	evolve(1, 30);
	return 0;
}


#include <bitset>
#include <stdio.h>

#define SIZE	           80
#define RULE               30
#define RULE_TEST(x)       (RULE & 1 << (7 & (x)))

void evolve(std::bitset<SIZE> &s) {
    int i;
    std::bitset<SIZE> t(0);
    t[SIZE-1] = RULE_TEST( s[0] << 2 | s[SIZE-1] << 1 | s[SIZE-2] );
    t[     0] = RULE_TEST( s[1] << 2 | s[     0] << 1 | s[SIZE-1] );
    for (i = 1; i < SIZE-1; i++)
	t[i] = RULE_TEST( s[i+1] << 2 | s[i] << 1 | s[i-1] );
    for (i = 0; i < SIZE; i++) s[i] = t[i];
}
void show(std::bitset<SIZE> s) {
    int i;
    for (i = SIZE; i--; ) printf("%c", s[i] ? '#' : ' ');
    printf("|\n");
}
unsigned char byte(std::bitset<SIZE> &s) {
    unsigned char b = 0;
    int i;
    for (i=8; i--; ) {
	b |= s[0] << i;
	evolve(s);
    }
    return b;
}

int main() {
    int i;
    std::bitset<SIZE> state(1);
    for (i=10; i--; )
	printf("%u%c", byte(state), i ? ' ' : '\n');
    return 0;
}


import std.stdio, std.range, std.typecons;

struct CellularRNG {
    private uint current;
    private immutable uint rule;
    private ulong state;

    this(in ulong state_, in uint rule_) pure nothrow @safe @nogc {
        this.state = state_;
        this.rule = rule_;
        popFront;
    }

    public enum bool empty = false;
    @property uint front() pure nothrow @safe @nogc { return current; }

    void popFront() pure nothrow @safe @nogc {
        enum uint nBit = 8;
        enum uint NU = ulong.sizeof * nBit;
        current = 0;

        foreach_reverse (immutable i; 0 .. nBit) {
            immutable state2 = state;
            current |= (state2 & 1) << i;

            state = 0;
            /*static*/ foreach (immutable j; staticIota!(0, NU)) {
                // To avoid undefined behavior with out-of-range shifts.
                static if (j > 0)
                    immutable aux1 = state2 >> (j - 1);
                else
                    immutable aux1 = state2 >> 63;

                static if (j == 0)
                    immutable aux2 = state2 << 1;
                else static if (j == 1)
                    immutable aux2 = state2 << 63;
                else
                    immutable aux2 = state2 << (NU + 1 - j);

                immutable aux = 7 & (aux1 | aux2);
                if (rule & (1UL << aux))
                    state |= 1UL << j;
            }
        }
    }
}

void main() {
    CellularRNG(1, 30).take(10).writeln;
    CellularRNG(1, 30).drop(2_000_000).front.writeln;
}


// Generate random numbers using Rule 30. Nigel Galloway: August 1st., 2019
eca 30 [|yield 1; yield! Array.zeroCreate 99|]|>Seq.chunkBySize 8|>Seq.map(fun n->n|>Array.mapi(fun n g->g.[0]<<<(7-n))|>Array.sum)|>Seq.take 10|>Seq.iter(printf "%d "); printfn ""


package main

import "fmt"

const n = 64

func pow2(x uint) uint64 {
    return uint64(1) << x
}

func evolve(state uint64, rule int) {
    for p := 0; p < 10; p++ {
        b := uint64(0)
        for q := 7; q >= 0; q-- {
            st := state
            b |= (st & 1) << uint(q)
            state = 0
            for i := uint(0); i < n; i++ {
                var t1, t2, t3 uint64
                if i > 0 {
                    t1 = st >> (i - 1)
                } else {
                    t1 = st >> 63
                }
                if i == 0 {
                    t2 = st << 1
                } else if i == 1 {
                    t2 = st << 63

                } else {
                    t2 = st << (n + 1 - i)
                }
                t3 = 7 & (t1 | t2)
                if (uint64(rule) & pow2(uint(t3))) != 0 {
                    state |= pow2(i)
                }
            }
        }
        fmt.Printf("%d ", b)
    }
    fmt.Println()
}

func main() {
    evolve(1, 30)
}


import CellularAutomata (fromList, rule, runCA)
import Control.Comonad
import Data.List (unfoldr)

rnd = fromBits <$> unfoldr (pure . splitAt 8) bits
  where
    size = 80
    bits =
      extract
        <$> runCA
          (rule 30)
          (fromList (1 : replicate size 0))

fromBits = foldl ((+) . (2 *)) 0


coclass'ca'
DOC =: 'locale creation: (RULE ; INITIAL_STATE) conew ''ca'''
create =: 3 :'''RULE STATE'' =: y'
next =: 3 :'STATE =: RULE (((8$2) #: [) {~ [: #. [: -. [: |: |.~"1 0&_1 0 [email protected]]) STATE'
coclass'base'

coclass'rng'
coinsert'ca'
bit =: 3 :'([ next) ({. STATE)'
byte =: [: #. [: , [: bit"0 (i.8)"_
coclass'base'


function evolve(state, rule, N=64)
    B(x) = UInt64(1) << x
    for p in 0:9
        b = UInt64(0)
        for q in 7:-1:0
            st = UInt64(state)
            b |= (st & 1) << q
            state = UInt64(0)
            for i in 0:N-1
                t1 = (i > 0) ? st >> (i - 1) : st >> (N - 1)
                t2 = (i == 0) ? st << 1 : (i == 1) ? st << (N - 1) : st << (N + 1 - i)
                if UInt64(rule) & B(7 & (t1 | t2)) != 0
                    state |= B(i)
                end
            end
        end
        print("$b ")
    end
    println()
end

evolve(1, 30)


// version 1.1.51

const val N = 64

fun pow2(x: Int) = 1L shl x

fun evolve(state: Long, rule: Int) {
    var state2 = state
    for (p in 0..9) {
        var b = 0
        for (q in 7 downTo 0) {
            val st = state2
            b = (b.toLong() or ((st and 1L) shl q)).toInt()
            state2 = 0L
            for (i in 0 until N) {
                val t = ((st ushr (i - 1)) or (st shl (N + 1 - i)) and 7L).toInt()
                if ((rule.toLong() and pow2(t)) != 0L) state2 = state2 or pow2(i)
            }
        }
        print(" $b")
    }
    println()
}

fun main(args: Array<String>) {
    evolve(1, 30)
}


FromDigits[#, 2] & /@ Partition[Flatten[CellularAutomaton[30, {{1}, 0}, {200, 0}]], 8]


const N = 64

template pow2(x: uint): uint = 1u shl x

proc evolve(state: uint; rule: Positive) =
  var state = state
  for _ in 1..10:
    var b = 0u
    for q in countdown(7, 0):
      let st = state
      b = b or (st and 1) shl q
      state = 0
      for i in 0u..<N:
        let t = (st shr (i - 1) or st shl (N + 1 - i)) and 7
        if (rule.uint and pow2(t)) != 0: state = state or pow2(i)
    stdout.write ' ', b
  echo ""

evolve(1, 30)


Program Rule30;
//http://en.wikipedia.org/wiki/Next_State_Rule_30;
//http://mathworld.wolfram.com/Rule30.html
{$IFDEF FPC}
  {$Mode Delphi}{$ASMMODE INTEL}
  {$OPTIMIZATION ON,ALL}
//  {$CODEALIGN proc=1}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  SysUtils;
const
  maxRounds = 2*1000*1000;
  rounds    = 10;

var
  Rule30_State : Uint64;

function GetCPU_Time: int64;
type
  TCpu = record
            HiCpu,
            LoCpu : Dword;
         end;
var
  Cput : TCpu;
begin
  asm
  RDTSC;
  MOV Dword Ptr [CpuT.LoCpu],EAX
  MOV Dword Ptr [CpuT.HiCpu],EDX
  end;
  with Cput do
    result := int64(HiCPU) shl 32 + LoCpu;
end;

procedure InitRule30_State;inline;
begin
  Rule30_State:= 1;
end;

procedure Next_State_Rule_30;inline;
var
  run, prev,next: Uint64;
begin
  run  := Rule30_State;
  Prev := RORQword(run,1);
  next := ROLQword(run,1);
  Rule30_State  := (next OR run) XOR prev;
end;

function NextRule30Byte:NativeInt;
//64-BIT can use many registers
//32-Bit still fast
var
  run, prev,next: Uint64;
  myOne : UInt64;
Begin
  run  := Rule30_State;
  result := 0;
  myOne  := 1;
  //Unrolling and inlining Next_State_Rule_30 by hand
  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  run  := (next OR run) XOR prev;

  result := (result+result) OR (run AND myOne);
  next := ROLQword(run,1);
  Prev := RORQword(run,1);
  Rule30_State := (next OR run) XOR prev;
end;

procedure Speedtest;
var
  T1,T0 : INt64;
  i: NativeInt;
Begin
  writeln('Speedtest for statesize of ',64,' bits');
  //Warm up start to wake up CPU takes some time
  For i := 100*1000*1000-1 downto 0 do
    Next_State_Rule_30;

  T0 := GetCPU_Time;
  InitRule30_State;
  For  i := maxRounds-1 downto 0 do
    NextRule30Byte;
  T1 := GetCPU_Time;
  writeln(NextRule30Byte);
  writeln('cycles per Byte : ',(T1-t0)/maxRounds:0:2);
  writeln;
end;

procedure Task;
var
  i: integer;
Begin
  writeln('The task ');
  InitRule30_State;
  For  i := 1 to rounds do
    write(NextRule30Byte:4);
  writeln;
end;

Begin
  SpeedTest;
  Task;
  write(' <ENTER> ');readln;
end.


package Automaton {
    sub new {
    my $class = shift;
    my $rule = [ reverse split //, sprintf "%08b", shift ];
    return bless { rule => $rule, cells => [ @_ ] }, $class;
    }
    sub next {
    my $this = shift;
    my @previous = @{$this->{cells}};
    $this->{cells} = [
        @{$this->{rule}}[
        map {
          4*$previous[($_ - 1) % @previous]
        + 2*$previous[$_]
        +   $previous[($_ + 1) % @previous]
        } 0 .. @previous - 1
        ]
    ];
    return $this;
    }
    use overload
    q{""} => sub {
    my $this = shift;
    join '', map { $_ ? '#' : ' ' } @{$this->{cells}}
    };
}

my $a = Automaton->new(30, 1, map 0, 1 .. 100);

for my $n (1 .. 10) {
    my $sum = 0;
    for my $b (1 .. 8) {
	$sum = $sum * 2 + $a->{cells}[0];
	$a->next;
    }
    print $sum, $n == 10 ? "\n" : " ";
}


from elementary_cellular_automaton import eca, eca_wrap

def rule30bytes(lencells=100):
    cells = '1' + '0' * (lencells - 1)
    gen = eca(cells, 30)
    while True:
        yield int(''.join(next(gen)[0] for i in range(8)), 2)

if __name__ == '__main__':
    print([b for i,b in zip(range(10), rule30bytes())])


#lang racket
;; below is the code from the parent task
(require "Elementary_cellular_automata.rkt")
(require racket/fixnum)

;; This is the RNG automaton
(define (CA30-random-generator
         #:rule [rule 30] ; rule 30 is random, maybe you're interested in using others
         ;; width of the CA... this is implemented as a number of words plus,
         ;; maybe, another word containing the spare bits
         #:bits [bits 256])
  (define-values [full-words more-bits]
    (quotient/remainder bits usable-bits/fixnum))
  (define wrap-rule
    (and (positive? more-bits) (wrap-rule-truncate-left-word more-bits)))
  (define next-gen (CA-next-generation 30 #:wrap-rule wrap-rule))
  (define v (make-fxvector (+ full-words (if more-bits 1 0))))
  (fxvector-set! v 0 1) ; this bit will always have significance

  (define (next-word)
    (define-values [v+ o] (next-gen v 0))
    (begin0 (fxvector-ref v 0) (set! v v+)))

  (lambda (bits)
    (for/fold ([acc 0]) ([_ (in-range bits)])
      ;; the CA is fixnum, but this function returns integers of arbitrary width
      (bitwise-ior (arithmetic-shift acc 1) (bitwise-and (next-word) 1)))))

(module+ main
  ;; To match the other examples on this page, the automaton is 30+30+4 bits long
  ;; (i.e. 64 bits)
  (define C30-rand-64 (CA30-random-generator #:bits 64))
  ;; this should be the list from "C"
  (for/list ([i 10]) (C30-rand-64 8))

  ; we also do big numbers...
  (number->string (C30-rand-64 256) 16)
  (number->string (C30-rand-64 256) 16)
  (number->string (C30-rand-64 256) 16)
  (number->string (C30-rand-64 256) 16))


class Automaton {
    has $.rule;
    has @.cells;
    has @.code = $!rule.fmt('%08b').flip.comb».Int;

    method gist { "|{ @!cells.map({+$_ ?? '#' !! ' '}).join }|" }

    method succ {
        self.new: :$!rule, :@!code, :cells(
            @!code[
                    4 «*« @!cells.rotate(-1)
                »+« 2 «*« @!cells
                »+«       @!cells.rotate(1)
            ]
        )
    }
}

my Automaton $a .= new: :rule(30), :cells( flat 1, 0 xx 100 );

say :2[$a++.cells[0] xx 8] xx 10;


size = 100
eca = ElemCellAutomat.new("1"+"0"*(size-1), 30)
eca.take(80).map{|line| line[0]}.each_slice(8){|bin| p bin.join.to_i(2)}


//Assuming the code from the Elementary cellular automaton task is in the namespace.
fn main() {
    struct WolfGen(ElementaryCA);
    impl WolfGen {
        fn new() -> WolfGen {
            let (_, ca) = ElementaryCA::new(30);
            WolfGen(ca)
        }
        fn next(&mut self) -> u8 {
            let mut out = 0;
            for i in 0..8 {
                out |= ((1 & self.0.next())<<i)as u8;
            }
            out
        }
    }
    let mut gen = WolfGen::new();
    for _ in 0..10 {
        print!("{} ", gen.next());
    }
}


; uses SRFI-1 library http://srfi.schemers.org/srfi-1/srfi-1.html

(define (random-r30 n)
  (let ((r30 (vector 0 1 1 1 1 0 0 0)))
    (fold
      (lambda (x y ls)
	(if (= x 1)
	  (cons (* x y) ls)
	  (cons (+ (car ls) (* x y)) (cdr ls))))
      '()
      (circular-list 1 2 4 8 16 32 64 128)
      (unfold-right
	(lambda (x) (zero? (car x)))
	cadr
	(lambda (x) (cons (- (car x) 1)
			  (evolve (cdr x) r30)))
	(cons (* 8 n) (cons 1 (make-list 79 0))))))) ; list

(random-r30 10)


var auto = Automaton(30, [1] + 100.of(0));

10.times {
    var sum = 0;
    8.times {
        sum = (2*sum + auto.cells[0]);
        auto.next;
    };
    say sum;
};


oo::class create RandomGenerator {
    superclass ElementaryAutomaton
    variable s
    constructor {stateLength} {
	next 30
	set s [split 1[string repeat 0 $stateLength] ""]
    }

    method rand {} {
	set bits {}
	while {[llength $bits] < 8} {
	    lappend bits [lindex $s 0]
	    set s [my evolve $s]
	}
	return [scan [join $bits ""] %b]
    }
}


import "/big" for BigInt

var n = 64

var pow2 = Fn.new { |x| BigInt.one << x }

var evolve = Fn.new { |state, rule|
    for (p in 0..9) {
        var b = BigInt.zero
        for (q in 7..0) {
            var st = state.copy()
            b = b | ((st & 1) << q)
            state = BigInt.zero
            for (i in 0...n) {
                var t1 = (i > 0) ? st >> (i-1) : st >> 63
                var t2 = (i == 0) ? st << 1 : (i == 1) ? st << 63 : st << (n+1-i)
                var t3 = (t1 | t2) & 7
                if ((pow2.call(t3) & rule) != BigInt.zero) state = state | pow2.call(i)
            }
        }
        System.write(" %(b)")
    }
    System.print()
}

evolve.call(BigInt.one, 30)


fcn rule(n){ n=n.toString(2); "00000000"[n.len() - 8,*] + n }
fcn applyRule(rule,cells){
   cells=String(cells[-1],cells,cells[0]);  // wrap edges
   (cells.len() - 2).pump(String,'wrap(n){ rule[7 - cells[n,3].toInt(2)] })
}
fcn rand30{
   var r30=rule(30), cells="0"*63 + 1; // 64 bits (8 bytes), arbitrary
   n:=0;
   do(8){
      n=n*2 + cells[-1];          // append bit 0
      cells=applyRule(r30,cells); // next state
   }
   n
}


F step(cells, rule)
   V result = ‘’
   L(i) 0 .< cells.len - 2
      V bin = 0
      V b = 2
      L(n) i .< i + 3
         bin += Int(cells[n] == ‘*’) << b
         b >>= 1
      V a = I (rule [&] (1 << bin)) != 0 {‘*’} E ‘.’
      result ‘’= a
   R result

F addNoCells(&cells)
   V left  = I cells[0]   == ‘*’ {‘.’} E ‘*’
   V right = I cells.last == ‘*’ {‘.’} E ‘*’
   cells = left‘’cells‘’right
   cells = left‘’cells‘’right

F evolve(limit, rule)
   print(‘Rule #’rule)
   V cells = ‘*’
   L 0 .< limit
      addNoCells(&cells)
      V width = 40 + (cells.len >> 1)
      print(cells.rjust(width))
      cells = step(cells, rule)

evolve(35, 90)


#include <iostream>
#include <iomanip>
#include <string>

class oo {
public:
    void evolve( int l, int rule ) {
        std::string    cells = "O";
        std::cout << " Rule #" << rule << ":\n";
        for( int x = 0; x < l; x++ ) {
            addNoCells( cells );
            std::cout << std::setw( 40 + ( static_cast<int>( cells.length() ) >> 1 ) ) << cells << "\n";
            step( cells, rule );
        }
    }
private:
    void step( std::string& cells, int rule ) {
        int bin;
        std::string newCells;
        for( size_t i = 0; i < cells.length() - 2; i++ ) {
            bin = 0;
            for( size_t n = i, b = 2; n < i + 3; n++, b >>= 1 ) {
                bin += ( ( cells[n] == 'O' ? 1 : 0 ) << b );
            }
            newCells.append( 1, rule & ( 1 << bin ) ? 'O' : '.' );
        }
        cells = newCells;
    }
    void addNoCells( std::string& s ) {
        char l = s.at( 0 ) == 'O' ? '.' : 'O',
             r = s.at( s.length() - 1 ) == 'O' ? '.' : 'O';
        s = l + s + r;
        s = l + s + r;
    }
};
int main( int argc, char* argv[] ) {
    oo o;
    o.evolve( 35, 90 );
    std::cout << "\n";
    return 0;
}


import std.stdio, std.array, std.range, std.typecons, std.string, std.conv,
       std.algorithm;
alias R = replicate;

void main() {
    enum nLines = 25;
    enum notCell = (in char c) pure => (c == '1') ? "0" : "1";

    foreach (immutable rule; [90, 30]) {
        writeln("\nRule: ", rule);
        immutable ruleBits = "%08b".format(rule).retro.text;
        const neighs2next = 8.iota
                            .map!(n => tuple("%03b".format(n), [ruleBits[n]]))
                            .assocArray;

        string C = "1";
        foreach (immutable i; 0 .. nLines) {
            writefln("%2d: %s%s", i, " ".R(nLines - i), C.tr("01", ".#"));
            C = notCell(C[0]).R(2) ~ C ~ notCell(C[$ - 1]).R(2);
            C = iota(1, C.length - 1)
                .map!(i => neighs2next[C[i - 1 .. i + 2]])
                .join;
        }
    }
}


defmodule Elementary_cellular_automaton do
  def infinite(cell, rule, times) do
    each(cell, rule_pattern(rule), times)
  end

  defp each(_, _, 0), do: :ok
  defp each(cells, rules, times) do
    IO.write String.duplicate(" ", times)
    IO.puts String.replace(cells, "0", ".") |> String.replace("1", "#")
    c = not_cell(String.first(cells)) <> cells <> not_cell(String.last(cells))
    next_cells = Enum.map_join(0..String.length(cells)+1, fn i ->
      Map.get(rules, String.slice(c, i, 3))
    end)
    each(next_cells, rules, times-1)
  end

  defp not_cell("0"), do: "11"
  defp not_cell("1"), do: "00"

  defp rule_pattern(rule) do
    list = Integer.to_string(rule, 2) |> String.pad_leading(8, "0")
           |> String.codepoints |> Enum.reverse
    Enum.map(0..7, fn i -> Integer.to_string(i, 2) |> String.pad_leading(3, "0") end)
    |> Enum.zip(list) |> Map.new
  end
end

Enum.each([18, 30], fn rule ->
  IO.puts "\nRule : #{rule}"
  Elementary_cellular_automaton.infinite("1", rule, 25)
end)


package main

import (
    "fmt"
    "strings"
)

func btoi(b bool) int {
    if b {
        return 1
    }
    return 0
}

func evolve(l, rule int) {
    fmt.Printf(" Rule #%d:\n", rule)
    cells := "O"
    for x := 0; x < l; x++ {
        cells = addNoCells(cells)
        width := 40 + (len(cells) >> 1)
        fmt.Printf("%*s\n", width, cells)
        cells = step(cells, rule)
    }
}

func step(cells string, rule int) string {
    newCells := new(strings.Builder)
    for i := 0; i < len(cells)-2; i++ {
        bin := 0
        b := uint(2)
        for n := i; n < i+3; n++ {
            bin += btoi(cells[n] == 'O') << b
            b >>= 1
        }
        a := '.'
        if rule&(1<<uint(bin)) != 0 {
            a = 'O'
        }
        newCells.WriteRune(a)
    }
    return newCells.String()
}

func addNoCells(cells string) string {
    l, r := "O", "O"
    if cells[0] == 'O' {
        l = "."
    }
    if cells[len(cells)-1] == 'O' {
        r = "."
    }
    cells = l + cells + r
    cells = l + cells + r
    return cells
}

func main() {
    for _, r := range []int{90, 30} {
        evolve(25, r)
        fmt.Println()
    }
}


{-# LANGUAGE DeriveFunctor #-}

import Control.Comonad
import Data.InfList (InfList (..), (+++))
import qualified Data.InfList as Inf

data Cells a = Cells (InfList a) a (InfList a) deriving Functor

view n (Cells l x r) = reverse (Inf.take n l) ++ [x] ++ (Inf.take n r)

fromList []     = fromList [0]
fromList (x:xs) = let zeros = Inf.repeat 0
                  in Cells zeros x (xs +++ zeros)


def lpad($len; $fill): tostring | ($len - length) as $l | ($fill * $l)[:$l] + .;

def lpad($len): lpad($len; " ");

# Like *ix `tr` but it is as though $to is padded with blanks
def tr($from;$to):
  explode as $s
  | ($from | explode) as $f
  | ($to   | explode) as $t
  | reduce range(0;length) as $i ([];
      ($f | index($s[$i])) as $ix
      | if $ix then . + [$t[$ix] // " "]
        else . + [$s[$i]]
	end )
  | implode;

# Input: a non-negative integer
# Output: the corresponding stream of bits (0s and 1s),
# least significant digit first, with a final 0
def stream:
  recurse(if . > 0 then ./2|floor else empty end) | . % 2 ;

# input: an array, e.g. as produced by [7|stream]
# output: the corresponding binary string
def to_b: reverse | map(tostring) | join("") | sub("^0";"");


function ecainfinite(cells, rule, n)
    notcell(cell) = (cell == '1') ? '0' : '1'
    rulebits = reverse(string(rule, base = 2, pad = 8))
    neighbors2next = Dict(string(n - 1, base=2, pad=3) => rulebits[n] for n in 1:8)
    ret = String[]
    for i in 1:n
        push!(ret, cells)
        cells = notcell(cells[1])^2 * cells * notcell(cells[end])^2 # Extend/pad ends
        cells = join([neighbors2next[cells[i:i+2]] for i in 1:length(cells)-2], "")
    end
    ret
end

function testinfcells(lines::Integer)
    for rule in [90, 30]
        println("\nRule: $rule ($(string(rule, base = 2, pad = 8)))")
        s = ecainfinite("1", rule, lines)
        for i in 1:lines
            println("$i: ", " "^(lines - i), replace(replace(s[i], "0" => "."), "1" => "#"))
        end
    end
end

testinfcells(25)


// version 1.1.51

fun evolve(l: Int, rule: Int) {
    println(" Rule #$rule:")
    var cells = StringBuilder("*")
    for (x in 0 until l) {
        addNoCells(cells)
        val width = 40 + (cells.length shr 1)
        println(cells.padStart(width))
        cells = step(cells, rule)
    }
}

fun step(cells: StringBuilder, rule: Int): StringBuilder {
    val newCells = StringBuilder()
    for (i in 0 until cells.length - 2) {
        var bin = 0
        var b = 2
        for (n in i until i + 3) {
            bin += (if (cells[n] == '*') 1 else 0) shl b
            b = b shr 1
        }
        val a = if ((rule and (1 shl bin)) != 0) '*' else '.'
        newCells.append(a)
    }
    return newCells
}

fun addNoCells(s: StringBuilder) {
    val l = if (s[0] == '*') '.' else '*'
    val r = if (s[s.length - 1] == '*') '.' else '*'
    repeat(2) {
       s.insert(0, l)
       s.append(r)
    }
}

fun main(args: Array<String>) {
    evolve(35, 90)
    println()
}


CellularAutomaton[18, {{1}, 0}, 15] // ArrayPlot
CellularAutomaton[30, {{1}, 0}, 15] // ArrayPlot


import strutils

func step(cells: string; rule: int): string =
  for i in 0..(cells.len - 3):
    var bin = 0
    var b = 2
    for n in i..(i + 2):
      inc bin, ord(cells[n] == '*') shl b
      b = b shr 1
    let a = if (rule and 1 shl bin) != 0: '*' else: '.'
    result.add(a)

func addNoCells(cells: var string) =
  let left = if cells[0] == '*': "." else: "*"
  let right = if cells[^1] == '*': "." else: "*"
  cells.insert(left)
  cells.add(right)
  cells.insert(left)
  cells.add(right)

proc evolve(limit, rule: int) =
  echo "Rule #", rule
  var cells = "*"
  for _ in 0..<limit:
    cells.addNoCells()
    let width = 40 + cells.len shr 1
    echo cells.align(width)
    cells = cells.step(rule)

evolve(35, 90)


sub evolve {
	my ($rule, $pattern) = @_;
	my $offset = 0;

	while (1) {
		my ($l, $r, $st);
		$pattern =~ s/^((.)\g2*)/$2$2/ and $l = $2, $offset -= length($2);
		$pattern =~ s/(.)\g1*$/$1$1/   and $r = $1;

		$st = $pattern;

		$pattern =~ tr/01/.#/;
		printf "%5d| %s%s\n", $offset, ' ' x (40 + $offset), $pattern;

		$pattern = join '', map(1 & ($rule>>oct "0b$_"),
				$l x 3,
				map(substr($st, $_, 3), 0 .. length($st)-3),
				$r x 3);
	}
}

evolve(90, "010");


with javascript_semantics
string s = ".#.",
       t=s, r = "........"
integer rule = 18, k, l = length(s), w = 0
for i=1 to 8 do
    r[i] = iff(mod(rule,2)?'#':'.')
    rule = floor(rule/2)
end for
for i=0 to 25 do
    ?repeat(' ',floor((55-length(s))/2))&s
    for j=1 to l do
        k = (s[iff(j=1?l:j-1)]='#')*4
          + (s[          j   ]='#')*2
          + (s[iff(j=l?1:j+1)]='#')+1
        t[j] = r[k]
    end for
    if t[1]='#' then t = '.'&t end if
    if t[$]='#' then t = t&'.' end if
    l = length(t)
    s = t
end for


def _notcell(c):
    return '0' if c == '1' else '1'

def eca_infinite(cells, rule):
    lencells = len(cells)
    rulebits = '{0:08b}'.format(rule)
    neighbours2next = {'{0:03b}'.format(n):rulebits[::-1][n] for n in range(8)}
    c = cells
    while True:
        yield c
        c = _notcell(c[0])*2 + c + _notcell(c[-1])*2    # Extend and pad the ends

        c = ''.join(neighbours2next[c[i-1:i+2]] for i in range(1,len(c) - 1))
        #yield c[1:-1]

if __name__ == '__main__':
    lines = 25
    for rule in (90, 30):
        print('\nRule: %i' % rule)
        for i, c in zip(range(lines), eca_infinite('1', rule)):
            print('%2i: %s%s' % (i, ' '*(lines - i), c.replace('0', '.').replace('1', '#')))


#lang racket
; below is the code from the parent task
(require "Elementary_cellular_automata.rkt")
(require racket/fixnum)

(define (wrap-rule-infinite v-in vl-1 offset)
  (define l-bit-set? (bitwise-bit-set? (fxvector-ref v-in 0) usable-bits/fixnum-1))
  (define r-bit-set? (bitwise-bit-set? (fxvector-ref v-in vl-1) 0))
  ;; if we need to extend left offset is reduced by 1
  (define l-pad-words (if l-bit-set? 1 0))
  (define r-pad-words (if r-bit-set? 1 0))
  (define new-words (fx+ l-pad-words r-pad-words))
  (cond
    [(fx= 0 new-words) (values v-in vl-1 offset)] ; nothing changes
    [else
     (define offset- (if l-bit-set? (fx- offset 1) offset))
     (define l-sequence (if l-bit-set? (in-value 0) (in-sequences)))
     (define vl-1+ (fx+ vl-1 (fx+ l-pad-words r-pad-words)))
     (define v-out
       (for/fxvector
           #:length (fx+ vl-1+ 1) #:fill 0 ; right padding
           ([f (in-sequences l-sequence (in-fxvector v-in))])
        f))
     (values v-out vl-1+ offset-)]))

(module+ main
  (define ng/90/infinite (CA-next-generation 90 #:wrap-rule wrap-rule-infinite))
  (for/fold ([v (fxvector #b10000000000000000000)]
             [o 1]) ; start by pushing output right by one
            ([step (in-range 40)])
    (show-automaton v #:step step #:push-right o)
    (newline)
    (ng/90/infinite v o)))


class Automaton {
    has $.rule;
    has @.cells;
    has @.code = $!rule.fmt('%08b').flip.comb».Int;

    method gist { @!cells.map({+$_ ?? '▲' !! '░'}).join }

    method succ {
        self.new: :$!rule, :@!code, :cells(
            ' ',
            |@!code[
                    4 «*« @!cells.rotate(-1)
                »+« 2 «*« @!cells
                »+«       @!cells.rotate(1)
            ],
            ' '
        )
    }
}

my Automaton $a .= new: :rule(90), :cells(flat '010'.comb);

# display the first 20 rows
say $a++ for ^20;

# then calculate the other infinite number of rows, (may take a while)
$a++ for ^Inf;


def notcell(c)
  c.tr('01','10')
end

def eca_infinite(cells, rule)
  neighbours2next = Hash[8.times.map{|i|["%03b"%i, "01"[rule[i]]]}]
  c = cells
  Enumerator.new do |y|
    loop do
      y << c
      c = notcell(c[0])*2 + c + notcell(c[-1])*2        # Extend and pad the ends
      c = (1..c.size-2).map{|i| neighbours2next[c[i-1..i+1]]}.join
    end
  end
end

if __FILE__ == $0
  lines = 25
  for rule in [90, 30]
    puts "\nRule: %i" % rule
    for i, c in (0...lines).zip(eca_infinite('1', rule))
      puts '%2i: %s%s' % [i, ' '*(lines - i), c.tr('01', '.#')]
    end
  end
end


package require Tcl 8.6

oo::class create InfiniteElementaryAutomaton {
    variable rules
    # Decode the rule number to get a collection of state mapping rules.
    # In effect, "compiles" the rule number
    constructor {ruleNumber} {
	set ins {111 110 101 100 011 010 001 000}
	set bits [split [string range [format %08b $ruleNumber] end-7 end] ""]
	foreach input {111 110 101 100 011 010 001 000} state $bits {
	    dict set rules $input $state
	}
    }

    # Apply the rule to an automaton state to get a new automaton state.
    # We wrap the edges; the state space is circular.
    method evolve {left state right} {
	set state [list $left {*}$state $right]
	set len [llength $state]
	for {set i -1;set j 0;set k 1} {$j < $len} {incr i;incr j;incr k} {
	    set a [expr {$i<0 ? $left : [lindex $state $i]}]
	    set b [lindex $state $j]
	    set c [expr {$k==$len ? $right : [lindex $state $k]}]
	    lappend result [dict get $rules $a$b$c]
	}
	return $result
    }

    method evolveEnd {endState} {
	return [dict get $rules $endState$endState$endState]
    }

    # Simple driver method; omit the initial state to get a centred dot
    method run {steps {initialState "010"}} {
	set cap [string repeat "\u2026" $steps]
	set s [split [string map ". 0 # 1" $initialState] ""]
	set left [lindex $s 0]
	set right [lindex $s end]
	set s [lrange $s 1 end-1]
	for {set i 0} {$i < $steps} {incr i} {
	    puts $cap[string map "0 . 1 #" $left[join $s ""]$right]$cap
	    set s [my evolve $left $s $right]
	    set left [my evolveEnd $left]
	    set right [my evolveEnd $right]
	    set cap [string range $cap 1 end]
	}
	puts $cap[string map "0 . 1 #" $left[join $s ""]$right]$cap
    }
}

foreach num {90 30} {
    puts "Rule ${num}:"
    set rule [InfiniteElementaryAutomaton new $num]
    $rule run 25
    $rule destroy
}


import "/fmt" for Fmt

var addNoCells = Fn.new { |s|
    var l = (s[0] == "*") ? "." : "*"
    var r = (s[-1] == "*") ? "." : "*"
    for (i in 0..1) {
       s.insert(0, l)
       s.add(r)
    }
}

var step = Fn.new { |cells, rule|
    var newCells = []
    for (i in 0...cells.count - 2) {
        var bin = 0
        var b = 2
        for (n in i...i + 3) {
            bin = bin + (((cells[n] == "*") ? 1 : 0) << b)
            b = b >> 1
        }
        var a = ((rule & (1 << bin)) != 0) ? "*" : "."
        newCells.add(a)
    }
    return newCells
}

var evolve = Fn.new { |l, rule|
    System.print(" Rule #%(rule):")
    var cells = ["*"]
    for (x in 0...l) {
        addNoCells.call(cells)
        var width = 40 + (cells.count >> 1)
        Fmt.print("$*s", width, cells.join())
        cells = step.call(cells, rule)
    }
}

evolve.call(35, 90)
System.print()


nLines,flipCell := 25, fcn(c){ (c=="1") and "0" or "1" };
foreach rule in (T(90,30)){
   println("\nRule: ", rule);
   ruleBits:="%08.2B".fmt(rule);  // eg 90-->"01011010"
   neighs2next:=(8).pump(Dictionary(),
      'wrap(n){ T("%03.2B".fmt(n), ruleBits.reverse()[n]) });
   C:="1";  // C is "1"s and "0"s, I'll auto cast to Int as needed
   foreach i in (nLines){
      println("%2d: %s%s".fmt(i," "*(nLines - i), C.translate("01",".#")));
      C=String(flipCell(C[0])*2, C, flipCell(C[-1])*2);
      C=[1..C.len()-2].pump(String,'wrap(n){ neighs2next[C[n-1,3]] });
   }
}


I fs:list_dir(input()).empty
   print(‘empty’)
E
   print(‘not empty’)


; this routine attempts to remove the directory and returns an error code if it cannot.

mov ax,seg dirname           ;load into AX the segment where dirname is stored.
mov ds,ax                    ;load the segment register DS with the segment of dirname
mov dx,offset dirname        ;load into DX the offset of dirname
mov ah,39h                   ;0x39 is the interrupt code for remove directory
int 21h                      ;sets carry if error is encountered. error code will be in AX.
                             ;If carry is clear the remove was successful

jc error

mov ah,4Ch	;return function
mov al,0	;required return code
int 21h         ;return to DOS

error:          ;put your error handler here

mov ah,4Ch	;return function
mov al,0	;required return code
int 21h         ;return to DOS

dirname    db "GAMES",0


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Directories;
procedure EmptyDir is
   function Empty (path : String) return String is
      use Ada.Directories;
      result : String := "Is empty.";
      procedure check (ent : Directory_Entry_Type) is begin
         if Simple_Name (ent) /= "." and Simple_Name (ent) /= ".." then
            Empty.result := "Not empty";
         end if;
      end check;
   begin
      if not Exists (path) then return "Does not exist.";
      elsif Kind (path) /= Directory then return "Not a Directory.";
      end if;
      Search (path, "", Process => check'Access);
      return result;
   end Empty;
begin
   Put_Line (Empty ("."));
   Put_Line (Empty ("./empty"));
   Put_Line (Empty ("./emptydir.adb"));
   Put_Line (Empty ("./foobar"));
end EmptyDir;