clear screen


*SET LARGEFILE ON
*if !set(_SET_LARGEFILE)
*   ? "Large file support not available; this operating system"
*   ? "does yet not support it"
*   wait
*  clear all
*  return
* endif
**
vname = space(10)
vname2 = "coocc"
vyes = "N"
clear screen

@2,1
TEXT

The program redundancy.exe computes **synergy** measures along 
the column vectors of a 2-mode matrix saved in the .net format 
of Pajek. (Use preferentially Pajek itself for the saving.) 
The program and the data file have to be in the same folder. 
One is first prompted for the name of the file with the data.

If the matrix is 1-mode, use the following instruction in Pajek: 
Network > Create New Network> Transform> 1-Mode to 2-Mode. 
Save the file as a 2-mode matrix. Make sure that the row and 
column labels are unique.

Output are the files syn_ting.dbf containing the synergy values 
along the column dimension for all triplets of column vectors; 
minus.net containing the (negative) synergy contributions of 
links; plus.net the sums of positive values; diff.net total T123. 

Temp1.net contains the positive values of links (in h1) and the
negative ones (in h2). Temp2 the participatory sums for each node.
These are also written into shares.dbf. If the files cs.dbf and 
core.dbf (from isi.exe) are present, synergy values are also added.

ENDTEXT
wait
clear screen
@15,2 Say "input pajek file    "  get vname
read
vname = trim(vname)

vname2 = trim(vname2)
vnet = vname + ".net"
vnet = vname2 + ".net"
*delete file coocc.net
*copy file &vnet to coocc.net
vedge = "edges"
vvert = "vertices"
vco_row = "co_row"
vco_col = "co_col"
vpaj = "paj"
vyes = upper(vyes)

clear screen
@14,1 Say "processing input files"

****

select 1
create temp
append blank
replace field_name with "line"
replace field_len with 80
replace field_type with "c"

create lines from temp
vname2= vname + ".net"
copy file &vname2 to vname.txt
append from vname.txt sdf

select 2
use temp
delete all
pack
append blank
replace field_name with "citedj"
replace field_len with 50
replace field_type with "c"
append blank
replace field_name with "citedn"
replace field_len with 7
replace field_type with "n"
append blank
replace field_name with "tedtot"
replace field_len with 16, field_dec with 3
replace field_type with "n"
append blank
replace field_name with "tingtot"
replace field_len with 16, field_dec with 3
replace field_type with "n"
append blank
replace field_name with "scitedn"
replace field_len with 7
replace field_type with "c"
create &vvert from temp

select 3
use temp
delete all
pack
append blank
replace field_name with "citedn"
replace field_len with 7
replace field_type with "c"
append blank
replace field_name with "citingn"
replace field_len with 7
replace field_type with "c"
append blank
replace field_name with "total"
replace field_len with 15
replace field_type with "c"
append blank
replace field_name with "ncitedn"
replace field_len with 7
replace field_type with "n"
append blank
replace field_name with "ncitingn"
replace field_len with 7
replace field_type with "n"
append blank
replace field_name with "ntotal"
replace field_len with 16
replace field_type with "n"
replace field_dec with 8
append blank
replace field_name with "search1"
replace field_len with 14
replace field_type with "c"
append blank
replace field_name with "search2"
replace field_len with 14
replace field_type with "c"
append blank
replace field_name with "flogf", field_len with 16, field_dec with 9, field_type with "n"
create &vedge from temp

