macro- ; 
macro [ 500 ;
if ( (100+(5*(ntax+1))) > 1000 ) 
     macro*10 (100+(5*(ntax+1)));
else macro *10 1000 ; 
macro= ;

/**** CHECK WHETHER WE HAVE TREES *******/
if ( ntrees < 0 ) quote * 
This macro calculates bremer supports, by
reference to groups in some tree(s). To
run this macro, you need to have some 
tree(s) in memory. Find them and re-run.; proc/; end 

/****  DECLARE VARIABLES *********/
var = 10 
  schalgs[30] + tmpstring[30] + danumreps + fillonly + maxsave + maxsub 
  + savesub + hold + tmpbrem[ (2*(ntax+1)) ] + swaptype  + piweisoff 
  + scorinc + useconst + numsearches + avermin + alltrees + whichtree 
  + allnods + whichnod + inclist [ (ntax+1) ] + overimpose + ratreps 
  + driftreps + dofuse + secsearch + dorat + dodrift + domonosch 
  + timedsch + schtime + saveemf + emfname[30] + usersch + maxsupis 
  + beswith + beswithout + numincs + nowatsub + referscore + supis 
  + olrseed + whichtreewas + thereftree ; 

set piweisoff ( length[0] == score[0] ) ; 
set 0 ntrees ; 
set 1 ( ntax+2 ) ; 
set 2 ( 2 * ntax ) ; 
set olrseed rseed ; 

/***********      SET DEFAULTS          ***********/
/*      in non-Windows versions, set variables    */
/*      below to your preferred values!           */
set savesub 1 ;           /*  search suboptimal trees */
set useconst 1 ;          /*  do constrained searches */
set allnods 1 ;           /*  do all nodes, or single node    */
set whichnod (ntax+2) ;   /*  single node to do if allnods == 0  */
set alltrees 1 ;          /*  calculate support using all trees  */
set whichtree 0 ;         /*  if alltrees == 0, use groups from this tree */
set maxsave 1000 ;        /*  max. number of trees to save in each round  */
set maxsub 1 ;            /*  save trees up to N steps longer */
set scorinc 1 ;           /*  increase score gradually, in N steps each time  */
set avermin 1 ;           /*  if 0, use average difference of neg/pos constrained searches */
set numsearches 3 ;       /*  repeat constrained searches 3 times (to use either best/avg. score) */
set danumreps 1 ;         /*  use 1 repls. for each constrained search */
set domonosch 0 ;         /*  do a search constraining for monophyly (instead of comparing score 
                              of negatively constrained search with score of reference tree) */ 
loop 0 ntax               /*  by default, include all taxa  */
  set inclist[#1] 1; stop   
set saveemf 0 ;           /*  don't save tree-diagrama to a metafile (Windows only)  */
set emfname $bremer.emf ; /*  metafile default name */
set usersch 0 ;           /*  for constrained searches, use commands given by user */
set schalgs $ ;           /*  default user-commands (i.e. none) */
set dorat 0 ;             /*  do not use ratchet in constrained searches  */
set ratreps 10 ;          /*  number of ratchet reps. in constrained searches */
set dodrift 1 ;           /*  use drift in constrained searches  */
set driftreps 10 ;        /*  number of drift cycles in constrained searches   */
set secsearch 1 ;         /*  use sectorial search in constrained searches  */
set dofuse 1 ;            /*  fuse results of the 'danumreps' replications  */
set timedsch 0 ;          /*  use timeout for constrained searches */
set schtime 0 ;           /*  number of minutes to give up a constrained search (0 = don't give up) */

/***********  OPEN A WINDOWS DIALOG AND GET VALUES  ********/
/*           If running a non-windows version, you         */
/*           change the settings for the variables         */
/*           above (or change macro so that it reads       */
/*           values from arguments)                        */


if ( windows ) 
opendlg 30 30 555 280 Get trees and calculate supports... ; 
    frame 5 5 250 60 ; 
    check savesub 10 15 160 18 Search suboptimal trees... ;
       + subdlg 180 30 65 20 Settings ; 
            50 50 300 160  Swap existing trees...
            showtxt 30 10 90 18 ...saving up to ; 
            spin 1 32767 maxsave 125 10 80 18 trees ;
            showtxt 70 35 55 18 ...up to ; 
            spin 1 32767 maxsub 125 35 80 18 longer ;
            showtxt 10 60 110 18 ...increasing score ; 
            spin 1 32767 scorinc 125 60 80 18 every time ; 
            closedlg ; =
    frame 260 5 275 130 ; 
    showtxt 285 35 230 18 search with constraints...; 
    check useconst 270 15 240 18 For groups not lost in suboptimal trees, ; 
         + showtxt 300 60 55 18 ...search ; 
           spin 1 32767 numsearches 360 60 75 18 times, and... ; 
           choose avermin 
                325 85 130 18 use average score 
                325 110 130 18 use minimum score ; 
           subdlg 460 35 65 20 Settings ; 
             245 50 300 310 Constrained searches... ; 
        frame 5 5 285 35 ; 
        frame 5 40 285 130 ; 
        gettxt schalgs 110 15 160 18 ;  
        check usersch 10 15 90 18 User search: ; 
         - showtxt 10 50 105 18 for each one, use ; 
           spin 1 1000 danumreps 120 50 120 18 replications ; 
           check secsearch 10 70 140 18 do sectorial searches ; 
           check dorat 10 95 35 18 do ; 
             + spin 0 1000 ratreps 50 95 130 18 ratchet iterations ; = 
           check dodrift 10 120 35 18 do ; 
             + spin 0 1000 driftreps 50 120 130 18 tree-drift cycles ; = 
           check dofuse 10 145 170 18 fuse results from all repls. ; = 
        check domonosch 10 175 240 16 do a monophyly search as well (instead ; 
        showtxt 25 191 240 16 of using length of reference tree(s) ) ; 
        check timedsch 10 212 115 18 use no more than ; 
            + spin 1 1000 schtime 130 212 160 18 mins./search ; = 
        closedlg ; = 
   frame 5 65 250 170  ; 
   choose alltrees 
        15 80 120 18 For groups of tree   
          + spin 0 '0' whichtree  140 80 30 18 ; 
            choose allnods 
               60 105 70 18 for node 
                  + spin '1' '2' whichnod 130 105 30 18 ; = 
               60 130 90 18 for all nodes ; = 
        [ ( ntrees >= 0 ) ] 15 155 120 18 For all trees ; 
   showtxt 15 190 150 18 exclude some taxa ; 
   showtxt 15 208 150 18 from the consensus... ; 
   taxsel inclist 150 205 80 20 ; 
   frame 260 135 275 65 ; 
   check overimpose 270 150 220 18 Add labels to an existing target tree ; 
   check saveemf 270 170 112 18 Save metafile as ; 
       + gettxt emfname 387 170 130 18 ; = 
   subdlg 311 218 60 25 HELP; 
       85 60 460 240 How this macro works... ; 
       showtxt 10 10 430 15 This macro instructs TNT to search trees in stages. First, it searches ; 
       showtxt 10 25 430 15 saving suboptimal trees (possibly saving more suboptimal trees gradually, ; 
       showtxt 10 40 430 15 to avoid filling the tree buffer with superfluous trees), which it uses to ; 
       showtxt 10 55 430 15 identify the groups of low support.  Then, it searches using positive and ; 
       showtxt 10 70 430 15 negative constraints for each of the remaining groups.  It compares the score; 
       showtxt 10 85 430 15 length of the best trees with and without each group. For this, it can use ; 
       showtxt 10 100 430 15 the best score found (useful when you do very exhaustive searches) or the ; 
       showtxt 10 115 430 15 average (less prone to errors when you use more superficial searches or have ; 
       showtxt 10 130 430 15 very difficult data sets).  The macro considers only currently active chars.,; 
       showtxt 10 145 430 15 so that overimposed labels can be used for bremer supports of each partition.; 
       closedlg ; 
closedlg ;
if ( !exstatus ) proc/; end
end 

/****************  SOME PRELIMINARY CALCULATIONS   ****************/
resettime ; 
silent = buf ; 
macfloat 6 ; 
agroup =0 ( floaters ) ; 
loop 0 ntax if ( !'inclist[#1]' ) agroup >0 #1 ; end stop 

if ( ntrees == ( maxtrees-1 ) ) 
   set 0 ntrees+2 ; hold '0' ; end

loop 0 31 tgroup - #1 ; stop 

set whichtreewas 'whichtree' ; 

if ( 'alltrees' ) 
   sort ; 
   set referscore score[0] ; 
   coll temp ; 
   coll rule 1 ; 
   if ( score[0] == score[ntrees] ) 
       nelsen * / { floaters } ; 
       loop (ntax+2) (nnodes[ntrees]) set tmpbrem[#1] 1000000 ; stop 
   else 
     tread ( ... ) ; 
     set tmpbrem bremlist * / { floaters } ; 
   end 
else 
  set referscore score['whichtree'] ; 
  hold + 1 ; 
  copytree 'whichtree' ; 
  loop 0 ntax 
    if ( ( !'inclist[#1]' ) && isintree['whichtree' #1 ] ) 
         lquote[ ; 
         quote * When calculating support from a tree, tree cannot &10include any excluded taxon! ; 
         lquote] ; 
         proc/; end 
    if ( !isintree['whichtree' #1] ) set inclist[#1] 0 ; end 
    stop 
  loop (ntax+2) (nnodes[ntrees]) set tmpbrem[#1] 1000000 ; stop 
end 

set 5 0 ;    
loop 0 ntax if ( 'inclist[#1]' ) set 5 ++ ; end stop 
if ( '5' < 4 ) 
     lquote[ ; 
     quote * Sorry, cannot calculate support &10for only '5' taxa; 
     lquote ] ; 
     proc/ ; end 


set whichtree ntrees ; 
tsave/ ; 
tsave * refbrem.tre ; 
save 'whichtree' ; 
tsave/; 
tsave * tempbrem.tre ; 
save 'whichtree' ; 
loop (ntax+2) nnodes['whichtree'] set tmpbrem[#1] 1000000 ; stop 
if ( !'overimpose' ) 
     ttag - ; 
     nak = ; 
     ttag * 'whichtree' ; 
end 
set 0 ntrees ; 
set maxsupis score['whichtree'] ; 
keep '0' ; 
tread ( ... ) ; 
set maxsupis score['whichtree'] - 'maxsupis' ; 
save ; 
keep '0' ; 
tsave/; 

goto [ %0 EXIT_CODE ; 
warn - ; 
report- ; 

if ( ( !'domonosch') && ( 'avermin == 0 ) && 
      'useconst' && ( 'numsearches' > 1 ) ) 
    set avermin 1 ; 
    sil - buff ; 
    lquote [ ; 
    quote &10&10NOTE: requested average scores, but it makes no sense ; 
    quote when referring length to previous tree(s)., will use minimum.; 
    quote &10; 
    sil = buff ; 
end 

/*****  BEGIN CALCULATIONS WITH SUBOPTIMAL TEES     *****/
if ( 'savesub' )   
  report= ; 
  set numincs 'maxsub' / 'scorinc' ; 
  if ( 'numincs' < 1 ) set numincs 1 ; end 
  set nowatsub 'scorinc' ; 
  loop 1 'numincs' 
    sub 'nowatsub' ; 
    hold + 'maxsave' ; 
    bb = fillonly tbr ; 
    set nowatsub += 'scorinc' ; 
    if ( ( 'nowatsub' + 'scorinc' ) > 'maxsub' ) 
        set nowatsub 'maxsave' ; 
        end 
  stop 
  if ( 'alltrees' ) 
    p tempbrem.tre ; 
    uniq ; 
    coll temp ; 
    set tmpbrem bremlist / { floaters } ; 
  else 
   set thereftree (ntrees+1) ; 
   p refbrem.tre ; 
   report- ; 
   set 2 0 ; 
   set 3 nnodes['thereftree'] - ( ntax+2 ) ; 
   loop ( ntax+2) nnodes['thereftree'] 
      progress '2' '3' Checking suboptimal groups ('2' of '3'); 
      chkbreak 1 ; 
      set 2 ++ ; 
      keep 'thereftree' ; 
      p refbrem.tre ; 
      force + [ @'thereftree' #1 ({floaters}) ] ; 
      set beswith 100000000 ; 
      set beswithout 100000000 ; 
      loop 0 ntrees 
         set 0 score[#2] ; 
         if ( ( '0' >= 'beswith' ) && ( '0' >= 'beswithout' ) ) continue ; end 
         set 1 mono[#2] ; 
         if ( ( '1' == 1 ) && ( '0' < 'beswith' ) ) 
            set beswith '0' ; end 
         if ( ( '1' == 0 ) && ( '0' < 'beswithout' ) ) 
            set beswithout '0' ; end 
         stop 
      if ( 'tmpbrem[#1]' > ( 'beswithout' - 'beswith' ) ) 
         set tmpbrem[#1] ( 'beswithout' - 'beswith' ) ; end
      stop 
   progress/; 
   report= ; 
   end 
   sub 0 ; 
end  /*  end of calculations for suboptimal searches    */

report- ; 

/*****  BEGIN CALCULATIONS USING CONSTRAINTS   *****/
if ( 'useconst' )
    sub 0 ; 
    if ( 'timedsch' ) 
        macfloat 0 ; 
        timeout 0:'schtime':0 ; 
        macfloat 6 ; 
        end 
    silent = all ; 
    if ( !'usersch' ) 
       set schalgs $xmu = noke rep'danumreps'; 
       if ( 'secsearch' ) set tmpstring $ $schalgs css rss autoc1 ; 
       else set tmpstring $ $schalgs nocss norss noaut ; end 
       set schalgs $ $tmpstring ; 
       if ( 'dorat' ) set tmpstring $ $schalgs rat'ratreps'; 
       else set tmpstring $ $schalgs norat; end 
       set schalgs $ $tmpstring ; 
       if ( 'dodrift' ) set tmpstring $ $schalgs drif'driftreps'; 
       else set tmpstring $ $schalgs nodri; end 
       set schalgs $ $tmpstring ; 
       if ( 'dofuse' ) set tmpstring $ $schalgs fuse5; 
       else set tmpstring $ $schalgs nofu ; end 
       set schalgs $ $tmpstring ; 
       end 
    keep 0 ; 
    p refbrem.tre ; 
    set 0 nnodes[0 ] ; 
    set 1 0 ; 
    set 2 0 ; 
    if ( 'alltrees' || 'allnods' ) 
      loop (ntax+2 ) '0' 
        if ( ( 'tmpbrem[#1]' < 'maxsupis' ) &&
             ( 'tmpbrem[#1]' > 'maxsub' ) ) continue ; end 
        set 1 += 'numsearches' ; 
        stop 
    else 
       set 1 'numsearches' ; 
    end 
    loop (ntax+2 ) '0' 
      if ( ( 'tmpbrem[#1]' < 'maxsupis' ) &&
           ( 'tmpbrem[#1]' > 'maxsub' ) ) continue ; end 
      if ( ( !'alltrees' ) && ( !'allnods' ) && ( #1 != 'whichnod' ) ) 
           continue ; end 
      if ( 'avermin' == 1 )      /*  i.e. use minimum   */
         set beswith 10000000 ; 
         set beswithout 10000000 ; 
      else                       /*  i.e. use average   */
         set beswith 0 ; 
         set beswithout 0 ; 
      end 
      if ( !'domonosch' ) 
         if ( 'avermin' == 1 ) set beswith 'referscore' ; 
         else set beswith 'referscore' * 'numsearches' ; end 
      end
      loop 1 'numsearches' 
        set 2 ++ ; 
        keep 0 ;  
        p refbrem.tre ; 
        force - [ @0 #1 ({floaters})] ; 
        const= ; 
        goto [ %0 EXIT_CODE ; 
        progress '2' '1' Constrained search '2' of '1'... ; 
        chkbreak 1 ; 
        rseed * ; 
        $schalgs ;     
        set 0 score[0] ; 
        if ( ( 'avermin' == 1 ) && ( 'beswithout' > '0' ) ) 
           set beswithout '0' ; end
        if ( 'avermin' == 0 ) set beswithout += '0' ; end 
        if ( 'domonosch' ) 
          keep 0 ; 
          p refbrem.tre ; 
          force + [ @0 #1 ({floaters})] ; 
          const = ; 
          $schalgs ; 
          set 0 score[0] ; 
          if ( ( 'avermin' == 1 ) && ( 'beswith' > '0' ) ) 
             set beswith '0' ; end
          if ( 'avermin' == 0 ) set beswith += '0' ; end 
        end 
        stop 
      if ( 'avermin' == 0 ) 
           set supis ( ( 'beswithout' - 'beswith' ) / 'numsearches' ) ; 
      else set supis ( 'beswithout' - 'beswith' ) ; end 
      if ( 'supis' < 'tmpbrem[#1]' ) set tmpbrem[#1] 'supis' ; end 
      stop 
progress/; 
const = ; 
end   /* end of calculations for constrained searches  */


/********  WRITE LABELS TO TARGET TREE  **************/
keep 0 ; 
p tempbrem.tre ; 
if ( 'piweisoff' && 'avermin' ) macfloat 0 ; 
else macfloat 2 ; end 
loop (ntax+2) nnodes[0] 
      if ( ( !'alltrees' ) && (!'allnods' ) && ( #1 != 'whichnod' ) ) 
           continue ; end 
      if ( 'overimpose' ) ttag +#1 /; end 
      if ( 'tmpbrem[#1]' >= 'maxsupis' ) 
        ttag +#1 ???; continue ; end 
      if ( 'tmpbrem[#1]' < 0 ) 
           ttag +#1 ['tmpbrem[#1]']; 
      else ttag +#1 'tmpbrem[#1]'; end 
stop 
const - ; 
force - ; 
macfloat 6 ; 
rseed 'olrseed' ; 


/*****  RE-READ ORIGINAL SET OF TREES  *************/
keep 0 ; 
p tempbrem.tre ; 
set 0 ( ntrees - 1 ) ; 
tc 1.'0' ; 


/**********  SHOW SETTINGS AND TREE (SAVING IT, IF SO REQUESTED) *******/
macfloat 0 ;
sil - all ;  
lquote [ ; 
quote &10&10SETTINGS FOR CALCULATION OF BREMER SUPPORTS: ; 
if ( 'savesub' ) 
   sil = all ; 
   if ( !'piweisoff' ) macfloat 3 ; end 
   sil - all ; 
   quote &32  Searching suboptimal trees, with score up to 'maxsub' worse than ; 
   sil = all ; macfloat 0 ; sil - all ; 
   quote &32     best (in 'numincs' searches, each 'scorinc' worse than previous); 
end 

if ( 'useconst' ) 
   quote &32  Searching with constraints, 'numsearches' times (each with ; 
   if ( !'usersch' ) 
      lquote = ; 
      quote &32     'danumreps' replications; 
      if ( 'secsearch' ) quote , sectorial search; else quote , no sectorial search; end 
      if ( 'dorat' ) quote , 'ratreps' ratchet iterations; else quote , no ratchet; end 
      lquote - ; quote ,&10; lquote= ; 
      if ( 'dodrift' ) quote &32     'driftreps' drifting cycles; else quote &32     no drifting; end 
      if ( 'dofuse' ) 
          quote , fusing results from the 'danumreps' replications) ; 
      else 
          quote , no fusing); 
      end 
      lquote - ; 
   else 
      quote &32     user-defined search ($schalgs) ; 
   end 
   lquote - ; 
    quote &10 ; 
   if ( 'numsearches' > 1 ) 
     if ( 'avermin' == 0 ) 
       quote &32  Calculating average scores (with and without constraints) ; 
     else 
       quote &32  Using the best scores (with and without constraints) ; 
     end 
   end 
   if ( 'useconst' ) 
       if ( 'domonosch' ) 
            quote &32  Best score with a group calculated constraining group for monophyly ; 
       else quote &32  Best score with a group taken from reference tree(s) ; 
       end 
   end 
   if ( 'alltrees' ) 
      quote &32  Calculating supports on consensus of shortest trees in memory ; 
   else 
    if ( 'allnods' ) 
       quote &32  Calculating supports for groups of tree 'whichtreewas' ; 
    else 
       quote &32  Calculating support only for node 'whichnod' of tree 'whichtreewas' ; 
    end 
   end
end 

lquote - ; lquote [ ; 
set 0 time ; 
quote TOTAL TIME USED: '0' secs.; 
quote &10 ; 
lquote ] ; 
warn= ; 
report= ; 

if ( 'saveemf' ) log & $emfname ; end 
ttag ; 
if ( 'saveemf' ) log /& ; end 

proc/ ;
        
/****  This is used if routine is interrupted... ****/ 
label EXIT_CODE ; 
keep 0 ; 
p tempbrem.tre ; 
set 0 ( ntrees - 1 ) ; 
tc 1.'0' ; 
warn= ; 
report= ; 
silent - all ; 
sub 0 ; 
const - ; 
lquote [ ; 
if ( !windows ) 
    quote EXECUTION OF SCRIPT INTERRUPTED... RESETTING PROGRAM STATUS ... ; 
else 
    quote *SCRIPT INTERRUPTED... ; 
end 

proc/;