/****************************************************************************
 *                                                                          *
 *     Loki - Programs for genetic analysis of complex traits using MCMC    *
 *                                                                          *
 *                      Simon Heath - MSKCC                                 *
 *                                                                          *
 *                          August 2000                                     *
 *                                                                          *
 * loki_output.c:                                                           *
 *                                                                          *
 * Routines for sample output                                               *
 *                                                                          *
 * Copyright (C) Simon C. Heath 1997, 2000, 2002                            *
 * This is free software.  You can distribute it and/or modify it           *
 * under the terms of the Modified BSD license, see the file COPYING        *
 *                                                                          *
 ****************************************************************************/
/* add routines to output QTL vectors for stat5 EWD */

#include <stdlib.h>
#ifdef USE_DMALLOC
#include <dmalloc.h>
#endif
#include <math.h>
#include <stdio.h>

int n_cov_columns;

#include "utils.h"
#include "loki.h"
#include "loki_peel.h"
#include "version.h"
#include "loki_ibd.h"
#include "calc_var_locus.h"
#include "sample_rand.h"
#include "sample_nu.h"
#include "mat_utils.h"
#include "loki_output.h"

static double *tot_gen_var;

void Output_Sample_Aff(int lp,double *ss,double *ss2,int *perm,FILE *fptr)
{
	int k,k1,k2,k3;
	
	(void)fprintf(fptr,"%d ",lp);
	for(k1=0;k1<n_links;k1++) {
		get_locuslist(perm,k1,&k2,1);
		if(analysis&NULL_ANALYSIS) {
			for(k3=0;k3<k2;k3++) if(perm[k3]==0) break;
			if(k3==k2) continue;
		}
		gnu_qsort(perm,(size_t)k2,(size_t)sizeof(int),cmp_loci_pos);
		for(k3=0;k3<k2;k3++) {
			k=perm[k3];
			if((analysis&NULL_ANALYSIS) && k) continue;
			(void)fprintf(fptr,"%g ",ss[k]);
			if(ss2) (void)fprintf(fptr,"%g ",ss2[k]);
		}
	}
	(void)fputc('\n',fptr);
	(void)fflush(fptr);
}

void Output_BV(FILE *fptr) 
{
	int i,j,mx;
	double mu,s,z,z1;
	
	mx=(int)get_max_idlen();
	z=bv_iter?(double)bv_iter:1.0;
	z1=z>1.0?z-1.0:1.0;
	fputs("ID ",fptr);
	for(i=3;i<mx;i++) fputc(' ',fptr);
	fputs("         BV           SD(BV)\n",fptr);
	for(i=0;i<ped_size;i++) {
		j=(int)print_orig_id(fptr,i+1);
		for(;j<=mx;j++) fputc(' ',fptr);
		mu=id_array[i].bvsum[0]/z;
		s=(id_array[i].bvsum2[0]-z*mu*mu)/z1;
		fprintf(fptr," %13.8f %13.8f\n",mu,sqrt(s));
	}
}

/* Version 2.1 output routine */
static void OutputSample_1(FILE *fptr,int lp)
{
	int i,j,k,l,type,nq,nq1,grp;

#ifdef DEBUG
	int mn,mn1;
	double z;
#endif
	
	nq=nq1=0;
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag)	{
		nq++;
		if(tlocus[l].locus.flag&TL_LINKED) nq1++;
	}
	(void)fprintf(fptr,"%d %d %d %g %g %g",lp,nq,nq1,grand_mean[0],residual_var[0],tau[0]);
	if(use_student_t) (void)fprintf(fptr," %g",res_nu);
	if(polygenic_flag) (void)fprintf(fptr," %g",additive_var[0]);
	for(i=0;i<n_random;i++) (void)fprintf(fptr," %g",c_var[i][0]);
	if(output_type==OUTPUT_TYPE_ORIGINAL) (void)fprintf(fptr," %d %d",n_cov_columns,n_genetic_groups);
	for(i=0;i<models[0].n_terms;i++) if(models[0].term[i].out_flag) {
		type=models[0].term[i].vars[0].type;
		if(type&ST_ID) continue;
		k=models[0].term[i].vars[0].var_index;
		if(type&ST_MARKER) {
			for(grp=0;grp<n_genetic_groups;grp++)
				for(j=0;j<marker[k].locus.n_alleles-1;j++) (void)fprintf(fptr," %g",marker[k].locus.freq[grp][j]);
		}
		if(!(type&ST_TRAITLOCUS))
		  for(j=0;j<models[0].term[i].df;j++) (void)fprintf(fptr," %g",models[0].term[i].eff[j]);
		if(type&ST_MARKER) {
			calc_var_locus(k);
			(void)fprintf(fptr," %g",sqrt(marker[k].locus.variance[0]));
		}
	}
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
		if(tlocus[l].locus.flag&TL_LINKED) {
			(void)fprintf(fptr," %d",tlocus[l].locus.link_group+1);
			for(k=0;k<=sex_map;k++) (void)fprintf(fptr," %g",tlocus[l].locus.pos[1-k]);
		} else {
			(void)fputs(" 0",fptr);
			if(output_type==OUTPUT_TYPE_ORIGINAL) for(k=0;k<=sex_map;k++) (void)fputs(" -1",fptr);
		}
		k=tlocus[l].locus.n_alleles;
		for(grp=0;grp<n_genetic_groups;grp++)
		  for(j=0;j<k-1;j++) (void)fprintf(fptr," %g",tlocus[l].locus.freq[grp][j]);
		k=k*(k+1)/2-1;
		for(j=0;j<k;j++) (void)fprintf(fptr," %g",tlocus[l].eff[0][j]);
		(void)fprintf(fptr," %g",sqrt(tlocus[l].locus.variance[0]));
	}
	(void)fputc('\n',fptr);
