** revised 16 Feb. 2021;  MAJOR REVISIONS

** th4 for Hungarian data
SET( _SET_EOL, CHR(10) )

** input data

clear screen
* vn1 = 0
* vn2 = 0
* vn3 = 0
* vn4 = 0
vtemp = "Y"
TEXT
    v.2 of TH4.exe; 16 Feb. 2021

    This routine computes three- and four-dimensional                      
    transmissions between and among NOMINAL variables.
    Input file is data.txt with five fields as follows:                 
    "id001","12","text1","var3","var4" 

    The first variable is an identifier, the four next ones              
    are nominal values. Note that numbers will be handled as             
    character strings. Each case on one line, string variables,         
    the comma is used as delimiter. 

    Output file is th4.dbf; new runs are appended to an                  
    existing file; if absent, th4.dbf is generated by the program.
    The program assumes that all observations are valid; typos
    lead to the introduction of a new class!

(c) Loet Leydesdorff, 2012, 2021


ENDTEXT
wait
clear screen
vname = space(30)
  @ 5,1 say "name of the run ?                     " get vname
  read

clear screen
  @ 5,1 say "wait >> "

* @ 8,1 Say "N of categories of the first variable  " Get vn1
* @ 9,1 Say "N of categories of the second variable " Get vn2
* @10,1 Say "N of categories of the third variable  " get vn3
* read
* @11,1 say "Is there a fourth variable ?           " get vtemp
* read
* clear screen
* if upper(vtemp) = "Y" 

* @11,1 Say "N of categories of the fourth variable " get vn4
* read

* else 
*    vn4 = 0
* endif

select 1                             && generate file input.dbf and read input data
delete file temp.dbf
create temp
append blank
replace field_name with "id"
replace field_type with "c"
replace field_len with 30
append blank
replace field_name with "v1"
replace field_type with "c"
replace field_len with 30
append blank
replace field_name with "v2"
replace field_type with "c"
replace field_len with 30
append blank
replace field_name with "v3"
replace field_type with "c"
replace field_len with 30
* if vn4 > 0
   append blank
   replace field_name with "v4"
   replace field_type with "c"
   replace field_len with 30
* endif
create input from temp
append from data.txt delimited 
go top
do while .not. eof()
   if len(trim(id)) = 0
      delete
   endif
   skip
enddo
pack
go top
vN = reccount()

** make output file
select 2
use temp
delete all
pack
append blank
replace field_name with "Hw"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hx"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9

append blank
replace field_name with "Hwx"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hwy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hwz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hxy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hxz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9

append blank
replace field_name with "Hwxy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hwxz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hwyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hxyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Hwxyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9

append blank
replace field_name with "Twx"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Txy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Txz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Tyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twxy"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twxz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Txyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Twxyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9
append blank
replace field_name with "Rwxyz"
replace field_type with "n"
replace field_len with 16
replace field_dec with 9

append blank
replace field_name with "name"
replace field_type with "c"
replace field_len with 30
append blank
replace field_name with "N_"
replace field_len with 9
replace field_type with "n"

if .not. file("th4.dbf")
   create th4 from temp
else 
   use th4
endif

***
vHw = 0
vHx = 0
vHy = 0
vHz = 0
vHwx = 0
vHwy = 0
vHwz = 0
vHxy = 0
vHxz = 0
vHyz = 0
vHwxy = 0
vHwxz = 0
vHwyz = 0
vHxyz = 0
vHwxyz = 0

select 1

index on v1 to v1
do while .not. eof()
   store v1 to vv1
   n = 0
   do while v1 == vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHw = vHw - (n/vN) * log(n/vN) / log(2) 
enddo  

index on v2 to v2
do while .not. eof()
   store v2 to vv2
   n = 0
   do while v2 == vv2 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHx = vHx - (n/vn) * log(n/vn) / log(2) 
enddo  
index on v3 to v3
do while .not. eof()
   store v3 to vv3
   n = 0
   do while v3 == vv3 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHy = vHy - (n/vn) * log(n/vn) / log(2) 
enddo  
* if vn4 > 0
   index on v4 to v4
   do while .not. eof()
      store v4 to vv4
      n = 0
      do while v4 == vv4 .and. .not. eof()
         n = n + 1
         skip
      enddo
      vHz = vHz - (n/vn) * log(n/vn) / log(2) 
   enddo  
* else
*   Hz = 0
* endif
select 2
append blank
replace Hw with vHw, Hx with vHx, Hy with vHy, Hz with vHz

vn1 = vn
vn = 2 * vn1      && 16 Feb 2021: wih increasing dimensionality the number of options increases

select 9
delete file temp.dbf
create temp
append blank
replace field_type with "c", field_len with 30, field_name with "count"
delete file temp2.dbf
create temp2 from temp

* wx, wy, wz, xy, xz, yz 
select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v2 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
use temp2
index on val(trim(count)) to icount
go top
vHwx = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) == vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwx = vHwx - (n/vN) * log(n/vN) / log(2) 
enddo  
* wz, wy, xy, xz, yz  ** wx

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v3 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
use temp2
index on val(trim(count)) to icount
go top
vHwy = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) == vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwy = vHwy - (n/vN) * log(n/vN) / log(2) 
enddo  


