clear screen

@ 2,1 say "Fill out the values for a three-dimensional array in terms of "
@ 3,1 say "(positive!) frequencies. The program will make probabilities "
@ 4,1 say "from this and produce maximum entropies from this in wmax.dbf. "

p000 = 0
p001 = 0
p010 = 0
p011 = 0
p100 = 0
p101 = 0
p110 = 0
p111 = 0
@ 6,5 say "000" get p000 picture "9999.99"   valid p000 >= 0 
@ 7,5 say "001" get p001 picture "9999.99"   valid p001 >= 0 
@ 8,5 say "010" get p010 picture "9999.99"   valid p010 >= 0 
@ 9,5 say "011" get p011 picture "9999.99"   valid p011 >= 0 
@ 10,5 say "100" get p100 picture "9999.99"  valid p100 >= 0 
@ 11,5 say "101" get p101 picture "9999.99"  valid p101 >= 0 
@ 12,5 say "110" get p110 picture "9999.99"  valid p110 >= 0 
@ 13,5 say "111" get p111 picture "9999.99"  valid p111 >= 0 

@ 20,5 say "Finish with <RETURN>; empty values will be zero."
read

select 1
delete file temp.dbf
create temp
append blank
replace field_name with "n000"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n001"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n010"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n011"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n100"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n101"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n110"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
append blank
replace field_name with "n111"
replace field_type with "n"
replace field_len with 10
replace field_dec with 3
delete file numeric.dbf

create numeric from temp
use numeric
append blank
replace n000 with p000, n001 with p001, n010 with p010, n011 with p011
replace n100 with p100, n101 with p101, n110 with p110, n111 with p111

c = 1
vsum = 0
do while c <= 8
   h = field(c)
   vsum = vsum + &h
   c = c + 1
enddo
delete file temp.dbf
copy stru extend to temp

select 2
use temp
replace all field_len with 7
replace all field_dec with 5
delete file probab.dbf
create probab from temp
append blank
set relation to recno() into a
c = 1
do while c <= 8
   select 1
   h1 = field(c)
   h2 = &h1
   select 2
   h3 = h2/vsum
   replace &h1 with h3
   c = c + 1
enddo
p000 = n000
p001 = n001
p010 = n010
p011 = n011
p100 = n100
p101 = n101
p110 = n110
p111 = n111

delete file wmax.dbf
copy to wmax

select 3
use wmax
c = 1
do while c <= 8
   h = field(c)
   replace &h with 1/8
   c = c + 1
enddo

vsum0 = 1
n = 1
do while n <= 100
   vsum0 = vsum
   if n000 + n001 > 0
      h000 = (p000 + p001) * (n000/(n000 + n001))
      h001 = (p000 + p001) * (n001/(n000 + n001))
   endif
   if n010 + n011 > 0
      h010 = (p010 + p011) * (n010/(n010 + n011))
      h011 = (p010 + p011) * (n011/(n010 + n011))   
   endif
   if n100 + n101 > 0
      h100 = (p100 + p101) * (n100/(n100 + n101))
      h101 = (p100 + p101) * (n101/(n100 + n101))
   endif
   if n110 + n111 > 0
      h110 = (p110 + p111) * (n110/(n110 + n111))
      h111 = (p110 + p111) * (n111/(n110 + n111))
   endif
   
   append blank
   replace n000 with h000
   replace n001 with h001
   replace n010 with h010
   replace n011 with h011
   replace n100 with h100
   replace n101 with h101
   replace n110 with h110
   replace n111 with h111
   
   if h000 + h010 > 0
      i000 = (p000 + p010) * (h000/(h000 + h010))
   endif
   if h001 + h011 > 0
      i001 = (p001 + p011) * (h001/(h001 + h011))
   endif
   if h000 + h010 > 0
      i010 = (p000 + p010) * (h010/(h000 + h010))
   endif
   if h001 + h011 > 0
     i011 = (p001 + p011) * (h011/(h001 + h011))
   endif
   if h100 + h110 > 0
      i100 = (p100 + p110) * (h100/(h100 + h110))
   endif
   if h101 + h111 > 0
      i101 = (p101 + p111) * (h101/(h101 + h111))
   endif
   if h100 + h110 > 0
      i110 = (p100 + p110) * (h110/(h100 + h110))
   endif
   if h101 + h111 > 0
      i111 = (p101 + p111) * (h111/(h101 + h111))
   endif
   
   append blank
   replace n000 with i000
   replace n001 with i001
   replace n010 with i010
   replace n011 with i011
   replace n100 with i100
   replace n101 with i101
   replace n110 with i110
   replace n111 with i111
   

   if i000 + i100 > 0
      j000 = (p000 + p100) * (i000/(i000 + i100))
   endif
   if i001 + i101 > 0
      j001 = (p001 + p101) * (i001/(i001 + i101))
   endif
   if i010 + i110 > 0
      j010 = (p010 + p110) * (i010/(i010 + i110))
   endif
   if i011 + i111 > 0
      j011 = (p011 + p111) * (i011/(i011 + i111))
   endif
   if i100 + i000 > 0
      j100 = (p000 + p100) * (i100/(i100 + i000))
   endif
   if i101 + i001 > 0
      j101 = (p001 + p101) * (i101/(i101 + i001))
   endif
   if i010 + i110 > 0
      j110 = (p010 + p110) * (i110/(i010 + i110))
   endif
   if i011 + i111 > 0
      j111 = (p011 + p111) * (i111/(i011 + i111))
   endif
   
   append blank
   replace n000 with j000
   replace n001 with j001
   replace n010 with j010
   replace n011 with j011
   replace n100 with j100
   replace n101 with j101
   replace n110 with j110
   replace n111 with j111
   vsum = j000 + j001 + j010 + j011 + j100 + j101 + j110 + j111
   
   n = n + 1
enddo

clear all   
** compute I(xyz) according to Krippendorff 2009, at p. 201

set decimal to 4

select 1
use probab

select 2
use wmax
go bottom

vI = 0
c = 1
do while c <= 8
   h1 = field(c)
   h2 = &h1
   select 1
   h3 = field(c)
   h4 = &h3
   vI = vI + (h4 * log(h4/h2)/log(2))
   select 2
   c = c + 1
enddo

clear screen
@ 10,5 say "I(ABC->AB:AC:BC) = " + ltrim(str(vI)) + " bits."
?
text

    The file wmax.dbf contains the maximum entropy values 
    after 100 iterations. (This file can be read by Excel.)
    
    
endtext
wait

clear all
return