#ifdef DEBUG
	if((*debug_level)&2) {
		mn=mn1=0;
		for(i=0;i<N_MOVE_STATS;i++) {
			z=move_stats[i].n?(double)move_stats[i].success/(double)move_stats[i].n:0.0;
			(void)fputc(i?' ':'[',fptr);
			(void)fprintf(fptr," %g",z);
			if(i<4) {
				mn+=move_stats[i].success;
				mn1+=move_stats[i].n;
			}
		}
		z=mn1?(double)mn/(double)mn1:0.0;
		(void)fprintf(fptr," %g]\n",z);
	}
#endif
	(void)fflush(fptr);
}

/* Version 2.2 output routine */
static void OutputSample_2(FILE *fptr,int lp)
{
	int i,j,k,l,type,grp;
	
#ifdef DEBUG
	int mn,mn1;
	double z;
#endif

	tot_gen_var[0]=0.0;
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
		tot_gen_var[0]+=tlocus[l].locus.variance[0];
	}
	if(polygenic_flag) tot_gen_var[0]+=additive_var[0];
	for(i=0;i<models[0].n_terms;i++) {
		k=models[0].term[i].vars[0].var_index;
		type=models[0].term[i].vars[0].type;
		if(type&ST_MARKER) {
			calc_var_locus(k);
			tot_gen_var[0]+=marker[k].locus.variance[0];
		}
	}
	(void)fprintf(fptr,"%d %g %g",lp,grand_mean[0],residual_var[0]);
	if(use_student_t) (void)fprintf(fptr," %g",res_nu);
	if(polygenic_flag) (void)fprintf(fptr," %g",additive_var[0]);
	for(i=0;i<n_random;i++) (void)fprintf(fptr," %g",c_var[i][0]);
	for(i=0;i<models[0].n_terms;i++) if(models[0].term[i].out_flag) {
		type=models[0].term[i].vars[0].type;
		if(type&ST_ID) continue;
		k=models[0].term[i].vars[0].var_index;
		if(type&ST_MARKER) {
			for(grp=0;grp<n_genetic_groups;grp++)
				for(j=0;j<marker[k].locus.n_alleles-1;j++) (void)fprintf(fptr," %g",marker[k].locus.freq[grp][j]);
		}
		if(!(type&ST_TRAITLOCUS))
		  for(j=0;j<models[0].term[i].df;j++) (void)fprintf(fptr," %g",models[0].term[i].eff[j]);
		if(type&ST_MARKER) {
			(void)fprintf(fptr," %g",sqrt(marker[k].locus.variance[0]));
		}
	}
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
		if(tlocus[l].locus.flag&TL_LINKED) {
			(void)fprintf(fptr," %d",tlocus[l].locus.link_group+1);
			for(k=0;k<=sex_map;k++) (void)fprintf(fptr," %g",tlocus[l].locus.pos[1-k]);
		} else (void)fputs(" 0",fptr);
		k=tlocus[l].locus.n_alleles;
		for(grp=0;grp<n_genetic_groups;grp++)
		  for(j=0;j<k-1;j++) (void)fprintf(fptr," %g",tlocus[l].locus.freq[grp][j]);
		k=k*(k+1)/2-1;
		for(j=0;j<k;j++) (void)fprintf(fptr," %g",tlocus[l].eff[0][j]);
		(void)fprintf(fptr," %g",sqrt(tlocus[l].locus.variance[0]));
	}
	(void)fputc('\n',fptr);
