aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Task/Entropy/REXX/entropy-3.rexx
View file

@ -1,18 +1,18 @@
/*REXX program calculates the information entropy for a given character string. */
numeric digits 50 /*use 50 decimal digits for precision. */
parse arg $; if $='' then $=1223334444 /*obtain the optional input from the CL*/
#=0; @.=0; L=length($); $$= /*define handy-dandy REXX variables. */
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*/
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*/
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
@ -23,8 +23,8 @@ exit /*stick a fork in it, we're al
log2: procedure; parse arg x 1 ox; ig= x>1.5; ii=0; is=1 - 2 * (ig\==1)
numeric digits digits()+5 /* [↓] precision of E must be≥digits()*/
e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759
do while ig & ox>1.5 | \ig&ox<.5; _=e; do j=-1; iz=ox* _**-is
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; x=x* e**-ii-1; z=0; _=-1; p=z
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,.)