/*  newlib1.sas  */

libname libs "c:\myfiles\courses\seminar\seminar\software.";
 
OPTIONS NOCENTER;
PROC IML;


start cutcol(mtx,mm);
ncol=mm[+];
countrow=1;
if type(mtx)='C' then zero='bertram  wooster';
else zero=0;
newmtx=j(nrow(mtx),ncol,zero);
do count=1 to nrow(mm);
  if mm(|count,|)=1 then do;
     newmtx(|,countrow|)=mtx(|,count|);
     countrow=countrow+1;
  end;
end;
mtx=newmtx;
finish cutcol;

START MDELST(MTX,N) GLOBAL (M0);
M0=J(N,1,1);
if mtx[+]^=0 then do;
  DM=MTX; MTX=M0;
  DO CTR = 1 TO ncol(dm);
     MTX(|DM(|1,CTR|),|)=0;
  END;
end;
FINISH MDELST;


* MODULES LBLING AND LBLINGC LABEL AND PRINT MATRICES SENT TO THEM.
  There are two of them so that you may play with the formats in 
  the last line.
  SEND MTX(TO BE PRINTED OUT)
       RLBL(THE LABELS TO DESCRIBE THE ROWS)
       CLBL(THE LABELS TO DESCRIBE THE COLUMNS)
       NAME(HOW YOU WOULD LIKE THE MATRIX NAMED IN THE OUTPUT);
 
START LBLING (MTX,RLBL,CLBL,NAME);
    IF NROW(MTX)=NCOL(MTX) & NROW(MTX)>2 THEN CLBL=RLBL`;
    MATTRIB MTX ROWNAME=(RLBL)
    COLNAME=(CLBL)
    LABEL=NAME;
    PRINT MTX[format=16.6];
FINISH LBLING;
 
START LBLINGC (MTX,RLBL,CLBL,NAME);
    IF NROW(MTX)=NCOL(MTX) & NROW(MTX)>2 THEN CLBL=RLBL`;
    MATTRIB MTX ROWNAME=(RLBL)
    COLNAME=(CLBL)
    LABEL=NAME;
    PRINT MTX[format=5.0]; 
FINISH LBLINGC;


START LBLINGD (MTX,RLBL,CLBL,NAME);
    *IF NROW(MTX)=NCOL(MTX) & NROW(MTX)>2 THEN CLBL=RLBL`;
    MATTRIB MTX ROWNAME=(RLBL)
    COLNAME=(CLBL)
    LABEL=NAME;
    PRINT MTX[format=7.4]; 
FINISH LBLINGD;


START LBLINGSH (MTX,RLBL,CLBL,NAME);
    *IF NROW(MTX)=NCOL(MTX) & NROW(MTX)>2 THEN CLBL=RLBL`;
    MATTRIB MTX ROWNAME=(RLBL)
    COLNAME=(CLBL)
    LABEL=NAME;
    PRINT MTX[format=3.2]; 
FINISH LBLINGSH;


start cutrow(mtx,mm);
nrow=mm[+];
countrow=1;
if type(mtx)='C' then zero='bertram  wooster';
else zero=0;
newmtx=j(nrow,ncol(mtx),zero);
do count=1 to nrow(mm);
  if mm(|count,|)=1 then do;
     newmtx(|countrow,|)=mtx(|count,|);
     countrow=countrow+1;
  end;
end;
mtx=newmtx;
finish cutrow;

start geteigs(mtx,nwmxeig,nwmx2eig,detmtx) global(symmtx);
holdmtx=mtx;
run makesymm(mtx,symmtx);
eigvals=eigval(mtx);
nwmxeig=eigvals(|1,1|);
nwmx2eig=eigvals(|2,1|);
if nwmx2eig=1 then nwmx2eig=1.00000000001;
if nwmxeig=1 then nwmx2eig=1.00000000001;
detmtx=det(mtx);
mtx=holdmtx;
finish geteigs;

start fnddivrg(mnblfs,divmtx);
divmtx=j(nrow(mnblfs),2,'No ');
nr=nrow(mnblfs);
do i=1 to nr;
  if abs(mnblfs(|i,1|))>2 then divmtx(|i,1|)='Yes';
  if abs(mnblfs(|i,2|))>9 then divmtx(|i,2|)='Yes';
end;  
finish fnddivrg;

*Note: Change made 10/7, to accomodate row normalization.;

start fndA(socmtx,Amtx) global (alphay,gammay,maxint,perstype,complete,stand,infltime,perslab,pnumlab,shockmtx,incldiag);
  
  Amtx=diag(gammay); *diag(j(nrow(socmtx),1,gammay));
  
  soccol=socmtx[,+];
  Amtx=Amtx-alphay*perstype*diag(soccol);
  Amtx=Amtx+alphay*socmtx;
finish fndA;


start recntint(socmtx,stack) global(currtime,numrecnt,perslab,pnumlab,decision);
delblk=j(nrow(socmtx),1,0)//j((numrecnt-1)*nrow(socmtx),1,1);
multblk=i(nrow(socmtx));
do i = 1 to numrecnt-1;
  multblk=multblk||i(nrow(socmtx));
end;
if currtime=1 then 
    stack=j(numrecnt*nrow(socmtx),ncol(socmtx),0);
if currtime<numrecnt+1 then
    stack(|((currtime-1)*nrow(socmtx)+1):currtime*nrow(socmtx),|)=socmtx;   
if currtime>numrecnt then do;
    run cutrow(stack,delblk);
    stack=stack//socmtx; 