#ifdef DEBUG
	if((*debug_level)&2) {
		mn=mn1=0;
		for(i=0;i<N_MOVE_STATS;i++) {
			z=move_stats[i].n?(double)move_stats[i].success/(double)move_stats[i].n:0.0;
			(void)fputc(i?' ':'[',fptr);
			(void)fprintf(fptr,"%g",z);
			if(i<4) {
				mn+=move_stats[i].success;
				mn1+=move_stats[i].n;
			}
		}
		z=mn1?(double)mn/(double)mn1:0.0;
		(void)fprintf(fptr," %g]\n",z);
	}
#endif
	(void)fflush(fptr);
}

/* Version 2.3 output routine */
static void OutputSample_3(FILE *fptr,int lp)
{
	int i,j,k,l,type,grp,mod,mod1;

#ifdef DEBUG
	int mn,mn1;
	double z;
#endif

	(void)fprintf(fptr,"%d",lp);
	for(j=mod=0;mod<n_models;mod++) {
		for(k=0;k<mod;k++) (void)fprintf(fptr," %g",residual_var[j++]);
		if(res_var_set[mod]!=1) (void)fprintf(fptr," %g",residual_var[j]);
		j++;
		for(i=0;i<models[mod].n_terms;i++) {
			k=models[mod].term[i].vars[0].var_index;
			type=models[mod].term[i].vars[0].type;
			if(type&ST_MARKER) calc_var_locus(k);
		}
	}
	k=n_models*(n_models+1)/2;
	for(i=0;i<k;i++) tot_gen_var[i]=0.0;
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
		for(i=0;i<k;i++) tot_gen_var[i]+=tlocus[l].locus.variance[i];
	}
	if(polygenic_flag) for(i=0;i<k;i++) tot_gen_var[i]+=additive_var[i];
	for(j=0;j<n_markers;j++) if(marker[j].locus.variance) for(i=0;i<k;i++) tot_gen_var[i]+=marker[j].locus.variance[i];
	if(use_student_t) (void)fprintf(fptr," %g",res_nu);
	for(i=0;i<k;i++) (void)fprintf(fptr," %g",tot_gen_var[i]);
	if(polygenic_flag) {
		for(mod=0;mod<n_models;mod++) if(models[mod].polygenic_flag) {
			for(mod1=0;mod1<mod;mod1++) if(models[mod1].polygenic_flag) (void)fprintf(fptr," %g",BB(additive_var,mod,mod1));
			if(add_var_set[mod]!=1) (void)fprintf(fptr," %g",BB(additive_var,mod,mod));
		}
	}
	for(i=0;i<n_random;i++) {
		for(mod=0;mod<n_models;mod++) if(rand_flag[mod]&(1<<i)) {
			for(mod1=0;mod1<=mod;mod1++) if(rand_flag[mod1]&(1<<i)) (void)fprintf(fptr," %g",BB(c_var[i],mod,mod1));
		}
	}
	for(mod=0;mod<n_models;mod++) {
		if(grand_mean_set[mod]!=1) (void)fprintf(fptr," %g",grand_mean[mod]);
		for(i=0;i<models[mod].n_terms;i++) if(models[mod].term[i].out_flag) {
			type=models[mod].term[i].vars[0].type;
			if(type&ST_ID) continue;
			k=models[mod].term[i].vars[0].var_index;
			if(!(type&(ST_MARKER|ST_TRAITLOCUS))) {
				for(j=0;j<models[mod].term[i].df;j++) (void)fprintf(fptr," %g",models[mod].term[i].eff[j]);
			}
		}
	}
	for(k=0;k<n_markers;k++) if(marker[k].locus.variance) {
		for(grp=0;grp<n_genetic_groups;grp++)
		  for(j=0;j<marker[k].locus.n_alleles-1;j++) (void)fprintf(fptr," %g",marker[k].locus.freq[grp][j]);
		for(mod=0;mod<n_models;mod++) if(marker[k].mterm[mod]) {
			for(j=0;j<marker[k].mterm[mod]->df;j++) (void)fprintf(fptr," %g",marker[k].mterm[mod]->eff[j]);
		}
		for(mod=0;mod<n_models;mod++) if(marker[k].mterm[mod]) 
		  for(mod1=0;mod1<=mod;mod1++) if(marker[k].mterm[mod1]) (void)fprintf(fptr," %g",sqrt(BB(marker[k].locus.variance,mod,mod1)));
	}
	for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
		if(tlocus[l].locus.flag&TL_LINKED) {
			(void)fprintf(fptr," %d",tlocus[l].locus.link_group+1);
			for(k=0;k<=sex_map;k++) (void)fprintf(fptr," %g",tlocus[l].locus.pos[1-k]);
		} else (void)fputs(" 0",fptr);
		k=tlocus[l].locus.n_alleles;
		for(grp=0;grp<n_genetic_groups;grp++)
		  for(j=0;j<k-1;j++) (void)fprintf(fptr," %g",tlocus[l].locus.freq[grp][j]);
		k=k*(k+1)/2-1;
		for(mod=0;mod<n_models;mod++) if(tlocus[l].model_flag&(1<<mod))
		  for(j=0;j<k;j++) (void)fprintf(fptr," %g",tlocus[l].eff[mod][j]);
		for(mod=0;mod<n_models;mod++) if(tlocus[l].model_flag&(1<<mod))
		  for(mod1=0;mod1<=mod;mod1++) if(tlocus[l].model_flag&(1<<mod1)) (void)fprintf(fptr," %g",sqrt(BB(tlocus[l].locus.variance,mod,mod1)));
	}
	(void)fputc('\n',fptr);
