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

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,30 +1,30 @@
/*REXX program calculates the information entropy for a given char str.*/
numeric digits 30 /*use thirty digits for precision*/
parse arg $; if $=='' then $=1223334444 /*obtain optional input*/
n=0; @.=0; L=length($); $$=
/*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 $ str*/
if @._==0 then do; n=n+1 /*if unique, bump char counter. */
$$=$$ || _ /*add this character to 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 char count. */
@._=@._+1 /*keep track of this character's count.*/
end /*j*/
sum=0 /*calc info entropy for each char*/
do i=1 for n; _=substr($$,i,1) /*obtain a char from unique list.*/
sum=sum - @._/L * log2(@._/L) /*add (negatively) the entropies.*/
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: ' n ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
exit /*stick a fork in it, we're done.*/
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. */
/*──────────────────────────────────LOG2 subroutine───────────────────────────*/
log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
log2: procedure; parse arg x 1 ox; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be ≥ digits().*/
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
do while ig & xx>1.5 | \ig&xx<.5; _=e; do j=-1; iz=xx* _**-is
if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave; _=_*_; izz=iz; end /*j*/
xx=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,0)
do while ig & ox>1.5 | \ig&ox<.5; _=e; do k=-1; iz=ox* _**-is
if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end
ox=izz; ii=ii+is*2**k; end; 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,0)