35 lines
940 B
Plaintext
35 lines
940 B
Plaintext
*process source xref attributes or(!);
|
|
/*--------------------------------------------------------------------
|
|
* 08.08.2014 Walter Pachl translated from REXX version 1
|
|
*-------------------------------------------------------------------*/
|
|
ent: Proc Options(main);
|
|
Dcl (index,length,log2,substr) Builtin;
|
|
Dcl sysprint Print;
|
|
Dcl occ(100) Bin fixed(31) Init((100)0);
|
|
Dcl (n,cn,ci,i,pos) Bin fixed(31) Init(0);
|
|
Dcl chars Char(100) Var Init('');
|
|
Dcl s Char(100) Var Init('1223334444');
|
|
Dcl c Char(1);
|
|
Dcl (occf,p(100)) Dec Float(18);
|
|
Dcl e Dec Float(18) Init(0);
|
|
Do i=1 To length(s);
|
|
c=substr(s,i,1);
|
|
pos=index(chars,c);
|
|
If pos=0 Then Do;
|
|
pos=length(chars)+1;
|
|
cn+=1;
|
|
chars=chars!!c;
|
|
End;
|
|
occ(pos)+=1;
|
|
n+=1;
|
|
End;
|
|
do ci=1 To cn;
|
|
occf=occ(ci);
|
|
p(ci)=occf/n;
|
|
End;
|
|
Do ci=1 To cn;
|
|
e=e+p(ci)*log2(p(ci));
|
|
End;
|
|
Put Edit('s='''!!s!!''' Entropy=',-e)(Skip,a,f(15,12));
|
|
End;
|