select 1
go top
do while .not. eof()
   do case
   case trim(line) < " "
      skip
      loop
   case "*V"$line .or. "*v"$line
      store trim(line) to vline
      store substr(vline,at(" ",vline)+1) to vvert
      store ltrim(vvert) to vvert
      if " "$vvert
         vvert1 = substr(vvert,1,at(" ",vvert)-1)
         vvert2 = substr(vvert,at(" ",vvert)+1)
         vvert2 = ltrim(trim(vvert2))
         nvert1 = val(vvert1)                     && nrows + ncols
         nvert2 = val(vvert2)                     && nrows
         nvert = nvert1 - nvert2                  && ncols
         vmode = 2
      else
         nvert= val(vvert)
         vmode = 1
         nvert2 = 0
         nvert1 = nvert
      endif
      skip
      vcount = 1
      do while '"'$line .and. .not. eof()
         if "*"$line
            skip
            vcount = vcount + 1
            loop
         endif
         vn = substr(line,1,at('"',line)-1)
         vj = substr(line,at('"',line)+1)
         vj = substr(vj,1,at('"',vj)-1)
         select 2
         append blank
         replace citedj with ltrim(vj)
         replace citedn with val(trim(ltrim(vn))) 
         select 1
         vcount = vcount + 1
         skip
      enddo
      if "*"$line
         skip
      endif
      do while .not. trim(line) < " " .and. .not. eof()
         vline = ltrim(line)
         vcited = substr(vline,1,at(" ",vline)-1)
         vtotal = substr(vline,at(" ",vline)+1)
         vtotal = ltrim(vtotal)
         vciting = substr(vtotal,1,at(" ",vtotal)-1)
         vtotal = substr(vtotal,at(" ",vtotal)+1)
         vtotal = ltrim(trim(vtotal))
         if "E-"$vtotal
            vdec = substr(vtotal,at("E-",vtotal)+2)
            vdec = -val(vdec)
            vtotal = substr(vtotal,1,at("E-",vtotal)-1)
            vtotal = val(vtotal)
            vtotal = vtotal * 10^vdec
            vtotal = str(vtotal,10,8)
         endif
         vciting= ltrim(trim(vciting))
         vcited = ltrim(trim(vcited))
 
            select 3
            append blank
            replace citedn with vcited, citingn with vciting, total with vtotal

         select 1
         skip
      enddo
   endcase
   select 1
   skip
enddo

select 2
replace all scitedn with ltrim(str(citedn))

select 3
replace all ncitedn with val(trim(citedn))
replace all ncitingn with (val(trim(citingn)) - nvert2)  
replace all ntotal with val(trim(total))


** fill tedtot etc.
close data

select 1
use edges
index on citedn to i1

select 2
use vertices
do while recno() <= nvert2 .and. .not. eof()
   store trim(scitedn) to vcitedn
   select 1
   vted = 0
   vted2 = 0
   seek vcitedn
   do while vcitedn == trim(citedn) .and. .not. eof()
      vted = vted + ntotal
      vted2 = vted2 + (ntotal * ntotal)
      skip
   enddo
   select 2
   replace tedtot with vted
*   replace sqrow with vted2
   skip
enddo

select 1
use edges
index on citingn to i1

select 2
use vertices
goto nvert2 + 1
do while .not. eof()
   store scitedn to vcitingn
   select 1
   vting = 0
   seek vcitingn
   do while vcitingn == citingn .and. .not. eof()
      vting = vting + ntotal
      skip
   enddo
   select 2
   replace tingtot with vting
   skip
enddo

close data

clear screen

@15,1 SAY "organizing output files"

select 1
delet file temp.dbf

   create temp
   append blank
   replace field_name with "citedj1", field_type with "c", field_len with 50
   append blank
   replace field_name with "citedn1", field_type with "c", field_len with 7
   append blank
   replace field_name with "citedj2", field_type with "c", field_len with 50
   append blank
   replace field_name with "citedn2", field_type with "c", field_len with 7
   append blank
   replace field_name with "citedj3", field_type with "c", field_len with 50
   append blank
   replace field_name with "citedn3", field_type with "c", field_len with 7
   append blank
   replace field_name with "h1", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h2", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h3", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h12", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h13", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h23", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "h123", field_type with "n", field_len with 19, field_dec with 6
   append blank
   replace field_name with "t12", field_type with "n", field_len with 16, field_dec with 6
   append blank
   replace field_name with "t13", field_type with "n", field_len with 16, field_dec with 6
   append blank
   replace field_name with "t23", field_type with "n", field_len with 16, field_dec with 6
   append blank
   replace field_name with "t123", field_type with "n", field_len with 16, field_dec with 6
   append blank
   replace field_name with "nted1", field_type with "n", field_len with 10
   append blank
   replace field_name with "nting1", field_type with "n", field_len with 10
   append blank
   replace field_name with "scitedn1", field_type with "c", field_len with 7

   delete file syn_ting.dbf
   create syn_ting from temp
   delete file synergy0.dbf
   create synerg0 from temp
*   append fields citedj, citedn from vertices
*   go top

close data

? "h"
select 3
use syn_ting

select 1
use edges
index on citingn to i1

select 2
use vertices
goto nvert2 + 1
vrecno1 = nvert2 + 1
vrecno2 = nvert2 + 2
vrecno3 = nvert2 + 3
   
         vh1 = 0
         vh2 = 0
         vh3 = 0
         vh12 = 0
         vh13 = 0
         vh23 = 0
         vh123 = 0
         

