30 lines
2.6 KiB
Rexx
30 lines
2.6 KiB
Rexx
/*REXX program calculates the information entropy for a given character string. */
|
|
numeric digits length( e() ) % 2 - length(.) /*use 1/2 of the decimal digits of E. */
|
|
parse arg $; if $='' then $= 1223334444 /*obtain the optional input from the CL*/
|
|
#=0 ; @.= 0; L= length($) /*define handy-dandy REXX variables. */
|
|
$$= /*initialize the $$ list. */
|
|
do j=1 for L; _= substr($, j, 1) /*process each character in $ string.*/
|
|
if @._==0 then do; #= # + 1 /*Unique? Yes, bump character counter.*/
|
|
$$= $$ || _ /*add this character to the $$ list. */
|
|
end
|
|
@._= @._ + 1 /*keep track of this character's count.*/
|
|
end /*j*/
|
|
sum= 0 /*calculate info entropy for each char.*/
|
|
do i=1 for #; _= substr($$, i, 1) /*obtain a character from unique list. */
|
|
sum= sum - @._/L * log2(@._/L) /*add (negatively) the char entropies. */
|
|
end /*i*/
|
|
say ' input string: ' $
|
|
say 'string length: ' L
|
|
say ' unique chars: ' # ; say
|
|
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
|
|
exit /*stick a fork in it, we're all done. */
|
|
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
|
e: e= 2.718281828459045235360287471352662497757247093699959574966967627724076630; return e
|
|
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
|
log2: procedure; parse arg x 1 ox; ig= x>1.5; ii= 0; is= 1 - 2 * (ig\==1)
|
|
numeric digits digits()+5; call e /*the precision of E must be≥digits(). */
|
|
do while ig & ox>1.5 | \ig&ox<.5; _= e; do j=-1; iz= ox * _ ** -is
|
|
if j>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _= _ * _; izz= iz; end /*j*/
|
|
ox=izz; ii=ii+is*2**j; end /*while*/; x= x * e** -ii -1; z= 0; _= -1; p= z
|
|
do k=1; _= -_ * x; z= z+_/k; if z=p then leave; p= z; end /*k*/
|
|
r= z + ii; if arg()==2 then return r; return r / log2(2,.)
|