* wz, xy, xz, yz  ** wx, wy

select 9
use temp2
delete all
pack

** xy
select 1
set index to
go top
do while .not. eof()
   store v2 to vv1
   store v3 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
use temp2
index on val(trim(count)) to icount
go top
vHxy = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHxy = vHxy - (n/vN) * log(n/vN) / log(2) 
enddo  

* wx, xz, yz  ** wz, wy, xy, 




select 9
use temp2
delete all
pack

** xz
select 1
set index to
go top
do while .not. eof()
   store v2 to vv1
   store v4 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
index on val(trim(count)) to icount
go top
vHxz = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHxz = vHxz - (n/vN) * log(n/vN) / log(2)
enddo  


* yz  ** wz, wy, xy, wx, xz, 

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v3 to vv1
   store v4 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
index on val(trim(count)) to icount
go top
vHyz= 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHyz = vHyz - (n/vN) * log(n/vN) / log(2) 
enddo  

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v4 to vv2
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   select 1
   skip
enddo

select 9
index on val(trim(count)) to i9
go top
vHwz= 0
do while .not. eof()
   store val(trim(count)) to vv1
   nhelp = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      nhelp = nhelp + 1
      skip
   enddo

   vHwz = vHwz - (nhelp/vN) * log(nhelp/vN) / log(2) 
   vhelp = - (nhelp/vN) * log(nhelp/vN) / log(2)
*   ? str(nhelp) + str(vhelp) + str(vHwz)   
enddo  
* ? str(vHwz)


* ** wz, wy, xy, wx, xz, yz


select 2
replace Hwx with vHwx, Hwy with vHwy, Hwz with vHwz
replace Hxy with vHxy, Hxz with vHxz, Hyz with vHyz

vn = 3 * vn1    && Feb 21

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v2 to vv2
   store v3 to vv3
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   append blank
   replace count with vv3
   select 1
   skip
enddo

select 9
index on val(trim(count)) to icount
go top
vHwxy = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwxy = vHwxy - (n/vN) * log(n/vN) / log(2) 
enddo  

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v2 to vv2
   store v4 to vv3
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   append blank
   replace count with vv3
   select 1
   skip
enddo

select 9
index on val(trim(count)) to icount
go top
vHwxz = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwxz = vHwxz - (n/vN) * log(n/vN) / log(2) 
enddo  

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v3 to vv2
   store v4 to vv3
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   append blank
   replace count with vv3
   select 1
   skip
enddo

select 9
index on val(trim(count)) to i9a
go top
vHwyz = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwyz = vHwyz - (n/vN) * log(n/vN) / log(2) 
enddo  

select 9
use temp2
delete all
pack

select 1
set index to
go top
do while .not. eof()
   store v2 to vv1
   store v3 to vv2
   store v4 to vv3
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   append blank
   replace count with vv3
   select 1
   skip
enddo

select 9
index on val(trim(count)) to icount
go top
vHxyz = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHxyz = vHxyz - (n/vN) * log(n/vN) / log(2) 
enddo  

vn = 4 * vn1
select 9
use temp2
delete all
pack


select 1
set index to
go top
do while .not. eof()
   store v1 to vv1
   store v2 to vv2
   store v3 to vv3
   store v4 to vv4
   select 9
   append blank
   replace count with vv1
   append blank
   replace count with vv2
   append blank
   replace count with vv3
   append blank
   replace count with vv4
   select 1
   skip
enddo

vn = 4 * vn1
select 9
index on val(trim(count)) to icount
go top
vHwxyz = 0
do while .not. eof()
   store val(trim(count)) to vv1
   n = 0
   do while val(trim(count)) = vv1 .and. .not. eof()
      n = n + 1
      skip
   enddo
   vHwxyz = vHwxyz - (n/vN) * log(n/vN) / log(2) 
enddo  

select 9
delete all
pack

select 2
replace Hwxy with vHwxy, Hwxz with vHwxz, Hwyz with vHwyz, Hxyz with vHxyz
replace Hwxyz with vHwxyz

** transmissions

replace Twx with (Hw + Hx) - Hwx
replace Twy with (Hw + Hy) - Hwy
replace Twz with (Hw + Hz) - Hwz
replace Txy with (Hx + Hy) - Hxy
replace Txz with (Hx + Hz) - Hxz
replace Tyz with (Hy + Hz) - Hyz
replace Twxy with (Hw + Hx + Hy - Hwx - Hwy - Hxy + Hwxy)
replace Twxz with (Hw + Hx + Hz - Hwx - Hwz - Hxz + Hwxz)
replace Twyz with (Hw + Hy + Hz - Hwy - Hwz - Hyz + Hwyz)
replace Txyz with (Hx + Hy + Hz - Hxy - Hxz - Hyz + Hxyz)
replace Twxyz with (Hw + Hx + Hy + Hz - Hwx - Hwy - Hwz - Hxy - Hxz - Hyz + Hwxy + Hwxz + Hwyz + Hxyz - Hwxyz)
replace Rwxyz with -(Hw + Hx + Hy + Hz - Hwx - Hwy - Hwz - Hxy - Hxz - Hyz + Hwxy + Hwxz + Hwyz + Hxyz - Hwxyz) 
replace name with trim(vname)
replace N_ with vN
clear all
return