#ifdef DEBUG
	if((*debug_level)&2) {
		mn=mn1=0;
		for(i=0;i<N_MOVE_STATS;i++) {
			z=move_stats[i].n?(double)move_stats[i].success/(double)move_stats[i].n:0.0;
			(void)fputc(i?' ':'[',fptr);
			(void)fprintf(fptr,"%g",z);
			if(i<4) {
				mn+=move_stats[i].success;
				mn1+=move_stats[i].n;
			}
		}
		z=mn1?(double)mn/(double)mn1:0.0;
		(void)fprintf(fptr," %g]\n",z);
	}
#endif
	(void)fflush(fptr);
}

#ifdef FUNC_NAME
#undef FUNC_NAME
#endif
#define FUNC_NAME "OutputSample"
void OutputSample(FILE *fptr,int lp)
{
	if(!fptr) {
		if(tot_gen_var) {
			free(tot_gen_var);
			tot_gen_var=0;
		}
		return;
	}
	if(!tot_gen_var && n_models) {
		if(!(tot_gen_var=malloc(sizeof(double)*n_models*(n_models+1)/2))) ABT_FUNC(MMsg);
	}
	switch(output_type) {
	 case OUTPUT_TYPE_ORIGINAL:
	 case OUTPUT_VERSION_2_1: 
		OutputSample_1(fptr,lp);
		break;
	 case OUTPUT_VERSION_2_2:
		OutputSample_2(fptr,lp);
	 case OUTPUT_VERSION_2_3:
		OutputSample_3(fptr,lp);
		break;
	}
}

void OutputFreqHeader(FILE *fptr,loki_time *lt)
{
	int i,j;
	
	(void)fprintf(fptr,"Created by %s: %s",LOKI_NAME,ctime(&lt->start_time));
	for(i=0;i<n_markers;i++) {
		(void)fprintf(fptr,"%d ",i);
		print_marker_name(fptr,i);
		(void)fputc(':',fptr);
		for(j=0;j<marker[i].locus.n_alleles-1;j++) {
			(void)fputc(' ',fptr);
			print_allele_type1(fptr,i,j);
		}
		(void)fputs(" (",fptr);
		print_allele_type1(fptr,i,j);
		(void)fputs(")\n",fptr);
	}
	(void)fprintf(fptr,"No. genetic groups: %d\n",n_genetic_groups);
	if(est_aff_freq) (void)fputs("Estimating allele frequencies amongst affecteds\n",fptr);
	(void)fputs("--------------------\n",fptr);
	(void)fflush(fptr);
}