do while .not. eof()
   ? str(vrecno1)
   store recno() to vrecno1
         if tingtot = 0
            skip
            loop
         endif
   store tingtot to vtingtot1
   store scitedn to vcitedn1
   store citedj to vcitedj1
   skip 
   do while .not. eof()
      store recno() to vrecno2
      if tingtot = 0
         skip
         loop
      endif
      store tingtot to vtingtot2
      store scitedn to vcitedn2
      store citedj to vcitedj2
      skip 
      do while .not. eof()
         store recno() to vrecno3
         store tingtot to vtingtot3
         if tingtot = 0
            skip
            loop
         endif
         store scitedn to vcitedn3
         store citedj to vcitedj3

         select 1
         seek vcitedn1
      *   ? vcitedn1 + citingn + str(vh1)
      *   wait
         do while citingn == vcitedn1 .and. .not. eof()
            if ntotal > 0
               vp1 = ntotal/vtingtot1
               vh1 = vh1 - (vp1* log(vp1)/ log(2))
               vp12 = ntotal/(vtingtot1 + vtingtot2)
               vh12 = vh12 - (vp12* log(vp12)/ log(2))
               vp13 = ntotal/(vtingtot1 + vtingtot3)
               vh13 = vh13 - (vp13* log(vp13)/ log(2))
               vp123 = ntotal/(vtingtot1 + vtingtot2 + vtingtot3)
               vh123 = vh123 - (vp123* log(vp123)/ log(2))
            endif
            skip
         enddo
         if vh1 = 0
            select 2
   
            vh1 = 0
            vh2 = 0
            vh3 = 0
            vh12 = 0
            vh13 = 0
            vh23 = 0
            vh123 = 0
              
            skip
            loop
         endif
   
         seek vcitedn2
         do while citingn == vcitedn2 .and. .not. eof()
            if ntotal > 0
               vp2 = ntotal/vtingtot2
               vh2 = vh2 - (vp2* log(vp2)/ log(2))
               vp12 = ntotal/(vtingtot1 + vtingtot2)
               vh12 = vh12 - (vp12* log(vp12)/ log(2))
               vp23 = ntotal/(vtingtot2 + vtingtot3)
               vh23 = vh23 - (vp23* log(vp23)/ log(2))
               vp123 = ntotal/(vtingtot1 + vtingtot3 + vtingtot3)
               vh123 = vh123 - (vp123* log(vp123)/ log(2))
            endif
            skip
         enddo
         if vh2 = 0
            select 2
   
            vh1 = 0
            vh2 = 0
            vh3 = 0
            vh12 = 0
            vh13 = 0
            vh23 = 0
            vh123 = 0
              
            skip
            loop
         endif
            
         seek vcitedn3
         do while citingn == vcitedn3 .and. .not. eof()
            if ntotal > 0
               vp3 = ntotal/vtingtot3
               vh3 = vh3 - (vp3* log(vp3)/ log(2))
               vp13 = ntotal/(vtingtot1 + vtingtot3)
               vh13 = vh13 - (vp13* log(vp13)/ log(2))
               vp23 = ntotal/(vtingtot2 + vtingtot3)
               vh23 = vh23 - (vp23* log(vp23)/ log(2))
               vp123 = ntotal/(vtingtot1 + vtingtot3 + vtingtot3)
               vh123 = vh123 - (vp123* log(vp123)/ log(2))
            endif
            skip
         enddo
         if vh3 = 0
            select 2
   
            vh1 = 0
            vh2 = 0
            vh3 = 0
            vh12 = 0
            vh13 = 0
            vh23 = 0
            vh123 = 0
              
            skip
            loop
         endif

         
         select 3
         append blank
         replace citedj1 with vcitedj1, citedj2 with vcitedj2, citedj3 with vcitedj3
         replace citedn1 with vcitedn1, citedn2 with vcitedn2, citedn3 with vcitedn3
         replace h1 with vh1, h12 with vh12, h123 with vh123, h2 with vh2, h3 with vh3, h13 with vh13, h23 with vh23
         replace t12 with ((h1 + h2) - h12)
         replace t13 with ((h1 + h3) - h13) 
         replace t23 with ((h2 + h3) - h23)
         replace t123 with ((h1 + h2 + h3) - (h12 + h13 + h23) + h123)

   
         vh1 = 0
         vh2 = 0
         vh3 = 0
         vh12 = 0
         vh13 = 0
         vh23 = 0
         vh123 = 0
              
         select 2
         goto vrecno3 + 1
      enddo
      select 2
      goto vrecno2 + 1
   enddo
   select 2
   goto vrecno1 + 1
enddo

close data


select 1
use syn_ting
delete file temp1.dbf
copy fields CITEDj1, citedn1, citedj2, citedn2, t123, h1, h2 to temp1

select 2
use temp1
replace all h1 with 0
replace all h2 with 0
index on citedn1 + citedn2 to t2
goto top

