#
# Macros to automatically run MENDEL, MERLIN or SUPERLINK
#
# print lines from file in range /sta/, /end/ a la Awk
#
eval (define (print-one-range file sta end)  \
 (begin \
  (define (print s) (begin (display s) (newline))) \
  (define dat (open-input-file file))  \
  (newline) \
  (let loop ((lin (read-line dat)) (p 0))    \
   (begin \
    (if (and (< p 2) (string? lin))     \
     (begin  \
      (if (substring? sta lin) (set! p 1)) \
      (if (> p 0) (print lin)) \
      (if (substring? end lin) (set! p 2)) \
      (loop (read-line dat) p))))) \
  (close-input-port dat) (display "")))
# 
# mendelvc <quantitative trait> <covariate1> ... <covariateN>
#   multipoint univariate variance components QTL linkage analysis
#   Calls mendel
#   note the loop over the covariates (argument 2 onwards) "{ Grand %+2 }"
#   which will give the intercept only (Grand) if there are no covariates,
#   and the Scheme call to perform QTL linkage only if there is
#   more than one marker locus (MENDEL crashes if only a single marker is present)
#
macro mendelvc
 write loc mendel %%.lom new
 write map mendel %%.map new
 write mendel %%.pem new
 out %%.con
 echo SUMMARY_FILE = mendelvc.sum
 echo OUTPUT_FILE = %%.out
 echo DEFINITION_FILE = %%.lom
 echo PEDIGREE_FILE = %%.pem
 echo ANALYSIS_OPTION = Polygenic_qtl
 echo QUANTITATIVE_TRAIT = %1
 echo PREDICTOR = { Grand %+2 } :: %1
 echo COVARIANCE_CLASS = Additive
 echo COVARIANCE_CLASS = Environmental
 eval (if (> (length (ls 'm)) 1) \
         (display "COVARIANCE_CLASS = Qtl") \
         (display "! NOTE: No active markers"))
 out
 $ mendel -c %%.con
 file print mendelvc.sum
 eval (print-one-range "%%.out"  "SUMMARY FOR MEAN PARAMETERS" "CHECK THE")
 file delete %%.con %%.lom %%.map %%.out %%.pem
;;;;
#
# merlin <merlin_args>
#   call MERLIN to analyse currently active loci
#   Calls merlin
# 
macro merlin
 write loc merlin %%.dat
 write map merlin %%.map
 write merlin %%.ped
 $ merlin %0 -d %%.dat -m %%.map -p %%.ped
 file delete %%.dat %%.map %%.ped
;;;;
#
# superlink
#   call SUPERLINK to analyse currently active loci using
#   the "Super-Genehunter" style analysis
#   Calls superlink
# 
macro superlink
 wri loc sup %%.dat
 wri ppd %%.ppd
 $ superlink %%.dat %%.ppd
 file delete %%.dat %%.ppd
;;;;
#
# draw <pedigree> [<trait> [<genotype]]
#   automatically view a pedigree
#   call dot to create a marriage node drawing of a pedigree
#   Calls dot, gv
#
macro draw
 select pedigree %1
 write dot %%.dot %2 %3
 $ dot -Tps -o %%.ps %%.dot
 $ gv --scale=-2 %%.ps
 file delete %%.dot %%.ps
 unselect
;;;;