void OutputFreq(FILE *fptr,int lp)
{
	int i,j,k;
	
	(void)fprintf(fptr,"%d ",lp);
	for(i=0;i<n_markers;i++) {
		for(j=0;j<marker[i].locus.n_alleles-1;j++) {
			for(k=0;k<n_genetic_groups;k++) (void)fprintf(fptr,"%g ",marker[i].locus.freq[k][j]);
			if(est_aff_freq) {
				(void)fprintf(fptr,"%g ",marker[i].locus.aff_freq[j]);
			}
		}
	}
	(void)fputc('\n',fptr);
	(void)fflush(fptr);
}

#ifdef FUNC_NAME
#undef FUNC_NAME
#endif
#define FUNC_NAME "OutputHeader"
void OutputHeader(FILE *fptr,int si,loki_time *lt)
{
	int i,j,k,k1,k2,k3,type,n_all,grp,*perm=0,mod,mod1;
	struct Variable *var,*group_var=0;
	
	for(i=0;i<n_id_records;i++) if(id_variable[i].type&ST_GROUP) {
		group_var=id_variable+i;
		break;
	}
	(void)fprintf(fptr,"Created by %s: %s",LOKI_NAME,ctime(&lt->start_time));
	if(!analysis) {
		(void)fprintf(fptr,"Output format: %d\n",output_type);
		for(mod=0;mod<n_models;mod++) {
			type=models[mod].var.type;
			if(type) {
				if(n_models>1) {
					if(!mod) (void)fputs("Models: \n  ",fptr);
					else (void)fputs("  ",fptr);
				} else (void)fputs("Model: ",fptr);
				i=models[mod].var.var_index;
				var=(type&ST_CONSTANT)?id_variable+i:nonid_variable+i;
				(void)fputs(var->name,fptr);
				if(var->index) (void)fprintf(fptr,"(%d)",var->index);
				(void)fputs(" = ",fptr);
				for(i=0;i<models[mod].n_terms;i++) {
					type=models[mod].term[i].vars[0].type;
					if(i) (void)fputs(" + ",fptr);
					if(type&ST_TRAITLOCUS) (void)fputs("QTL",fptr);
					else if(type&ST_ID) (void)fputs("ID\'",fptr);
					else {
						j=models[mod].term[i].vars[0].var_index;
						if(type&ST_MARKER) {
							print_marker_name(fptr,j);
						} else {
							var=(type&ST_CONSTANT)?id_variable+j:nonid_variable+j;
							(void)fputs(var->name,fptr);
							if(var->index) (void)fprintf(fptr,"(%d)",var->index);
							if(type&ST_RANDOM) (void)fputc('\'',fptr);
						}
					}
				}
				(void)fputc('\n',fptr);
			}
		}
	}
	if(!(analysis&NULL_ANALYSIS)) {
		if(n_links) {
			(void)fprintf(fptr,"Input map function: %s\nOutput map function: Haldane\n",map_function?"Kosambi":"Haldane");
			if((n_tloci+n_markers) && !(perm=malloc(sizeof(int)*(n_tloci+n_markers)))) ABT_FUNC(MMsg);
			(void)fputs("Linkage groups:\n",fptr);
			for(i=0;i<n_links;i++) {
				(void)fprintf(fptr,"  %d: %s  Map range: ",i+1,linkage[i].name);
				for(k3=0;k3<=sex_map;k3++) (void)fprintf(fptr," (%gcM to %gcM) ",linkage[i].r1[1-k3],linkage[i].r2[1-k3]);
				(void)fputc('\n',fptr);
				if(perm) {
					get_locuslist(perm,i,&k2,1);
					gnu_qsort(perm,(size_t)k2,sizeof(int),cmp_loci_pos);
					for(k1=0;k1<k2;k1++) {
						k=perm[k1];
						if(marker[k].index) (void)fprintf(fptr,"    %s(%d) -",marker[k].name,marker[k].index);
						else (void)fprintf(fptr,"    %s -",marker[k].name);
						for(k3=0;k3<=sex_map;k3++) (void)fprintf(fptr," %g",marker[k].locus.pos[1-k3]);
						(void)fputc('\n',fptr);
					}
				}
				switch(linkage[i].ibd_est_type) {
				 case IBD_EST_DISCRETE:
					if(!linkage[i].ibd_list) ABT_FUNC("Internal error - no ibd list\n");
					(void)fprintf(fptr,"IBD Matrix estimated at position%s",linkage[i].ibd_list->idx==1?":":"s:");
					for(j=0;j<linkage[i].ibd_list->idx;j++) {
						(void)fputc(j?',':' ',fptr);
						(void)fprintf(fptr,"%g",linkage[i].ibd_list->pos[j]);
					}
					(void)fputc('\n',fptr);
					break;
				 case IBD_EST_GRID:
					if(!linkage[i].ibd_list) ABT_FUNC("Internal error - no ibd list\n");
					(void)fprintf(fptr,"IBD Matrix estimated at grid of positions from %g to %g step %g\n",
									  linkage[i].ibd_list->pos[0],linkage[i].ibd_list->pos[1],linkage[i].ibd_list->pos[2]);
					break;
				 case IBD_EST_MARKERS:
					(void)fputs("IBD Matrix estimated at all marker locations\n",fptr);
					break;
				}
			}
			if(perm) free(perm);
			(void)fputs("Total Map Length:",fptr);
			for(k3=0;k3<=sex_map;k3++) (void)fprintf(fptr," %gcM",total_maplength[1-k3]);
			(void)fputc('\n',fptr);		}
	}
	if(!analysis && models) {
		(void)fputs("Output columns:\n",fptr);
		k1=0;
		(void)fprintf(fptr,"  %d: Iteration count\n",++k1);
		if(output_type<=OUTPUT_VERSION_2_1) {
			(void)fprintf(fptr,"  %d: No. QTL's in models[0]\n",++k1);
			(void)fprintf(fptr,"  %d: No. linked QTL's\n",++k1);
		}
		if(output_type<3) {
			if(n_models>1) {
				for(mod=0;mod<n_models;mod++) (void)fprintf(fptr,"  %d: Grand mean %d\n",++k1,mod+1);
			} else (void)fprintf(fptr,"  %d: Grand mean\n",++k1);
		}
		if(n_models>1) {
			for(k=mod=0;mod<n_models;mod++) {
				for(mod1=0;mod1<mod;mod1++) {
					if(res_var_set[k++]!=1) (void)fprintf(fptr,"  %d: Residual covariance %d %d\n",++k1,mod1+1,mod+1);
				}
				if(res_var_set[k++]!=1) (void)fprintf(fptr,"  %d: Residual variance   %d\n",++k1,mod+1);
			}
		} else {
			if(res_var_set[0]!=1) (void)fprintf(fptr,"  %d: Residual variance\n",++k1);
		}
		if(use_student_t) (void)fprintf(fptr,"  %d: d.f. for student t distribution of residuals\n",++k1);
		if(output_type<=OUTPUT_VERSION_2_1) {
			if(n_models>1) {
				for(mod=0;mod<n_models;mod++) (void)fprintf(fptr,"  %d: tau %d\n",++k1,mod+1);
			} else (void)fprintf(fptr,"  %d: tau\n",++k1);
		}
		if(output_type>=OUTPUT_VERSION_2_3) {
			if(n_models>1) {
				for(mod=0;mod<n_models;mod++) {
					for(mod1=0;mod1<mod;mod1++) {
						(void)fprintf(fptr,"  %d: Total genetic covariance %d %d\n",++k1,mod1+1,mod+1);
					}
					(void)fprintf(fptr,"  %d: Total genetic variance   %d\n",++k1,mod+1);
				}
			} else {
				(void)fprintf(fptr,"  %d: Total genetic variance\n",++k1);
			}
		} 
		if(polygenic_flag) {
			if(n_models>1) {
				for(k=mod=0;mod<n_models;mod++) if(models[mod].polygenic_flag) {
					for(mod1=0;mod1<mod;mod1++) if(models[mod1].polygenic_flag) {
						if(add_var_set[k++]!=1) (void)fprintf(fptr,"  %d: Additive covariance %d %d\n",++k1,mod1+1,mod+1);
					}
					if(add_var_set[k++]!=1) (void)fprintf(fptr,"  %d: Additive variance   %d\n",++k1,mod+1);
				}
			} else {
				if(add_var_set[0]!=1) (void)fprintf(fptr,"  %d: Additive variance\n",++k1);
			}
		}
		for(j=0;j<n_random;j++) {
			var=rand_list[j];
			for(mod=0;mod<n_models;mod++) if(rand_flag[mod]&(1<<j)) {
				for(mod1=0;mod1<mod;mod1++) if(rand_flag[mod]&(1<<j)) {
					(void)fprintf(fptr,"  %d: Additional random covariance for %s",++k1,var->name);
					if(var->index) (void)fprintf(fptr,"(%d)",var->index);
					(void)fprintf(fptr," %d %d\n",mod1+1,mod+1);
				}
				(void)fprintf(fptr,"  %d: Additional random variance for %s",++k1,var->name);
				if(var->index) (void)fprintf(fptr,"(%d)",var->index);
				if(n_models>1) (void)fprintf(fptr,"   %d\n",mod+1);
				else (void)fputc('\n',fptr);
			}
		}
		if(output_type==OUTPUT_TYPE_ORIGINAL) {
			(void)fprintf(fptr,"  %d: No. covariate columns\n",++k1);
			(void)fprintf(fptr,"  %d: No. genetic groups\n",++k1);
		}
		k3=k1;
		for(mod=0;mod<n_models;mod++) {
			(void)fputs(" covariate data",fptr);
			if(n_models>1) (void)fprintf(fptr," - model %d:\n",mod+1);
			else (void)fputs(":\n",fptr);
			if(output_type==DEFAULT_OUTPUT_TYPE) {
				if(grand_mean_set[mod]!=1) (void)fprintf(fptr,"  %d: Grand mean\n",++k1);
			}
			for(i=0;i<models[mod].n_terms;i++) if(models[mod].term[i].out_flag) {
				type=models[mod].term[i].vars[0].type;
				if(type&ST_ID) continue;
				k=models[mod].term[i].vars[0].var_index;
				if(type&(ST_TRAITLOCUS|ST_MARKER)) continue;
				if(type&ST_CONSTANT) var=id_variable+k;
				else var=nonid_variable+k;
				for(j=0;j<models[mod].term[i].df;j++) {
					(void)fprintf(fptr,"  %d: %s",++k1,var->name);
					if(var->index) (void)fprintf(fptr,"(%d)",var->index);
					(void)fputs(" effect ",fptr);
					if(var->type&ST_FACTOR)	{
						if(var->rec_flag==ST_STRING) (void)fputs(var->recode[j].string,fptr);
						else (void)fprintf(fptr,"%d",var->recode[j].value);
					}
					(void)fputc('\n',fptr);
				}
			}
		}
		for(k=0;k<n_markers;k++) if(marker[k].locus.variance) {
			n_all=marker[k].locus.n_alleles;
			for(grp=0;grp<n_genetic_groups;grp++) {
				for(j=0;j<n_all-1;j++) {
					(void)fprintf(fptr,"  %d: %s",++k1,marker[k].name);
					if(marker[k].index) (void)fprintf(fptr,"(%d)",marker[k].index);
					if(group_var) {
						(void)fputs(" [Genetic group ",fptr);
						if(group_var->rec_flag==ST_STRING) (void)fputs(group_var->recode[grp].string,fptr);
						else (void)fprintf(fptr,"%d",group_var->recode[grp].value);
						(void)fputc(']',fptr);
					}
					(void)fputs(" freq. ",fptr);
					print_allele_type1(fptr,k,j);
					(void)fputc('\n',fptr);
				}
			}
			for(mod=0;mod<n_models;mod++) if(marker[k].mterm[mod]) {
				for(j=1;j<n_all;j++) for(k2=0;k2<=j;k2++)	{
					(void)fprintf(fptr,"  %d: %s",++k1,marker[k].name);
					if(marker[k].index) (void)fprintf(fptr,"(%d)",marker[k].index);
					(void)fputs(" effect ",fptr);
					print_allele_type1(fptr,k,k2);
					(void)fputc(',',fptr);
					print_allele_type1(fptr,k,j);
					if(n_models>1) (void)fprintf(fptr," for model %d ",mod+1);
					(void)fputc('\n',fptr);
				}
			}
			for(mod=0;mod<n_models;mod++) if(marker[k].mterm[mod]) 
			  for(mod1=0;mod1<=mod;mod1++) if(marker[k].mterm[mod1]) {
				  (void)fprintf(fptr,"  %d: %s",++k1,marker[k].name);
				  if(marker[k].index) (void)fprintf(fptr,"(%d)",marker[k].index);
				  (void)fputs(" size ",fptr);
				  if(n_models>1) {
					  if(mod==mod1) (void)fprintf(fptr,"model %d",mod+1);
					  else (void)fprintf(fptr,"models %d,%d\n",mod+1,mod1+1);
				  }
				  (void)fputc('\n',fptr);
			  }
		}
		if(tlocus && max_tloci) {
			(void)fputs(" QTL data blocks:\n  linkage group\n",fptr);
			if(output_type==OUTPUT_TYPE_ORIGINAL) {
 				if(sex_map) (void)fputs("  male position\n  female position\n",fptr);
				else (void)fputs("  position\n",fptr);
			} else {
 				if(sex_map) (void)fputs("  [male position if linked]\n  [female position if linked]\n",fptr);
				else (void)fputs("  [position if linked]\n",fptr);
			}
			for(grp=0;grp<n_genetic_groups;grp++) {
				if(group_var) {
					(void)fputs("  [Genetic group ",fptr);
					if(group_var->rec_flag==ST_STRING) (void)fputs(group_var->recode[grp].string,fptr);
					else (void)fprintf(fptr,"%d",group_var->recode[grp].value);
					(void)fputc(']',fptr);
				}
				(void)fputs("  freq. 1\n",fptr);
			}
			if(n_models>1) {
				(void)fputs("  Effect block:\n   Model no.\n   effect 1,2\n   effect 2,2\n",fptr);
				(void)fputs("  Size block:\n",fptr);
			} else (void)fputs("  effect 1,2\n  effect 2,2\n  size\n",fptr);
			if(min_tloci==max_tloci) (void)fprintf(fptr,"No. QTL: %d\n",max_tloci);
			else {
				(void)fprintf(fptr,"Number of QTL: %d to %d\n",min_tloci,max_tloci);
				if(tloci_mean_set) (void)fprintf(fptr,"Mean of poisson prior on QTL number: %g\n",tloci_mean);
			}
		}
		if(res_var_set[0]==1) (void)fprintf(fptr,"Residual variance: %g\n",residual_var[0]);
		if(grand_mean_set[0]==1) (void)fprintf(fptr,"Grand mean: %g\n",grand_mean[0]);
		(void)fprintf(fptr,"Tau Mode: %d\nTau Beta: %g\n",tau_mode,tau_beta[0]);
		(void)fprintf(fptr,"No. fixed output columns: %d\n",k1);
		if(no_overdominant) (void)fputs("Over-dominant QTLs not allowed\n",fptr);
		k1-=k3;
		n_cov_columns=k1;
	} else if(!(analysis&ESTIMATE_IBD)) {
		(void)fputs("Affected only ",fptr);
		if(analysis&IBD_ANALYSIS) (void)fputs("IBD Analysis\n",fptr);
		else (void)fputc('\n',fptr);
	}
	if(lm_ratio>0.0) (void)fprintf(fptr,"LM ratio: %g\n",lm_ratio);
	(void)fprintf(fptr,"SI_mode: %d\n",si);
	(void)fprintf(fptr,"No. genetic groups: %d\n",n_genetic_groups);
	if(sex_map) (void)fputs("Sex specific map\n",fptr);
	(void)fputs("--------------------\n",fptr);
	(void)fflush(fptr);
}

