Entropy/Narcissist

Entropy/Narcissist is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Write a program that computes and shows its own entropy.

J

Solution:<lang j> entropy=: +/@:-@(* 2&^.)@(#/.~ % #)

  1!:2&2 entropy 1!:1 (4!:4 <'entropy') { 4!:3</lang>

Example:<lang j> load 'entropy.ijs' 4.73307</lang>

Perl 6

<lang Perl 6>say log(2) R/ [+] map -> \p { p * -log p }, $_.bag.values »/» +$_

   given slurp($*PROGRAM_NAME).comb</lang>

Output:

4.98893170929151

REXX

REXX doesn't have a BIF for LOG or LN,   so the subroutine (function) LOG2 is included herein. <lang rexx>/*REXX program calculates the information entropy for this REXX program*/ numeric digits 30 /*use thirty digits for precision*/ n=0; @.=0; $$=; $=

             do m=1  for sourceline() /*obtain program source and ──◄ $*/
             $=$ || sourceline(m)     /*get a sourceLine of this pgm.  */
             end   /*m*/

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 'program length: ' L say ' unique chars: ' n ; say say 'the information entropy of this REXX program ──► ' format(sum,,12) 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)</lang>

output

program length:  1827
  unique chars:  69

the information entropy of this REXX program ──►  4.649522956153

Tcl

Note that this code doesn't bother to close the open handle on the script; it is only suitable as a demonstration program. <lang tcl>proc entropy {str} {

   set log2 [expr log(2)]
   foreach char [split $str ""] {dict incr counts $char}
   set entropy 0.0
   foreach count [dict values $counts] {

set freq [expr {$count / double([string length $str])}] set entropy [expr {$entropy - $freq * log($freq)/$log2}]

   }
   return $entropy

}

puts [format "entropy = %.5f" [entropy [read [open [info script]]]]]</lang>

Output:

entropy = 4.59099