update
This commit is contained in:
Ingy döt Net
parent
1f1ad49427
commit
6f050a029e
2496 changed files with 37609 additions and 3031 deletions
|
|
@ -1,24 +1,38 @@
|
|||
/* Rexx ***************************************************************
|
||||
/* 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
|
||||
**********************************************************************/
|
||||
s="1223334444"
|
||||
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 c=1 To 4
|
||||
do ci=1 To cn
|
||||
c=substr(chars,ci,1)
|
||||
p.c=occ.c/n
|
||||
say c p.c
|
||||
/* say c p.c */
|
||||
End
|
||||
e=0
|
||||
Do c=1 To 4
|
||||
e=e+p.c*log(p.c,,2)
|
||||
Do ci=1 To cn
|
||||
c=substr(chars,ci,1)
|
||||
e=e+p.c*log(p.c,30,2)
|
||||
End
|
||||
Say 'Entropy of' s 'is' (-e)
|
||||
Say 'Version 1:' s 'Entropy' format(-e,,12)
|
||||
Exit
|
||||
|
||||
log: Procedure
|
||||
|
|
@ -28,6 +42,8 @@ log: Procedure
|
|||
* 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
|
||||
|
|
@ -78,7 +94,7 @@ log: Procedure
|
|||
End
|
||||
End
|
||||
If b<>'' Then
|
||||
r=r/log(b)
|
||||
r=r/log(b,prec)
|
||||
Numeric Digits (prec)
|
||||
r=r+0
|
||||
Return r
|
||||
|
|
|
|||
|
|
@ -1,30 +1,23 @@
|
|||
/*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($); $$=
|
||||
|
||||
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.*/
|
||||
end
|
||||
@._ = @._+1 /*keep track of this char 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.*/
|
||||
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.*/
|
||||
/*──────────────────────────────────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().*/
|
||||
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
|
||||
do while ig & xx>1.5 | \ig&xx<.5; _=e; do k=-1; iz=xx* _**-is
|
||||
if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end
|
||||
xx=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)
|
||||
/* REXX ***************************************************************
|
||||
* Test program to compare Versions 1 and 2
|
||||
* (the latter tweaked to be acceptable by my (oo)Rexx
|
||||
* and to give the same output.)
|
||||
* version 1 was extended to accept the strings of the incorrect flag
|
||||
* 22.05.2013 Walter Pachl (I won't analyze the minor differences)
|
||||
* 25.05.2013 I did now analyze and had to discover that
|
||||
* 'my' log routine is apparently incorrect
|
||||
* Correction is yet to come
|
||||
*********************************************************************/
|
||||
Call both '1223334444'
|
||||
Call both '1223334444555555555'
|
||||
Call both '122333'
|
||||
Call both '1227774444'
|
||||
Call both 'aaBBcccDDDD'
|
||||
Call both '1234567890abcdefghijklmnopqrstuvwxyz'
|
||||
Exit
|
||||
both:
|
||||
Parse Arg s
|
||||
Call entropy s
|
||||
Call entropy2 s
|
||||
Say ' '
|
||||
Return
|
||||
|
|
|
|||
30
Task/Entropy/REXX/entropy-3.rexx
Normal file
30
Task/Entropy/REXX/entropy-3.rexx
Normal file
|
|
@ -0,0 +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($); $$=
|
||||
|
||||
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.*/
|
||||
end
|
||||
@._ = @._+1 /*keep track of this char 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.*/
|
||||
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.*/
|
||||
/*──────────────────────────────────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().*/
|
||||
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)
|
||||
Loading…
Add table
Add a link
Reference in a new issue