end; 
sum=multblk*stack;
percint=sum/numrecnt;
title='%Ints.,&'||char(numrecnt);*||'&pts';
title=rowcatc(title); 
call change(title,'&',' ',0);
if decision=1 then do;
run lbling3(percint,perslab,pnumlab,title);
run lbling3(socmtx,perslab,pnumlab,'Soc. Network Mtx.');
end;
print /;
finish recntint;

* A description of what the module GETSCINF does: ;
* Here, we put the data from the input file into matrix format.
  There are three related matrices.
  KENDAT directly reflects the datafile.  It tells who interacts with 
  whom, but does not say who doesn't interact with whom.  	
  BIG is like KENDAT, but it has rows telling who doesn't interact with whom.
  Thus, in BIG, every possible interaction is mentioned.
  SOCMTX is like BIG, but it is in the familiar square social network 
  matrix format;
* We also generate the initial belief values (inflmtx).;

start getscin2(kend,numpeop,socmtx,group);
kendat=kend;
numpeop=kendat[<>,1]; 
print "Number of people=" numpeop; reset name;

group=j(numpeop,1,0); ct=1;
cut9999=j(nrow(kendat),1,1);
do count=1 to nrow(kendat);
   if kendat(|count,2|)>100 then do;
      cut9999(|count,|)=0; * Cuts out lines in data file indicating
				group memberships;
      group(|ct,|)=kendat(|count,3|); * groupmem is a column telling 
					   us who is in what group;
      ct=ct+1;
  end;
end;

* Here we standardize the matrix.;
run cutrow(kendat,cut9999);
kendat=kendat//{0 0 0};
socmtx=j(numpeop,numpeop,0);
where=1;
big={1 1 0};
typesc='contin';

do count1=1 to numpeop;
  do count2=1 to numpeop;
    big=big//(count1||count2||0);
    if count1*count2=1 then big=big(|2,|);
    if kendat(|where,1:2|)=count1||count2 then do;
      first=numpeop*(count1-1)+count2;
      if typesc='contin' then
        big(|first,3|)=kendat(|where,3|);
      else
	big(|first,3|)=1;
      where=where+1;
     end;
     socmtx(|count1,count2|)=big(|(count1-1)*numpeop+count2,3|);
  end;
end;
finish getscin2;


* This module is the same as above, except it changes all interactions
to be either a 0 or a 1;

start getscin3(kend,numpeop,socmtx,group);
kendat=kend;
numpeop=kendat[<>,1]; 
*print numpeop; 
reset name;

group=j(numpeop,1,0); ct=1;
cut9999=j(nrow(kendat),1,1);
do count=1 to nrow(kendat);
   if kendat(|count,2|)>100 then do;
      cut9999(|count,|)=0; * Cuts out lines in data file indicating
				group memberships;
      group(|ct,|)=kendat(|count,3|); * groupmem is a column telling 
					   us who is in what group;
      ct=ct+1;
  end;
end;

* Here we standardize the matrix.;
run cutrow(kendat,cut9999);
kendat=kendat//{0 0 0};
socmtx=j(numpeop,numpeop,0);
where=1;
big={1 1 0};
typesc='contin';

do count1=1 to numpeop;
  do count2=1 to numpeop;
    big=big//(count1||count2||0);
    if count1*count2=1 then big=big(|2,|);
    if kendat(|where,1:2|)=count1||count2 then do;
      first=numpeop*(count1-1)+count2;
      if typesc='contin' then do;
        if kendat(|where,3|)>0 then kendat(|where,3|)=1;
        big(|first,3|)=kendat(|where,3|);
      end;
      where=where+1;
     end;
     socmtx(|count1,count2|)=big(|(count1-1)*numpeop+count2,3|);
  end;
end;
cutmtx=j(nrow(socmtx),ncol(socmtx),1);
cutmtx=cutmtx-diag(cutmtx); 
cutmtx=shape(cutmtx,nrow(cutmtx)*ncol(cutmtx),1);
run cutrow(big,cutmtx);
kend=big;
finish getscin3;


start blfsdif(blfsdat,attdif) global(numpeop);

* Start with beliefs stuff.  For dyad "ij", predicting interaction
   at time 't', get ATTDIF, 
     where ATTDIF=abs(attitude_i,t - attitude_j,t);
    
* Note this assumes just 1 timepoint of beliefs (and 1 social network);

ATTDIF=j(numpeop,numpeop,0);
do i = 1 to numpeop;
  do j = 1 to numpeop;
    ATTDIF(|i,j|)=abs(blfsdat(|i,3|)-blfsdat(|j,3|));
  end;
end;

nodiag=j(numpeop*(numpeop-1),1,0);
where=1;
do i = 1 to numpeop;
  do j = 1 to numpeop;
    if i<j | i>j then do;
      nodiag(|where,|)=ATTDIF(|i,j|);
      where=where+1;
    end;
  end;
end;
attdif=nodiag;

finish blfsdif;


start inoutwy(socmtx,outcomes,group,inwy,outwy,totwy) global (numpeop);
totwy=socmtx*outcomes;

blkgroup=diag(group);
do i = 1 to nrow(blkgroup);
  do j = 1 to ncol(blkgroup);
    if blkgroup(|i,i|)=blkgroup(|j,j|) then blkgroup(|i,j|)=blkgroup(|i,i|);
  end;
end;
do i = 1 to nrow(blkgroup);
  do j = 1 to ncol(blkgroup);
    if blkgroup(|i,j|)>1 then blkgroup(|i,j|)=1;
  end;
end;
socmtxin=socmtx#blkgroup;
inwy=socmtxin*outcomes;
outwy=totwy-inwy;

finish inoutwy;


RESET STORAGE = libs.STOR6;
STORE MODULE = _ALL_; SHOW STORAGE;
RESET STORAGE = libs.STOR6;
STORE MODULE = _ALL_; SHOW STORAGE;