59 lines
1.6 KiB
Fortran
59 lines
1.6 KiB
Fortran
!-*- mode: compilation; default-directory: "/tmp/" -*-
|
|
!Compilation started at Tue May 21 21:43:12
|
|
!
|
|
!a=./f && make $a && OMP_NUM_THREADS=2 $a 1223334444
|
|
!gfortran -std=f2008 -Wall -ffree-form -fall-intrinsics f.f08 -o f
|
|
! Shannon entropy of 1223334444 is 1.84643936
|
|
!
|
|
!Compilation finished at Tue May 21 21:43:12
|
|
|
|
program shannonEntropy
|
|
implicit none
|
|
integer :: num, L, status
|
|
character(len=2048) :: s
|
|
num = 1
|
|
call get_command_argument(num, s, L, status)
|
|
if ((0 /= status) .or. (L .eq. 0)) then
|
|
write(0,*)'Expected a command line argument with some length.'
|
|
else
|
|
write(6,*)'Shannon entropy of '//(s(1:L))//' is ', se(s(1:L))
|
|
endif
|
|
|
|
contains
|
|
! algebra
|
|
!
|
|
! 2**x = y
|
|
! x*log(2) = log(y)
|
|
! x = log(y)/log(2)
|
|
|
|
! NB. The j solution
|
|
! entropy=: +/@:-@(* 2&^.)@(#/.~ % #)
|
|
! entropy '1223334444'
|
|
!1.84644
|
|
|
|
real function se(s)
|
|
implicit none
|
|
character(len=*), intent(in) :: s
|
|
integer, dimension(256) :: tallies
|
|
real, dimension(256) :: norm
|
|
tallies = 0
|
|
call TallyKey(s, tallies)
|
|
! J's #/. works with the set of items in the input.
|
|
! TallyKey is sufficiently close that, with the merge, gets the correct result.
|
|
norm = tallies / real(len(s))
|
|
se = sum(-(norm*log(merge(1.0, norm, norm .eq. 0))/log(2.0)))
|
|
end function se
|
|
|
|
subroutine TallyKey(s, counts)
|
|
character(len=*), intent(in) :: s
|
|
integer, dimension(256), intent(out) :: counts
|
|
integer :: i, j
|
|
counts = 0
|
|
do i=1,len(s)
|
|
j = iachar(s(i:i))
|
|
counts(j) = counts(j) + 1
|
|
end do
|
|
end subroutine TallyKey
|
|
|
|
end program shannonEntropy
|