/*-------------------------------------------------------------------*
  *    Name: AGREEMT.SAS                                              *
  *   Title: Agreement chart for n x n table                          *
  *-------------------------------------------------------------------*
  *  Author:  Michael Friendly            <friendly@yorku.ca>         *
  * Created:  13 Mar 1991 10:23:12                                    *
  * Revised:  17 Mar 1991 14:40:33                                    *
  * Version:  1.1                                                     *
  *-------------------------------------------------------------------*/
*include goptions;
goptions  vsize=7.7in ;
title "Observer Agreement Chart";
proc iml;
 
*-- Bangdiwala Observer Agreement Chart [SAS SUGI, 1987, 1083-1088];
 
start agree(freq, w, vnames, lnames, title );
   row_sum = freq[,+];
   col_sum = freq[+,];
   n       = freq[+,+];
   k       = nrow(freq);
 
   reset noname;
   print (( freq || row_sum ) //
          ( col_sum || n ) )[r=(lnames ||'SUM') c=(lnames ||'SUM')];
   obs_agr = ssq( vecdiag(freq) );
   tot_agr = col_sum * row_sum ;
 
   call gstart;
   call gwindow( (-.15#J(1,2,n)) // (1.1#J(1,2,n)) );
*  call gset('FONT', 'DUPLEX');
   height = 1.3;
   call gstrlen(len,lnames,height);
 
   corner= { 0 0 };
   fill  = 'EMPTY';
   *-- construct marginal rectangles and locate row/col labels --;
   do s = 1 to k;
      thisbox = corner || row_sum[s] || col_sum[s];
      boxes   = boxes  // thisbox;
      fill    = fill   // 'EMPTY';
      center  = corner +((row_sum[s] || col_sum[s])
                       - (len[s]     || len[s]    ))/2;
      labelx  = labelx //(center[1] || (-.06#n)  || 0 )
                       //((-.04#n)  || center[2] || 90);
      labels  = labels // lnames[s]
                       // lnames[s];
      corner  = corner + (row_sum[s] || col_sum[s]);
      ht      = ht     // height // height;
      end;
 
   *-- variable names;
   height = 1.6;
   call gstrlen(len,vnames,height);
   center = ((1.0#n) - len)/2;
   labelx  = labelx // ( center[1] || (-.12#n)  || 0 )
                    // ( (-.10#n)  || center[2] || 90);
   labels  = labels // vnames[1]
                    // vnames[2];
   ht      = ht     // height // height;
 
   *-- surrounding frame, for all observations;
   boxes = boxes // ( { 0 0 } || n || n ) ;
 
   corner= { 0 0 };
   *-- construct agreement squares and scores;
   q = ncol(w) - 1;
   a = J(q+1,k,0);
   *-- b indexes distance from main diagonal for agreement;
   do b = 0 to q;
   do s = 1 to k;
      agr = max(1, s-b) : min(k, s+b) ;    * cells which agree;
      dis = 1 : max(1, s-b-1) ;            * disagre;
      box_loc = choose( (s-b-1)>0,
                        (sum(freq[s,dis]) || sum(freq[dis,s])),
                        { 0 0 } );
 /*   box_size= choose( (s-b) > 0,
                        (sum(freq[s,agr] ... */
      if s=1 then corner = {0 0};
             else corner = boxes[s,1:2] + box_loc;
                  /*       + (sum(freq[s,dis]) ||
                              sum(freq[dis,s])) ;   */
      thisbox = corner || sum(freq[s,agr]) || sum(freq[agr,s]);
      boxes   = boxes  // thisbox;
      if b>0 then a[b+1,s] =thisbox[3] # thisbox[4];
 
      if b=0 then fill    = fill   // 'SOLID';
      else do;
         if mod(b,2)=1 then dir='L';
                       else dir='R';
         dens = int((b+1) / 2);
         fill    = fill   // (dir + char(dens,1));
         end;
      end;
   end;
   print 'Bangdiwala agreement scores';
   part = diag(w) * A;
   weights = shape(w,0,1);
   steps = 0:q;
   BN =  1 - ( ( tot_agr - obs_agr - part[,+] ) / tot_agr );
   reset name;
   print steps weights[f=8.5] BN[f=8.4];
*  print boxes[c={'BotX' 'BotY' 'LenX' 'LenY'}] fill;
*  print labels labelx[c={X Y ANGLE}] ht;
 
   run gboxes( boxes, labels, labelx, fill, ht, title );
   call gstop;
finish;
 
*-- Draw and label the agreement display --;
start gboxes( boxes, labels, labelx, fill, ht, title );
   call gopen('AGREEMT');
   *-- locate the 4 corners of each box;
   ll = boxes[,{1 2}];
   lr = boxes[,{1 3}][,+] || boxes[,2] ;
   ul = boxes[,1] || boxes[,{2 4}][,+] ;
   ur = boxes[,{1 3}][,+] || boxes[,{2 4}][,+];
 
   xy = ll || ul || ur || lr;
   max = max(ur[,1]) || max(ur[,2]);
   do i=1 to nrow(boxes);
      box = shape(xy[i,], 4);
      color='BLACK';
      pat = fill[i];
      call gpoly( box[,1], box[,2], 1, color, pat, color);
   end;
 
   *-- Draw dotted diagonal line to show marginal homogeneity--;
   call gdrawl( {0 0}, max, 3 , 'RED' );
 
   do f=1 to nrow(labels);
      lxya = labelx[f,];
      labl = labels[f ];
      height = ht[f];
      call gscript( lxya[,1], lxya[,2], labl, lxya[,3], 0, height);
   end;
   height = 1.5;
   call gstrlen(len, title, height);
   tx = (max[1] - len)/2;
   call gscript(tx, max[2]#1.05, title, 0, 0, height);
   call gshow;
finish;
 
%include iml(gskipiml);
   freq =
     {  7     7     2      3,
        2     8     3      7,
        1     5     4      9,
        2     8     9     14 };
   title  = "Agreement Chart: Husband's and Wives Sexual Fun";
   vnames = {"Husband's Rating" "Wife's rating"};
   lnames = {'Never fun' 'Fairly Often' 'Very Often' 'Always fun'} ;
 
   freq =
     {  5     3     0      0,
        3    11     4      0,
        2    13     3      4,
        1     2     4     14 };
   title  = "Classification of Multiple Sclerosis";
   vnames = {"New Orleans Neurologist" "Winnipeg Neurologist"};
   lnames = {"Certain" "Probable" "Possible" "Doubtful"};
 
   r = nrow(freq);
   do i=1 to r-2;
      w = w || (1 -((i-1)##2 / (r-1)##2));
      run agree(freq, w, vnames, lnames, title);
   *  run gskip;
      end;
 
quit;
%gfinish;

data ms;
	do win_diag = 4 to 1 by -1;
	do no_diag  = 4 to 1 by -1;
		input count @@;
		output;
		end; end;
cards;
        5     3     0      0
        3    11     4      0
        2    13     3      4
        1     2     4     14 
title "Classification of Multiple Sclerosis";
proc catmod data=ms;
	weight count;
	response marginals;
	model win_diag * no_diag = _response_ / oneway cov;
	repeated neuro 2 / response= neurol;