select 1
goto top
do while .not. eof()
   store citedn1 to vcitedn1
   store citedn2 to vcitedn2
   store citedn3 to vcitedn3
   store citedj1 to vcitedj1
   store citedj2 to vcitedj2
   store citedj3 to vcitedj3
   store t123 to vt123
   select 2
   append blank
   replace citedn1 with vcitedn1, citedn2 with vcitedn3, t123 with vt123, citedj1 with vcitedj1, citedj2 with vcitedj2
   append blank
   replace citedn1 with vcitedn2, citedn2 with vcitedn3, t123 with vt123, citedj1 with vcitedj2, citedj2 with vcitedj3
   select 1
   skip
enddo

select 2
delete file temp2.dbf
copy stru to temp2
delete file temp3.dbf
copy stru to temp3

select 3
use temp2

select 2
use temp1
set index to t2
goto top
do while .not. eof()
   store citedn1 to vcitedn1
   store citedn2 to vcitedn2
   store citedj1 to vcitedj1
   store citedj2 to vcitedj2
   vh1 = 0
   vh2 = 0
   do while (vcitedn1==citedn1 .and. vcitedn2 == citedn2) .and. .not. eof()
      if t123 >= 0 
         vh1 = vh1 + t123
      endif
      if t123 < 0
         vh2 = vh2 - t123
      endif
      skip
   enddo
   store recno() to vrec1
   seek (vcitedn2 + vcitedn1)
   do while (vcitedn2==citedn1 .and. vcitedn1 == citedn2) .and. .not. eof()
      if t123 >= 0 
         vh1 = vh1 + t123
      endif
      if t123 < 0
         vh2 = vh2 - t123
      endif
      skip
   enddo

** h1 is the sum of positive t123 values; h2 the sum of negative ones

   select 3
   append blank
   replace citedn1 with vcitedn1, citedn2 with vcitedn2, h1 with vh1, h2 with vh2, citedj1 with vcitedj1, citedj2 with vcitedj2
   select 2
   goto vrec1
   skip
enddo

close data

set console off
set alternate to plus.net
set alternate on

select 3
use lines
* if vmode = 1
   ?? "*Vertices      " + str(nvert1 - nvert2)
*else 
*   ?? "*Vertices      " + str(nvert1) + "   " + str(nvert1 - nvert2)
*endif
skip nvert2 + 1
n = 1
do while .not. "*"$line .and. .not. eof()
   vline = trim(substr(line,at('"',line)-1))
   vline = substr(vline,1,rat('"',vline)+1)
   ? str(n) + "   " + lower(vline)
   n = n + 1 
   skip
enddo

? "*Arcs"
select 2
use temp2
do while .not. eof()
   val1 = val(citedn1) - (nvert2)
   val2 = val(citedn2) - (nvert2)
   if h1 > 0
      ? str(val1) + str(val2) + str(h1)
   endif
   skip
enddo

set alternat to minus.net
select 3
goto top
use lines
* if vmode = 1
   ?? "*Vertices      " + str(nvert1 - nvert2)
* else 
*   ?? "*Vertices      " + str(nvert1) + "   " + str(nvert1 - nvert2)
* endif
skip nvert2 + 1
n = 1
do while .not. "*"$line .and. .not. eof()
   vline = trim(substr(line,at('"',line)-1))
   vline = substr(vline,1,rat('"',vline)+1)
   ? str(n) + "   "+ lower(vline)
   n = n + 1 
   skip
enddo

? "*Arcs"
select 2
use temp2
do while .not. eof()
   val1 = val(citedn1) - (nvert2)
   val2 = val(citedn2) - (nvert2)
   if h2 > 0
      ? str(val1) + str(val2) + str(h2)
   endif
   skip
enddo


set alternat to diff.net
select 3
goto top
use lines
* if vmode = 1
   ?? "*Vertices      " + str(nvert1 - nvert2)
* else 
*    ?? "*Vertices      " + str(nvert1) + "   " + str(nvert1 - nvert2)
* endif
skip nvert2 + 1
n = 1
do while .not. "*"$line .and. .not. eof()
   vline = trim(substr(line,at('"',line)-1))
   vline = substr(vline,1,rat('"',vline)+1)
   ? str(n) + "   "+ lower(vline)
   n = n + 1 
   skip
enddo

? "*Arcs"
select 2
use temp2
goto top
do while .not. eof()
   val1 = val(citedn1) - (nvert2)
   val2 = val(citedn2) - (nvert2)
   if (h1 - h2) < 0
      ? str(val1) + str(val2) + str(h2 - h1)
   endif
   skip
