LIBNAME LIBREF ".";
libname libs "c:\myfiles\courses\seminar\seminar\software";
options nocenter;
options linesize=120;
options pagesize=58;
options linesize=78;
 
data kendat; infile "c:\myfiles\courses\seminar\seminar\software\pstar.list";
input person1 person2 relate;
proc iml;
reset storage=libs.stor6; load;
filename datfile 'pstar.dat';
use kendat; read all into kendat;
numpeop=9;
run getscin3(kendat,numpeop,socmtx,group);
*kendat=big;
numdyads=numpeop*(numpeop-1);


*z1 is the Choice parameter;
*z2 is the Choice Within Positions (groups) parameter;
*z3 is the Mutuality parameter;
*z4 is the Mutuality Within Positions (groups) parameter;
*z5 is the Transitivity parameter;

/*
socmtx=
{0 1 1 0 0 0,
 1 0 1 0 0 0,
 0 1 0 1 0 1,
 0 0 0 0 1 1,
 0 0 0 1 0 0,
 0 0 1 1 0 0};
group={1,1,1,2,2,2};
numpeop=6;
numdyads=numpeop*(numpeop-1);
*/

print kendat;
ties=kendat(|1:numdyads,3|);
print group;
print socmtx;
dyadlist=j(numdyads,9,0);
dyadpers=0;
do pers1 = 1 to numpeop;
  do pers2 = 1 to numpeop;
    if pers1 < pers2 | pers2 < pers1 then do;
      dyadpers=dyadpers+1;
      z1=1;
      if z1=1 & group(|pers1,|)=group(|pers2,|) then z2=1;
      else z2=0;
      if socmtx(|pers2,pers1|)=1 then z3=1;
      else z3=0;
      if z3=1 & group(|pers1,|)=group(|pers2,|) then z4=1;   
      else z4=0; 
      z5=0;
      print pers1 pers2;
      do i = 1 to numpeop;
        if (i < pers1 | i > pers1) & (i < pers2 | i > pers2) then do;
          if socmtx(|pers2,i|)=1 & socmtx(|pers1,i|)=1 then z5=z5+1;
          
          if socmtx(|i,pers2|)=1 & socmtx(|pers1,i|)=1 then z5=z5+1;
          
          if socmtx(|i,pers2|)=1 & socmtx(|i,pers1|)=1 then z5=z5+1;
          
        end;
      end;
      rowmarg=socmtx[,+];
      colmarg=socmtx[+,];
      twostar=rowmarg(|pers1,|);
      threstar=(twostar-1)*twostar/2; * Dumb, but works given formula on p.412;
      twopath=rowmarg(|pers2,|)+colmarg(|,pers1|);
      if socmtx(|pers2,pers1|)=1 then twopath=twopath-2; 
   *Begin threepath section;
      threpath=0;
      do i = 1 to numpeop;
        if (i < pers1 | i > pers1) & (i < pers2 | i > pers2) then do;
          pp=pers1||pers2;
          *print pp;
          run mdelst(pp,numpeop);
          *print pp;
          thing=socmtx(|pers2,i|)#socmtx(|i,|);
          run cutcol(thing,pp);
          *print thing pp;
          thing1=thing[+];
          threpath=threpath+thing1;
          thing=socmtx(|i,pers1|)#socmtx(|,i|);
          run cutrow(thing,pp);
          *print thing pp;
          thing2=thing[+];
          threpath=threpath+thing2;
	  *print thing2;      
        end;
     end;
       chosen=socmtx(|,pers1|);
       choose=socmtx(|pers2,|);
       combo=chosen*choose;
       run cutcol(combo,pp); 
       run cutrow(combo,pp);
       diagg=vecdiag(combo);
       threpath=threpath+combo[+]-diagg[+];          
       *print threpath;
    *End threepath section;      
    listdat=z1||z2||z3||z4||z5||twostar||threstar||twopath||threpath;
    dyadlist(|dyadpers,|)=listdat;
    *print pers1 pers2 listdat;
    end;
  end;    
end;

perslab="Pers.1";
do i = 2 to numpeop;
  perslab2='Pers.'+char(i);
  perslab=perslab//perslab2;	
  numlab=numlab||char(i);
  pnumlab=pnumlab//'P'+char(i);
end;
perslab=rowcatc(perslab)`;

A=1; CLAB=J(1,numdyads,'bertiewooster');
DO I=1 TO numpeop;
  DO J=1 TO numpeop;
    if i < j | j < i then do;
    TEMP=persLAB(|1,I|)||'&'||persLAB(|1,J|);
    CLAB(|1,A|)=ROWCATC(TEMP);
    A=A+1;
    end; 
 END;
END;
CALL CHANGE(CLAB,'&',' & ',0);
clab=clab`;
collabs={'Tie' 'Ch.w/g' 'Mutual.' 'Mut.w/g' 'Trans.' '2star' '3star' '2path' '3path'};
names={'Tie' 'Ch_wg' 'Mutual' 'Mut_wg' 'Trans' 'Twostar' 'Threstar' 'Twopath' 'Threpath'};

pdyadlst=ties||dyadlist(|,2:9|);
run lblingsh(pdyadlst,clab,collabs,'');
run lblingsh(pdyadlst(|,9|),clab,'ThreePath','');

file datfile;
DO I=1 TO NROW(pdyadlst);
  DO J=1 TO NCOL(pdyadlst);

    put j 10.0 @;
    put i 10.0 @; 
    PUT (pdyadlst[I,J]) 2.0 +2 @;
  END;
  PUT;
END;
CLOSEFILE datfile;

create pdyadlst from pdyadlst [colname=names];
append from pdyadlst;


proc logistic maxiter=100; 
  model tie = Ch_wg mutual mut_wg trans twostar threstar twopath threpath;


proc corr; var _all_;




* The file pstar.dat outputs the data in the following order:
'Tie' 'Ch.w/g' 'Mutual.' 'Mut.w/g' 'Trans.' '2star' '3star' '2path' '3path'};