/* the following routines are for stat 5 EWD */
#ifdef FUNC_NAME
#undef FUNC_NAME
#endif
#define FUNC_NAME "OutputQTLvect"
void OutputQTLvect(FILE *qptr,int lp)
/* June 3, 1998 EWD - output a QTL vector to file */
/* Jan 12, 2004 EWD - update? for new structure */
{
   int l,n;
   for(l=0;l<n_tloci;l++) if(tlocus[l].locus.flag) {
      fprintf(qptr,"%d ",lp);
      if(tlocus[l].locus.flag&TL_LINKED) {
         fprintf(qptr,"%d ",tlocus[l].locus.link_group+1);
      }
      else fputs("0 ",qptr);
      for(n=0;n<ped_size;n++) fprintf(qptr,"%d ",tlocus[l].locus.gt[n]);
      fputc('\n',qptr);
   }
}

#ifdef FUNC_NAME
#undef FUNC_NAME
#endif
#define FUNC_NAME "OutputQTLHead"
void OutputQTLHead(FILE *qptr)
/* June 3, 1998 EWD - print header information for QTL genotype vector file */
{
   int i;
   fprintf(qptr," %d %d\n",ped_size,n_comp);
   for(i=0;i<ped_size;i++) {
      print_orig_id(qptr,i+1);
      fputc(' ',qptr);
   }
   fputc('\n',qptr);
   for(i=0;i<ped_size;i++) {
      fprintf(qptr,"%d ",id_array[i].comp);
   }
   fputc('\n',qptr);
}