enddo



set alternate to
set alternate off

  nFHand = fopen("minus.net",2)
   fseek(nFHand, -1, 2)
   fwrite(nFHand, "", 1) 

  nFHand = fopen("plus.net",2)
   fseek(nFHand, -1, 2)
   fwrite(nFHand, "", 1) 

  nFHand = fopen("diff.net",2)
   fseek(nFHand, -1, 2)
   fwrite(nFHand, "", 1) 

***
close data

select 1
use temp2
index on -h2 to i1

select 2
use temp
delete all
pack
append blank
replace field_name with "citedj"
replace field_len with 50
replace field_type with "c"
append blank
replace field_name with "nr"
replace field_len with 8
replace field_type with "c"
append blank
replace field_name with "citedn"
replace field_len with 8
replace field_type with "c"
append blank
replace field_name with "h1"
replace field_type with "n"
replace field_len with 16
replace field_dec with 6
append blank
replace field_name with "h2"
replace field_type with "n"
replace field_len with 16
replace field_dec with 6
append blank
replace field_name with "ti"
replace field_type with "c"
replace field_len with 250
append blank
replace field_name with "cs"
replace field_type with "c"
replace field_len with 250


create shares from temp
index on nr to icitedn

select 1
do while .not. eof()
   store citedn1 to vcitedn1
   store citedn1 to vcitedn1a
   store citedj1 to vcitedj1
   store h1 to vh1
   store h2 to vh2
   vcitedn1 = val(vcitedn1) - nvert2
   vcitedn1 = "n" + ltrim(str(vcitedn1))
   select 2
   seek vcitedn1
   if .not. found()
      append blank
      replace citedj with vcitedj1
      replace nr with vcitedn1, h1 with vh1, h2 with vh2, citedn with vcitedn1a
   else 
      replace h1 with h1 + vh1,h2 with h2 + vh2
   endif
   select 1
   skip
enddo

goto top
do while .not. eof()
   store citedn2 to vcitedn1
   store citedn2 to vcitedn1a
   store citedj2 to vcitedj1
   store h1 to vh1
   store h2 to vh2
   vcitedn1 = val(vcitedn1) - nvert2
   vcitedn1 = "n" + ltrim(str(vcitedn1))
   select 2
   seek vcitedn1
   if .not. found()
      append blank
      replace citedj with vcitedj1
      replace nr with vcitedn1, h1 with vh1, h2 with vh2, citedn with vcitedn1a
   else 
      replace h1 with h1+ vh1, h2 with h2 + vh2
   endif
   select 1
   skip
enddo

if file("core.dbf") .and. file("cs.dbf")

   select 3
   use core
   index on nr to inr
   delete file temp.dbf
   copy stru extended to temp.dbf
   use temp
   append blank
   replace field_name with "tijk"
   replace field_type with "n"
   replace field_len with 15
   replace field_dec with 6
   create core_syn from temp
   append from core
   index on nr to i3
   
   select 4
   use cs
   delete file temp.dbf
   copy stru extended to temp
   use temp
   append blank
   replace field_name with "tijk"
   replace field_type with "n"
   replace field_len with 15
   replace field_dec with 6
   delete file cs_syn.dbf
   create cs_syn from temp
   append from cs
   index on nr to i4
   
   select 2
   goto top
   do while .not. eof()
      store citedn to vcitedn
      store nr to vnr
      store h1 to vh1
      store h2 to vh2
      select 3
      seek vnr
      store trim(ti) to vti
      replace tijk with vh2
      select 4
      seek vnr
      store trim(cs) to vcs
      do while nr == vnr .and. .not. eof()
         replace tijk with vh2
         skip
      enddo
      select 2
      replace ti with vti, cs with vcs
      skip
   enddo
endif
      
***

close data

select 2
use shares
index on citedn to icitedn

select 1
if !file("div_col.dbf")
   clear all
   return
endif
use div_col
delete file temp.dbf
copy stru exte to temp
use temp
append blank
replace field_name with "tplus", field_type with "n", field_len with 15, field_dec with 6
append blank
replace field_name with "tminus", field_type with "n", field_len with 15, field_dec with 6
append blank
replace field_name with "tdiff", field_type with "n", field_len with 15, field_dec with 6
creat div_share from temp
append from div_col

goto top
do while .not. eof()
   store trim(scitedn) to vcitedn
   select 2
   seek vcitedn
   store h1 to vh1
   store h2 to vh2
   select 1
   replace tplus with vh1
   replace tminus with vh2
   replace tdiff with vh1 + vh2
   skip
enddo


clear all
return