Data commit

Task/Entropy/REXX/entropy-1.rexx

@@ -0,0 +1,100 @@
+/* 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
+**********************************************************************/
+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 ci=1 To cn
+  c=substr(chars,ci,1)
+  p.c=occ.c/n
+  /* say c p.c */
+  End
+e=0
+Do ci=1 To cn
+  c=substr(chars,ci,1)
+  e=e+p.c*log(p.c,30,2)
+  End
+Say 'Version 1:' s 'Entropy' format(-e,,12)
+Exit
+
+log: Procedure
+/***********************************************************************
+* Return log(x) -- with specified precision and a specified base
+* Three different series are used for the ranges  0 to 0.5
+*                                                 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
+  Numeric Digits (2*prec)
+  Numeric Fuzz   3
+  Select
+    When x<=0 Then r='*** invalid argument ***'
+    When x<0.5 Then Do
+      z=(x-1)/(x+1)
+      o=z
+      r=z
+      k=1
+      Do i=3 By 2
+        ra=r
+        k=k+1
+        o=o*z*z
+        r=r+o/i
+        If r=ra Then Leave
+        End
+      r=2*r
+      End
+    When x<1.5 Then Do
+      z=(x-1)
+      o=z
+      r=z
+      k=1
+      Do i=2 By 1
+        ra=r
+        k=k+1
+        o=-o*z
+        r=r+o/i
+        If r=ra Then Leave
+        End
+      End
+    Otherwise /* 1.5<=x */ Do
+      z=(x+1)/(x-1)
+      o=1/z
+      r=o
+      k=1
+      Do i=3 By 2
+        ra=r
+        k=k+1
+        o=o/(z*z)
+        r=r+o/i
+        If r=ra Then Leave
+        End
+      r=2*r
+      End
+    End
+  If b<>'' Then
+    r=r/log(b,prec)
+  Numeric Digits (prec)
+  r=r+0
+  Return r

Task/Entropy/REXX/entropy-2.rexx

@@ -0,0 +1,23 @@
+/* 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
+* 25.05.2013 problem identified & corrected
+*********************************************************************/
+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

Task/Entropy/REXX/entropy-3.rexx

@@ -0,0 +1,30 @@
+/*REXX program calculates the   information entropy   for a specified 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, .)