//*************************************************************
// Sample script provided "as is" by Applied Maths.
// You are free to use and modify this script for your
// own purposes.
// Please notice that improper use of script commands may
// corrupt your database. Running this script is entirely at
// your own responsibility. Applied Maths accepts no
// liability for any damage that results from using
// this script.
//*************************************************************

// CREATES CENTROTYPES FOR GROUPS IN COMPARISON

//$MENU window=comparison;popup=groups;insertafter=group separation;name=Create centrotypes...
integer i,j,rs,nbchar,groupnr,grpsize,grpmemb[],nbnew,grpnb[],nfield,present[],charadd[][];
DIALOG dlg;
XMLNODE node;
string expcl,experlist,expername,report,newkey,name,centrostring,fieldlist,fieldname,st;
float chars[],charmean[][],pres,dju;
CHARSET cs;

// Check if comparison is present
if not(CmpIsPresent) then CmpAttach;
if not(CmpIsPresent) then {
   message("No comparison is currently open");
   stop;
}

// Get character experiment for which centrotype has to be calculated
for i=1 to DbGetExperCount do {
    expcl=DbGetExperClass(i);
    if expcl="CHR" then {
        experlist=experlist+DbGetExperName(i)+"	";
        expername=experlist;expername=splitstring(expername,"	");
    }
}     

DlgAddText(dlg,"Select the character type experiment to use:",15,15,150,30);
DlgAddList(dlg,experlist,expername,15,55,150,130,"LIST");

if not(DlgShow(dlg,"Find centrotype",300,230)) then stop;

nbchar=ChrSetGetCount(expername);
report = report+"Number of characters in experiment: "+str(nbchar,3,0)+"~n~n";

// Find groups and group members
for groupnr=1 to 30 do {
   grpsize=0;
   for i=1 to CmpGetEntryCount do
      if CmpGetGroup(i)=groupnr then {
         grpsize=grpsize+1;
         grpmemb[grpsize]=i;
      }
      if grpsize = 1 then {
        DbSetSel(CmpGetEntryKey(grpmemb[1]),1);
        report=report+"Group  "+str(groupnr,0,0)+"~n";
        report=report+"       1 entry ~n ";
        report=report+"      key:  "+CmpGetEntryKey(grpmemb[1])+"~n~n";
      }
      else 
// Calculate centrotype for groups with more than 1 entry
     
      if grpsize > 1 then {
            for j=1 to nbchar do present[j]=0;
            nbnew=nbnew+1;  
            grpnb[nbnew]=groupnr;
            for i=1 to grpsize do {
            ChrLoad(cs,CmpGetEntryKey(grpmemb[i]),expername); 
            for j=1 to nbchar do {
               if ChrGetPresent(cs,j) then {
                  present[j]=present[j]+1;
                  charadd[nbnew][j]=1;
                  dju = ChrGetVal(cs,j);
                  charmean[nbnew][j]=charmean[nbnew][j]+ChrGetVal(cs,j);
               }
            }      
          }
 
          for j=1 to nbchar do {
              if present[j]>0 then {
                  charmean[nbnew][j]=charmean[nbnew][j]/present[j];
                  centrostring = centrostring+str(charmean[nbnew][j],4,2)+"	";
              }
              else centrostring = centrostring+"  /  "+"	";   
              pres = j/7;
              if floor(pres)=pres then centrostring=centrostring+"~n";
          }
          report=report+"Group  "+str(groupnr,0,0)+"~n";
          report=report+"     "+str(grpsize,0,0)+"  entries ~n ";
          report=report+"     centrotype:  ~n"+centrostring+"~n~n";
          centrostring="";
       }
}
// Present results, give opportunity to add centrotypes to database
// and to add information to its data base fields
// Select centrotypes
DlgReset(dlg);
DlgAddEdit(dlg,report,10,10,480,340);
DlgAddButton(dlg,"Add to database",11,15,360,150,25);
DlgAddButton(dlg,"Exit",12,180,360,80,25);
rs=DlgShow(dlg,"Find centrotype: report",510,430);

DlgReset(dlg);
if rs=11 then {
  for i=1 to DbGetFieldCount do {
     fieldlist=fieldlist+DbGetFieldName(i)+"	";
     fieldname=fieldlist;fieldname=splitstring(fieldname,"	");
  }  
  DlgAddText(dlg,"Enter ",15,15,30,20);
  st=" ";
  DlgAddEdit(dlg,st,45,15,150,20);
  DlgAddText(dlg,"in the following database field:",15,40,150,20);
  DlgAddList(dlg,fieldlist,fieldname,15,65,150,123,"LIST");
  if not(DlgShow(dlg,"Find centrotype",300,230)) then stop;

  for i=1 to nbnew do {
    newkey=DbAddEntry("");
    ChrCreate(cs,expername,"",newkey);
    DbSetField(newkey,fieldname,st);
  
        for j=1 to nbchar do {
        if charadd[i][j]=1 then ChrSetVal(cs,j,charmean[i][j]);}
    ChrSave(cs);
    DbSetSel(newkey,1);copyclipboard(newkey);
    CmpPasteSel;
    CmpSetGroup(CmpGetKeyNr(newkey),grpnb[i]);
   }
}