/****************************************************************/
/*								*/
/*     C l a s s i f i e r - S y s t e m - S i m u l a t o r	*/
/*								*/
/****************************************************************/
/*		    in Turbo-C 2.0 on IBM-AT			*/
/*	 Diplomarbeit: Copyright 1991 by Marcus Hutter 		*/
/*			Stand: 21.05.1991			*/
/****************************************************************/

/****************************************************************/
/*		R e m a r k s					*/
/****************************************************************

- It is assumed, that 'int' is 16-bit and 'long' is 32-bit signed.
- Use Compact-Model (instead of Small), if your CFS-Example is so
  large, that you get Errors about 'too many dynamic Variables'
  (Mess,CF,..) and ignore warnings about loosing digits.
- Set an Breakpoint in and compile the EXAMPLE.C-File;
  this file is included.

 ****************************************************************/
/*		D e f i n i t i o n s				*/
/****************************************************************/

/*------------------------------*/
/*	  Include-Files		*/
/*------------------------------*/

#include <time.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <conio.h>
#include <dos.h>
#include <setjmp.h>

/*------------------------------*/
/*	   Definitions		*/
/*------------------------------*/

#define	then	/**/		/* if then else			*/
#define	ESC	27		/* define the escape key	*/
#define	FALSE	0		/* FALSE for bool		*/
#define TRUE	1		/* TRUE  for bool		*/
#define	MaxInt	32767		/* Maximal signed integer	*/
#define FOREVER	for(;;)		/* infinite loop		*/
#define	PSize	sizeof(*)	/* Pointer-Size			*/
#define NScrL	50		/* # of Screen-Lines 25/43/50	*/
#define STDCOL	YELLOW		/* Standard Color		*/

#define	MMask	(TString)~(~(long)0<<SStr) /* Cond/Act-Mask	*/
#define	NonId	-1		/* Not existing Id		*/
#define	DetId	-1		/* 'CF-Id' of Detector		*/

#if TwoCond         	     	/* ifTC(x) eval. x if TwoCond	*/
  #define ifTC(x) x		/* ifnTC(x)  "   x if not "	*/
  #define ifnTC(x)
#else
  #define ifTC(x)
  #define ifnTC(x) x
#endif

/*------------------------------*/
/*	   Struct. & Types	*/
/*------------------------------*/

typedef	char		bool;	/* bool = { TRUE , FALSE }	*/
typedef unsigned char	byte;	/* 0..255			*/
typedef	signed char	sbyte;	/* -128..127			*/
typedef	signed int	index;	/* Array-Indices		*/
typedef	signed int	fixp;	/* FixPoint: Range -128 to 127  */
				/*	   : step 1/256 	*/
				/* real(constants) to FixPoint	*/
#define	FixP(x) ((fixp)(((float)x)*256))

#if FALSE /* (SStr<=sizeof(byte)*8) *//* Type of String		*/
  typedef byte TString;        	/* Test, da sonst Anz. bl”d */
#elif (SStr<=sizeof(int)*8)
  typedef int  TString;
#elif (SStr<=sizeof(long)*8)
  typedef long TString;
#else
  #error Message too long
#endif

typedef	byte	TCType;		/* CF & Cond.-Type (ev.BitArray)*/
typedef	index	TMessId;	/* Message-Index/Id		*/
typedef	index	TCFId;		/* Classifier-Index/Id		*/
typedef	index	TBidId;		/* Bid-Index/Id			*/
typedef	index	TTupId;		/* MessTupel-Index/Id		*/

typedef	struct			/* = long int for Sort & Select	*/
      {	index	Id;		/* Inedx/Id			*/
	fixp	Val; }		/* Value/Prorpability/Helpinfo	*/
	TIdVal;
#define	Id(x)	(((TIdVal*)&(x))->Id)  /* first half of long	*/
#define	Val(x)	(((TIdVal*)&(x))->Val) /* second "   of long	*/

typedef	struct			/*	   CF-Condition		*/
      {	TString	C;		/* String  ------------		*/
	TString	B;		/* #-Mask			*/
	TCType	T; }		/* Type				*/
	TCond;

typedef	struct			/*          CF-Action		*/
      {	TString	A;		/* String   ---------		*/
	TString	B;		/* #-Mask			*/
	TCType	T; }		/* Type				*/
	TAct;

typedef	struct			/*          Classifier		*/
      {	TCond	C1;		/* Condition----------		*/
  ifTC( TCond	C2; )		/* Condition 2			*/
	TAct	Act;		/* Action			*/
	fixp	Sp;		/* Specifity of Cond1 (& Cond2)	*/
	fixp	S;		/* Strength			*/
	fixp	Get;		/* Reinf + Pay from others	*/
	fixp	Pay;		/* Pay to others		*/
	fixp	Tax;		/* Taxes                        */
	fixp	PSP;		/* Bid-Sums over Reinf-Expisode	*/
	int	H; }		/* Help-Value			*/
	TCF;

typedef	struct			/*	     CF-List		*/
      { TCF	*B;		/* Begin     -------		*/
	TCF	*C;		/* Current End			*/
	TCF	*E;		/* End of List			*/
	byte	BidMode;
	byte	SuppMode;
	sbyte	BidTupSelMode;
	sbyte	BidActSelMode;
	sbyte	FireBidSelMode;
	sbyte	FireTupSelMode;
	int	MBids;
	int	MAct;
	int	MFire;
	fixp	RiskFak;
	byte	SpecPow;
	byte	RelSuppPow;
	byte	EBidPow;
	byte	ESpecPow;
	byte	ClaimMode;
	byte	DisMode;
	byte	SumMode; }
	TCFL;

typedef	struct			/*	      Message		*/
      { TString	M;      	/* String     -------		*/
	fixp	I;		/* Intensity			*/
	TCFId	CF;		/* Id of sending CF		*/
	int	H; }		/* Help-Value			*/
	TMess;

typedef	struct			/*         Message-List		*/
      {	TMess	*B;		/*	   ------------		*/
	TMess	*C;
	TMess	*E; }
	TMessL;

typedef	struct			/*             Bid		*/
      {	TCFId	CF;		/* Bidding CF  ---		*/
	fixp	BV;		/* Bid-Value			*/
	fixp	EV;		/* Effective-Bid-Value		*/
	TTupId	Tup;		/* Matching-Tuples		*/
	int	N;		/* Number of Bid-Tuples		*/
	bool	F; }		/* Fired-Flag			*/
	TBid;

typedef	struct			/*	     Bid-List		*/
      {	TBid	*B;		/*	     --------		*/
	TBid	*C;
	TBid	*E; }
	TBidL;

typedef	struct			/*	     MessTupel		*/
      {	TMessId	M1;		/* Message 1 ---------		*/
  ifTC(	TMessId	M2; )		/* Message 2			*/
	fixp	S; }		/* Support			*/
	TTup;

typedef	struct			/*	  MessTupel-List	*/
      {	TTup	*B;		/*	  --------------	*/
	TTup	*C;
	TTup	*E; }
	TTupL;

typedef	struct			/*      Classifier-System	*/
      {	TMessL	*MP;            /* Mess	=================	*/
	TMessL	*NP;		/* New-Mess			*/
	TMessL	*OP;		/* Output-Mess (from Eff)	*/
	TCFL	*CP;		/* Classifier			*/
	TCFL	*EP;		/* Effectors			*/
	TBidL	*BP;		/* Bids				*/
	TBidL	*DP;		/* Eff-Bids (same list)		*/
	TTupL	*TP; 		/* MessTupel			*/
	TTupL	*UP; }		/* Eff-MessTupel (same list)	*/
	TCS;

typedef	struct			/* 	        Statistic	*/
      {	long	CycleC;		/* Cycle-Counter---------	*/
	long	ReVal;		/* ä of Reinf			*/
	long	Str;		/* ä of CF-Stregnth		*/
	long	NCFMinStr;	/* # of CF with MinStr		*/
	long	NCFMaxStr;	/* # of CF with MaxStr		*/
	long	MCF;		/* # of NonMatched CF		*/
	long	MMess;		/* # of NonMatched Mess.	*/
	long	NCF;		/* # of CF			*/
	long	NBid;		/* # of Bids			*/
	long	NTup;		/* # of Tupels			*/
	long	NMess; }	/* # of Messages		*/
	TStat;

/*------------------------------*/
/*	Variables		*/
/*------------------------------*/

TMessL	XM,XN,XO;
TBidL	XB,XD;
extern TCFL XC,XE;
TTupL	XT,XU;
TStat	cy,ep;

TCS	XCS = { &XM,&XN,&XO,&XC,&XE,&XB,&XD,&XT,&XU };
TCS	*o = &XCS;

long	CycleC;			/* Main-Cycle-Step-Counter	*/
fixp	ReVal;			/* Reinforcement-Value		*/
TString	DetMTagC,DetMTagB;	/* Detector-Tags		*/
TString	EffMTagC,EffMTagB;	/* Effector-Tags		*/

TMess	*GMB;			/* Global-Mess-Pointer 		*/
TString	*GStr;			/* Global Strting-Pointer	*/

jmp_buf	jmp;			/* jump-label			*/
FILE	*devP,*lpt1;		/* Output-Device		*/
bool	ProtF;			/* Protocoll is Off/On		*/
bool	SStepF;			/* Single-Step-Mode		*/
bool	prM1F;			/* printmode 1 - first flag	*/
bool	SoundF = TRUE;		/* Sound On / Off		*/
byte	prMode = 3;		/* Print-Mode 0=No ... 3=All	*/

/*------------------------------*/
/*	Constants		*/
/*------------------------------*/

char	FName[14] = "CFSSIM.C";	/* File-Name (not needed)	*/

char	*ErrMess[] =		/* Error-Messages		*/
      {	"Unspecific Error",
	"Mutliplication Overflow",
	"Division Overflow",
	"Wrong Selection-Mode",
	"Select more than possible",
	"Wrong User-Classifier/Message",
	"Couldn't allocate Memory",
	"Wrong BidMode",
	"Wrong Credit-Assign-Mode",
	"pprint is call with prMode=0" };

char	*WarnMess[] =		/* Warnning-Messages		*/
      {	"Unspecific Warning",
	"Division Underflow",
	"QMax called with k=0",
	"ProbSel called with N=0",
	"Tupellist is full",
	"Bidlist is full",
	"Selection of Zero-Values",
	"BestSelMode must be positive",
	"Too many matching tuples" };

#define NWarn (sizeof(WarnMess)/sizeof(char*))
int	WC[NWarn];
int	WP[NWarn];

/*------------------------------*/
/*	Test-Variables		*/
/*------------------------------*/

/*------------------------------*/
/*	Externals		*/
/*------------------------------*/

/* Example-Specific variables and functions			*/
/* For explanation refer to Example1/2/...			*/
extern  int	StRate,DetRate,EffRate,ReRate,GenRate;
extern	int	MDetM,MEqMess,NMutate,NCFMut,NCFRepl;
extern	fixp	DefNMI,SclSel,DefDetMI,DefStr,DefStrDev;
extern	fixp	Dev1,Dev2,NMFrac,DetFrac,HeadTax,MessTax,BidTax;
extern	fixp	MaxStr,MinStr,CondSp,ActSp,NegCondP,PSPFrac;
extern	byte	NMIMode,CreditMode,BidTaxMode,PSPDisMode;
extern	byte	DelMessMode;
extern	sbyte	DelMessSelMode,MutSelMode,ReplSelMode;
extern	bool	CleanHallF,MultBidTaxF,MultMessTaxF;
extern	char	DetMessTag[],EffMessTag[],ProtDev[];
extern	char	*CFSL[],*EffSL[];
extern		InitEnv(),Detect(TMessL*,int),Effect(TMessL*);
extern		Display();
extern	fixp	Reinf();

/*------------------------------*/
/*	Forward Declarations	*/
/*------------------------------*/

extern		Menu();
extern		main();
extern	char	event();

/****************************************************************/
/*		G e n e r a l   P r o c e d u r e s		*/
/****************************************************************/

#define	Sound(h,l)						\
	{ if (SoundF) { sound(h); delay(l); nosound(); } }

/*------------------------------*/
 prf(int Col,char*fmt,...)	/* printf to dev & devP		*/
/*------------------------------*/
{ char	str[999];
  extern Error(int);
  if (Col!=0) then textcolor(Col);
  if (prMode>0) then
  { vsprintf(str,fmt,...);
    cprintf(str);
    if (ProtF) then fprintf(devP,str); }
  else Error(9);
  if (Col!=0) then textcolor(STDCOL);
}
/*------------------------------*/
	Error(n)		/* break with Error # 10+n	*/
/*------------------------------*/
{ prMode++;
  textbackground(LIGHTRED);
  prf(WHITE,"Error #%d: %s\r\n",n,ErrMess[n]);
  textbackground(BLACK); clreol();
  textbackground(LIGHTRED);
  prf(WHITE,"Press any Menu-Key, but its risky to continue !!\r\n");
  textbackground(BLACK); clreol();
  prMode--;
  Sound(500,100);
  Menu();
}
/*------------------------------*/
	Warning(n)		/* write Warning # n		*/
/*------------------------------*/
{ WC[n]++;
  if (WC[n]%((WP[n]>>2)+1)==0)	/* /4 = Warning decay-Rate	*/
  { if (prMode>0) then prf(LIGHTGRAY,
      "%d.Warning #%d: %s\r\n",WC[n],n,WarnMess[n]);
    WP[n]+=1+(WP[n]>>1);
    Sound(1000,5);
} }
/* Random-Number between 0 and n-1 */
#define	random2(n) ((int)(((long)rand()*n)>>15))

/* TRUE with Prob. p (p is fixp. !) */
#define	flip(p)	   ((p)>(rand()>>7))

/*------------------------------*/
char*	ActTime()		/* Actual Time in String	*/
/*------------------------------*/
{ char	*s;
  time_t t;			/* Actual Time			*/
  time(&t);
  s=ctime(&t);
  s[strlen(s)-1]='\0';
  return(s);
}
/*------------------------------*/
	memswap(P,Q,n)		/* swap n Bytes from P and Q	*/
/*------------------------------*/
char	*P,*Q;
{ char	h,*E=P+n;
  while(P<E) { h=*P; *P++=*Q; *Q++=h; }
}
#if SpeedF 			/* fast Fix-Point-Operations	*/
#define FPMult(x,y) (fixp)((long)(x)*(y)>>8)
#define FPDiv(x,y)  (fixp)(((long)(x)<<8)/(y))
#else
/*------------------------------*/
fixp	FPMult2(x,y)		/* Fix-Point-Mult with Test	*/
/*------------------------------*/
long	x,y;
{ long h=(x*y)>>8;
  if ((h>0?h:-h)>MaxInt) then Error(1);
  return((fixp)h);
}
/*------------------------------*/
fixp	FPDiv2(x,y)		/* Fix-Point-Division with Test	*/
/*------------------------------*/
long	x,y;
{ long h=(x<<8)/y;
  if ((h>0?h:-h)>MaxInt) then Error(2);
  if (x!=0&&h==0) then Warning(1);
  return((fixp)h);
}				/* secure Fix-Point-Operations	*/
#define	FPMult(x,y) FPMult2((long)(x),(long)(y))
#define	FPDiv(x,y) FPDiv2((long)(x),(long)(y))
#endif
/*------------------------------*/
fixp	FPPow(y,x,n)		/* Fix-Point-Pow y*x^n		*/
/*------------------------------*/
fixp y,x; byte n;
{ int i;
  for(i=0; i<n; i++) y=FPMult(y,x);
  return(y);
}
/*------------------------------*/
int	Noise(Dev)		/* Standard-Normal-Distribution	*/
/*------------------------------*  Cut at ñ4 in .5 Steps	*/
int	Dev;                    /* * deviation Dev		*/
{ static int s=8;
  byte	c;
  int	b;
  if (Dev) then
  { c=0; b=rand();
    while(b) { c+=b&1; b>>=1; }
    return(Dev*(c-(s=15-s)) >> 1); }
  else return(0);
}
/* Order-Functions must be Reflexive, that means InOrder(x,x) !	*/
/*------------------------------*/
bool	InStdOrd(x,y)		/* Standard-Order-Function	*/
/*------------------------------*/
TIdVal	x,y;
{ return(x.Val<=y.Val);
}
/*------------------------------*/
bool	InMessOrder(x,y)	/* Mess-Order-Function		*/
/*------------------------------*/
TIdVal	x,y;
{ return(GMB[x.Id].M<=GMB[y.Id].M);
}
/*------------------------------*/
bool	InStrOrder(x,y)		/* String-Order-Function	*/
/*------------------------------*/
TIdVal	x,y;
{ return(GStr[x.Id]<=GStr[y.Id]);
}
/*------------------------------*/
byte	Count1s(s)		/* Count # of 1 Bits		*/
/*------------------------------*/
TString	s;
{ byte c=0;
  while(s) { if (s&1) then c++; s>>=1; }
  return(c);
}
/*------------------------------*/
	Shuffle(A,N)		/* Shuffle N El. of A		*/
/*------------------------------*/
long	A[];
int	N;
{ index	m;
  long	h;
  while(N>1)
  { m=random2(N);
    h=A[m]; A[m]=A[--N]; A[N]=h;
} }
/*------------------------------*/
#define	QDivide()		/* Used in QMax and QSort */	\
/*------------------------------*/              \
{ d=*M;						\
  while(B<C)					\
  { if (M-B<C-M) then				\
      if (InOrder(d,h=*C)) then C--;		\
      else { *C=*B; *B++=h; }			\
    else					\
      if (InOrder(h=*B,d)) then B++;		\
      else { *B=*C; *C--=h; } }			\
  if (InOrder(d,*C)) then B--; else C++;	\
}
/*------------------------------*/
	QMax(A,N,k,InOrder)	/* k biggest El. to bottom of A	*/
/*------------------------------*/
long	A[];			/* Array of length N		*/
int	N;			/* Length of Array		*/
int	k;			/* # of El. to select		*/
bool	InOrder(long,long);	/* Order-Criterium 		*/
{ long	*B,*B2,*C,*C2;		/* Begin & End of part of A	*/
  long	*M,d;			/* Div.-Point & -Element of A	*/
  long	h;			/* help-variable for exchange	*/
  if (k==0) then { Warning(2); return; }
  B=B2=A; C=C2=A+N-1; M=C-k+1;
  FOREVER
  { QDivide();
    if (C<M)      then { B2=B; C=C2; }
    else if (C>M) then { B=B2; C2=C; }
    else break;
} }
/*------------------------------*/
	QSort(B2,C2,InOrder)	/* Sort A In-Order		*/
/*------------------------------*/
long	*B2;			/* Begin of Index-Array		*/
long	*C2;			/* End of Index-Array (B2+#El-1)*/
bool	InOrder(long,long);	/* Order-Criterium		*/
{ long	*B,*C;			/* Actual Begin & End -Pointer	*/
  long	*M,d;			/* Div.-Point & -Element of A	*/
  long	h;			/* help-variable for exchange	*/
  if (B2<C2) then
  { B=B2; C=C2; M=B+((C-B+1)>>1);
    QDivide();
    QSort(B2,B,InOrder);
    QSort(C,C2,InOrder);
} }
/* TIdVal and long are used as synonyms				*/

/*------------------------------*/
int	MaxVal(A,N)		/* Maximal Value of A		*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
{ int	i;
  int	m=A[0].Val;
  for(i=1; i<N; i++) if (A[i].Val>m) then m=A[i].Val;
}
#define	AL	   ((long*)A)	/* long synonym for A		*/

/*------------------------------*/
	ProbSelInit(A,N)	/* Init Probability-Selection 	*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
{ index	i,k;
  fixp	m=MaxVal(A,N);
  if (m<8000 && m) then
  { m=16000/m;
    for(i=0; i<N; i++) A[i].Val*=m; }
  for(k=1; k<N; k<<=1)
    for(i=0; i<N; i+=k<<1)
    { if (i+k<N) then A[i].Val+=A[i+k].Val;
      A[i].Val>>=1; }
}
/*------------------------------*/
index	ProbSel(A,N)		/* Probability-Selection 	*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
{ index	i,k=0;
  TIdVal z;
  z.Id=rand()<<1;
  z.Val=random2(A[0].Val);
  for(i=1; i<N; i<<=1);
  for(i>>=1; i!=0; i>>=1)
  { *(long*)&z<<=1;
    if (i+k<N) then
      if (z.Val<A[k+i].Val) then k+=i;
      else z.Val-=A[k+i].Val; }
  return(k);
}
/*------------------------------*/
	ProbChg(A,N,k,p)	/* Probability-Selection 	*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
index	k;			/* Change Element k		*/
fixp	p;			/* ... to Probability p		*/
{ int	i;
  for(i=1; !(i&k) && i<N; i<<=1)
  { if (i+k<N) then p+=A[i+k].Val;
    p>>=1; }
  p-=A[k].Val;
  for(; i<N; i<<=1)
  { if (k&i) then { A[k].Val+=p; k-=i; }
    p>>=1; }
  A[0].Val+=p;
}
/*------------------------------*/
	ProbSelInit2(A,N)	/* Init Probability-Selection 	*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
{ index	i,m=0;
  long	h;
  if (N==0) then Warning(3);
  for(i=1; i<N; i++) if (A[i].Val>A[m].Val) then m=i;
  h=AL[m]; AL[m]=AL[0]; AL[0]=h;
}
/*------------------------------*/
index	ProbSel2(A,N)		/* Probability-Selection 	*/
/*------------------------------*/
TIdVal	A[];			/* Elements			*/
int	N;  			/* Number of Elements		*/
{ index	k;
  while(random2(A[0].Val)>=A[k=random2(N)].Val);
  return(k);
}

/*------------------------------*/
      MultSelInit(A,N,Mode)	/* Init Selection (for k<0)	*/
/*------------------------------*/
TIdVal	A[];			/* Elements & Values		*/
int	N;  			/* Number of Elements		*/
sbyte	Mode;			/* Selection-Mode		*/
{ switch(abs(Mode))
  { case 1: break;
    case 2: ProbSelInit(A,N); break;
    case 3: QSort(A,A+N-1,InStdOrd); break;
    case 4: break;
    case 5: break;
    case 6: ProbSelInit2(A,N); break;
    default:Error(3);
} }
/*------------------------------*/
	Select(A,NP,B,k,Mode)	/* Select k of N Elements	*/
/*------------------------------*/
TIdVal	A[];			/* Elements & Values		*/
int	*NP;  			/* Number of Elements		*/
index	B[];			/* Selected k Elements		*/
int	k;			/* Selection-Mode		*/
sbyte	Mode;			/* >0:different; <0:with repeat	*/
{ index	i,h,m,m2;
  int	an;
  int	N=*NP;
  bool	once=(k>0);

/* treat special cases */
  k=abs(k);
  if (k==0) then return;
  if (k>N && (Mode>0 || N==0)) then { Error(4); Mode=-Mode; }
  if (k==N && Mode>0) then Mode=1;
#if !SpeedF			/* Test slows down execution	*/
  for(i=h=0; i<N; i++) if (A[i].Val) then h++;
  if (h<k) then Warning(6);
#endif

/* branch on selection-mode */
  switch(abs(Mode))
  { case  1:			/* Dummy-Selection		*/
      for(i=0; i<k; i++)
	B[i]=A[Mode>0?--N:0].Id;
      break;
    case  2:			/* Probability-Selection	*/
      if (once) then ProbSelInit(A,N);
      for(i=0; i<k; i++)
      { m=ProbSel(A,N);
	B[i]=A[m].Id;
	if (Mode>0 && N>1) then
	{ an=A[N-1].Val;
	  for(h=N-1; !(h&1); h>>=1) an<<=1;
	  ProbChg(A,N,m,an);
	  ProbChg(A,N,N-1,0);
	  A[m].Id=A[--N].Id;
	  if (!(N&N-1)) then A[0].Val<<=1;
      } }
      N=*NP-k; break;
    case  3: 			/* Best-Selection (Different)	*/
      if (Mode<0) then Warning(7);
      if (once) then QMax(A,N,k,InStdOrd);
      for(i=0; i<k; i++) B[i]=A[--N].Id;
      break;
    case  4:			/* Scaled-Selection		*/
      for(i=0; i<k; i++)
      { m=random2(N); m2=random2(N);
	if ((A[m].Val>A[m2].Val)^flip(SclSel)) then m=m2;
	B[i]=A[m].Id;
	if (Mode>0) then AL[m]=AL[--N];
      } break;
    case  5:			/* Random-Selection		*/
      for(i=0; i<k; i++)
      { m=random2(N); B[i]=A[m].Id;
	if (Mode>0) then AL[m]=AL[--N];
      } break;
    case  6:			/* Prob2-Selection (simple vers) */
      if (once) then m=0; else m=1;
      for(i=0; i<k; i++)
      { if (m==0) then ProbSelInit2(A,N);
	m=ProbSel2(A,N);
	B[i]=A[m].Id;
	if (Mode>0) then AL[m]=AL[--N];
      } break;
    default: Error(3);
  }
  *NP=N;
}
#define pprFlag(F,S)	\
	prf(LIGHTMAGENTA,"%s %s\r\n",S,((F)==TRUE)?"ON":"OFF")
#define	SetSStep(F) pprFlag(SStepF=(F),"SingleStep")
#define	SetSound(F) pprFlag(SoundF=(F),"Sound")

/*------------------------------*/
	SetProt(F)		/* Toggle Protocoll On/Off	*/
/*------------------------------*/
bool	F;
{ if (F)
  then devP=fopen(ProtDev,"ab");
  else fclose(devP);
  pprFlag(ProtF=F,"Protocoll");
}
/*------------------------------*/
	SetprMode(n)		/* Set Print-Mode to 0,1,2 or 3	*/
/*------------------------------*/
int	n;
{ prM1F= (n==1||n==2);
  prf(LIGHTMAGENTA,"PrintMode = %d\r\n",prMode=n);
}
/****************************************************************/
/*		C F S - B a s i c - P r o c e d u r e s		*/
/****************************************************************/

/* Bits 0 to SStr-1 of M define 0 and 1 positions		*/
/* Corresponding Bits in C and B define CF-Cond/Action pos.	*/
/* (0,1)=0, (1,1)=1, (0,1)=(0,0)=#				*/

/* Does Message M match Condition (C,B) ?			*/
#define MatchMC(M,C,B) !((M^C)&B)  /* for doc. look further	*/

/* Match Message M with Action (A,B) to result 			*/
#define MatchMA(M,A,B) ((A&B)|(M&~B))

/*------------------------------*/
	CalcSpec(C)		/* Calculate Specifity		*/
/*------------------------------*/
TCF	*C;
{ fixp	Sp1,Sp2;
  Sp1=Count1s((long)C->C1.B);
  if (!(C->C1.T&2)) then Sp1=SStr-Sp1;
ifnTC( C->Sp=FPDiv(Sp1,SStr); )
ifTC( Sp2=Count1s((long)C->C2.B);
      if (!(C->C2.T&2)) then Sp2=SStr-Sp2;
      C->Sp=FPDiv(Sp1+Sp2,SStr<<1); )
}
#define	CrSumM(n) M=MP->B+n;					\
	if (M->H>0 || ModeP->ClaimMode==2) then			\
	{ M->H=-abs(M->H); /* Visited */			\
	  R= ModeP->SumMode==1 ? FixP(1) : -M->H;		\
	  Sum+= ModeP->DisMode==1 ? R : FPMult(R,M->I); }

/*------------------------------*/
long	CrSum(TS,N,MP,ModeP)	/* Calculate Credit-Sum		*/
/*------------------------------*/
TTup	*TS;			/* Start of Tupellist		*/
int	N;			/* # of Tupels to Check		*/
TMessL	*MP;
TCFL	*ModeP;
{ TMess	*M;
  TTup	*T;
  fixp	R;
  long	Sum=0;
  if (ModeP->SumMode==3) then return(FixP(1));
  for(T=TS; T<TS+N; T++)
  { CrSumM(T->M1); ifTC( CrSumM(T->M2); ) }
  return(Sum);
}
#define	DistrM(n) M=MP->B+n;					\
	if (M->H<0 || ModeP->ClaimMode==2) then			\
	{ M->H=abs(M->H); /* Visited */				\
	  R= FPMult(M->H,Val);					\
	  R= ModeP->DisMode==1 ? R : FPMult(R,M->I);		\
	  Sum+=R; CP->B[M->CF].Get+=R; }

/*------------------------------*/
  Distr(TS,N,MP,ModeP,CP,Val)	/* Distribute Val. to CF	*/
/*------------------------------*/
TTup	*TS;			/* Start of Tupellist		*/
int	N;			/* # of Tupels to Check		*/
TMessL	*MP;
TCFL	*ModeP,*CP;
fixp	Val;
{ TMess	*M;
  TTup	*T;
  fixp	R,Sum=FixP(0);
  for(T=TS; T<TS+N; T++)
  { DistrM(T->M1); ifTC( DistrM(T->M2); ) }
  return(Sum);
}
/*------------------------------*/
	SetMFrac(MP)		/* Set Mess.-Credit-Fraction	*/
/*------------------------------*/
TMessL	*MP;
{ TMess	*M;
  MP->B[-1].H=NMFrac;
  for(M=MP->B; M<MP->C; M++)
    M->H= (M->CF==DetId) ? DetFrac : FixP(1);
}
/*------------------------------*/
TString	RandStr(p)		/* Create Random-String		*/
/*------------------------------*/
fixp p;				/* p/256 = Prob. for a 1-Bit	*/
{ TString s=1;
  while(!(s&~MMask))
  { s<<=1; if flip(p) then s|=1; }
  return(s&MMask);
}
/*------------------------------*/
	RandMess(M)		/* Create Random-Message	*/
/*------------------------------*/
TMess	*M;
{ M->M=RandStr(FixP(0.5));
  M->I=DefNMI;
  M->CF=NonId;
}
/*------------------------------*/
	RandCF(C)		/* Create Random-Classifier	*/
/*------------------------------*/
TCF	*C;			/* Pointer to CF		*/
{ C->C1.T=flip(NegCondP) ? 4 : 6 ;
  C->C1.B=RandStr(CondSp);
  C->C1.C= C->C1.B & RandStr(FixP(0.5));
ifTC( C->C2.T=flip(NegCondP) ? 4 : 6 ;
      C->C2.B=RandStr(CondSp);
      C->C2.C= C->C2.B & RandStr(FixP(0.5)); )
  C->Act.B=RandStr(ActSp);
  C->Act.A= C->Act.B & RandStr(FixP(0.5));
  C->S=DefStr+Noise(FPMult(DefStr,DefStrDev));
  C->Sp=CalcSpec(C);
  C->Get=C->Pay=C->Tax=C->PSP=FixP(0);
}
/*------------------------------*/
	MutateCA(CP,BP,Sp)	/* Mutate Cond/Act		*/
/*------------------------------*/
TString *CP,*BP;		/* (*CP,*BP)= Cond/Act		*/
fixp	Sp;			/* Mean Specifity = 1- #Prob.	*/
{ TString m;
  m=1<<random2(SStr);
  if flip(Sp) { *BP|=m;
    if flip(FixP(0.5)) then *CP|=m; else *CP&=~m; }
  else { *BP&=~m; *CP&=~m; }
}
/****************************************************************/
/*		I n p u t   /   O u t p u t			*/
/****************************************************************/

/*------------------------------*/
char	*StoCB(S,PC,PB)		/* CharString to Condition	*/
/*------------------------------*/
char	*S;			/* String like "01##10"		*/
TString	*PC,*PB;		/* Condition (*PC,*PB)		*/
{ char	*T;
  *PB=*PC=0;
  for(T=S+SStr; S<T; S++)
  { *PB<<=1; *PC<<=1;
    switch(*S)
    { case '0': (*PB)++;          break;
      case '1': (*PB)++; (*PC)++; break;
      case '#': 		  break;
      case '*':		 (*PC)++; break;
      default : Error(5);
  } }
  return(T);			/* Pointer behind string	*/
}
/*------------------------------*/
	StoCF(S,C,Str,Dev)	/* CharString to Classifier	*/
/*------------------------------*/
char	*S;			/* String like "+01##/110#"	*/
TCF	*C;			/* Pointer to CF		*/
fixp	Str,Dev;		/* Strength and Deviation	*/
{ C->C1.T=4+'-'-*S++;
  S=StoCB(S,&C->C1.C,&C->C1.B);
ifTC( C->C2.T=4+'-'-*S++;
      S=StoCB(S,&C->C2.C,&C->C2.B); )
  S++;
  C->S=Str+Noise(FPMult(Str,Dev));
  C->Sp=CalcSpec(C);
  S=StoCB(S,&C->Act.A,&C->Act.B);
  C->Get=C->Pay=C->Tax=C->PSP=FixP(0);
  if (*S) then Error(5);
}
/*------------------------------*/
	StoM(S,MP)		/* CharString to MessageString	*/
/*------------------------------*/
char	*S;			/* String like "010011"		*/
TMess	*MP;
{ TString B;
  StoCB(S,&MP->M,&B);
  if (MMask^B) then Error(5);
  MP->CF=DetId;
  MP->I=DefDetMI;
}
/*------------------------------*/
char	*CBtoS(C,B)		/* Condition to CharString	*/
/*------------------------------*/
TString	C,B;
{ static char S[SStr+1];
  int	i;
  S[SStr]=0;
  for(i=SStr-1; i>=0; i--)
  { S[i]= (B&1) ? (C&1?'1':'0') : (C&1?'*':'#');
    B>>=1; C>>=1; }
  return(S);
}
/*------------------------------*/
	pprInfo()		/* Printf Help-Information	*/
/*------------------------------*/
{ prf(LIGHTCYAN,"%s\r\n%s\r\n",
  "Press one of the upcase letters in Menu-Field ...",
  "For more information refer to documentation     ");
}
/*------------------------------*/
	pprCFL(CP)		/* pprint Classifier-List	*/
/*------------------------------*/
TCFL	*CP;
{ TCF	*C;
  int	i=0;
  prf(LIGHTGREEN,
  "CFId   Str    Get    Pay  Taxes Condion/Action\r\n");
  for(C=CP->B; C<CP->C; C++)
  { prf(0,"%3d:%6.2f %6.2f %6.2f %6.2f %c%s",
      i++,C->S/256.0,C->Get/256.0,C->Pay/256.0,C->Tax/256.0,
      '-'-(C->C1.T&2),CBtoS(C->C1.C,C->C1.B));
ifTC( prf(0,"%c%s",'-'-(C->C2.T&2),CBtoS(C->C2.C,C->C2.B)); )
    prf(0,"/%s\r\n",CBtoS(C->Act.A,C->Act.B));
} }
/*------------------------------*/
	pprMessL(MP)		/* pprint Message-List		*/
/*------------------------------*/
TMessL	*MP;
{ TMess	*M;
  int	i=0;
  prf(LIGHTGREEN,"MId Intens Sender Message\r\n");
  for(M=MP->B; M<MP->C; M++)
  { prf(0,"%3d:%6.2f ",i++,M->I/256.0);
    if (M->CF==DetId)
    then prf(0,"  D    ");
    else prf(0,"%3d    ",M->CF);
    prf(0,"%s\r\n",CBtoS(M->M,MMask));
} }
/*------------------------------*/
	pprBidL(BP,TP)		/* pprint Bid-List		*/
/*------------------------------*/
TBidL	*BP;
TTupL	*TP;
{ TBid	*B;
  TTup	*T,*TS;
  int	i=0;
  prf(LIGHTGREEN,
    "BidId CFId Bid EBid Fired BidTupel\r\n");
  for(B=BP->B; B<BP->C; B++)
  { prf(0,"%3d: %3d %6.2f %6.2f %c {",
      i,B->CF,B->BV/256.0,B->EV/256.0,B->F?'F':'-');
    for(T=TS=TP->B+B->Tup; T<TS+B->N; T++)
    { if (T->M1==NonId) then prf(0," N");
      else prf(0," %d",T->M1);
      ifTC( if (T->M2==NonId) then prf(0,":N");
	    else prf(0,":%d",T->M2); )
    }
    prf(0," }\r\n");
    i++;
} }
/*------------------------------*/
	pprCS(prMode,o)		/* pprint whole CFS		*/
/*------------------------------*/
TCS	*o;
{ extern pprStat(int,TStat*);
  Display();
  switch(prMode) {
  case 3:
    prf(WHITE,
    "-------------- Cycle %ld --------------\r\n",CycleC);
    prf(LIGHTGREEN,"\r\nMessage-List:\r\n");
    pprMessL(o->MP);
    prf(LIGHTGREEN,"\r\nClassifier-List:\r\n");
    pprCFL(o->CP);
    prf(LIGHTGREEN,"\r\nBid-List:\r\n");
    pprBidL(o->BP,o->TP);
    prf(LIGHTGREEN,"\r\nNew-Message-List:\r\n");
    pprMessL(o->NP);
    if (CycleC%EffRate==0) then
    { prf(LIGHTGREEN,"\r\nEffector-List:\r\n");
      pprCFL(o->EP);
      prf(LIGHTGREEN,"\r\nEff-Bid-List:\r\n");
      pprBidL(o->DP,o->UP);
      prf(LIGHTGREEN,"\r\nOutput-Message-List:\r\n");
      pprMessL(o->OP);
    }
    prf(0,"\r\n");
    prM1F=TRUE;
  case 2:
    pprStat(1,&cy); break;
} }
/*------------------------------*/
	pprStat(prMode,epp)	/* Print Statistic		*/
/*------------------------------*/
int	prMode;
TStat	*epp;
{ int	n	  = (int)max(epp->CycleC,1);
  float	ReVal	  = epp->ReVal/(256.0*n);
  float	Str	  = epp->Str/(256.0*n*(o->CP->C-o->CP->B));
  int	NCFMinStr = (int)(epp->NCFMinStr/n);
  int	NCFMaxStr = (int)(epp->NCFMaxStr/n);
  int	MCF	  = (int)(epp->MCF/n);
  int	MMess	  = (int)(epp->MMess/n);
  int	NCF	  = (int)(epp->NCF/n);
  int	NBid      = (int)(epp->NBid/n);
  int	NTup	  = (int)(epp->NTup/n);
  int	NMess	  = (int)(epp->NMess/n);

  switch(prMode) {
  case 2: pprCS(3,o); /* no break; */
  case 3: prf(LIGHTGREEN,
    "\r\n  Statistic (Mean-Values) of Cycle %ld-%ld:\r\n",
	    CycleC-n+1,CycleC);
    prf(0,"  External Reinforcement  : %.3f\r\n",ReVal);
    prf(0,"  mean CF-Strength        : %.3f\r\n",Str);
    prf(0,"  min/maximal Strength CF : %d/%d\r\n",
					 NCFMinStr,NCFMaxStr);
    prf(0,"  (matched) Messages      : (%d) %d\r\n",MMess,NMess);
    prf(0,"  (matched) Classifers    : (%d) %d\r\n",MCF,NCF);
    prf(0,"  Bids (-Tupels)          : %d (%d)\r\n",NBid,NTup);
    prf(0,"\r\n");
    prM1F=TRUE;
    break;
  case 1:
    if (prM1F) then
    { prf(LIGHTGREEN,"%s\r\n%s\r\n",
      "Cycle-Cycle  Reinf Strength Min Max Mch Mch Bid Tup",
      "             Value          Str Str  CF Mess 's els");
      prM1F=FALSE; }
    prf(0,"%5ld-%-5ld:%7.3f %7.3f %3d %3d %3d %3d %3d %3d\r\n",
      CycleC-n+1,CycleC,ReVal,Str,NCFMinStr,
      NCFMaxStr,MCF,MMess,NBid,NTup);
    break;
  case 0: break;
  default: Error(8);
} }
/****************************************************************/
/*		C F S - H i g h - P r o c e d u r e s		*/
/****************************************************************/

/* Support of Tupel (m1,m2)  (used by MatchBid)			*/
#define	TupSupp1(m1,m2) m1.Val               			\
  ifTC(+ ((m1.Id==m2.Id && CP->SuppMode==1) ?  0 : m2.Val) )

/* Support of Tupel (m1,m2) (used by Fire)					*/
#define	TupSupp2(m1,m2)	(MP->B[m1].I       			\
  ifTC(+ ((m1==m2 && CP->SuppMode==1) ? 0 : MP->B[m2].I) ) )

/*------------------------------*/
	MatchBid(CP,MP,BP,TP)	/* Create BidList		*/
/*------------------------------*/
TCFL	*CP;
TMessL	*MP;
TBidL	*BP;
TTupL	*TP;
{ TMess	*M;
  TIdVal M1[SMessL];
ifTC( TIdVal M2[SMessL];
      TIdVal MM[SMessL+1];
      long s1; long s2; )
  TIdVal F[STupL];
  index G[STupL];
  int	H[STupL];		/* Copy of A[].Val		*/
  TString Str[SMessL];
  TString as;
  int	n1,n2=1,nn;
  TCF	*C;
  int	h,i,k,k2,N;
  bool	mf;			/* Matching Flag		*/
  long	s,ss=0;			/* Support			*/
  TBid	*B,*BPB=BP->C;		/* relevant beginning for this	*/

for(M=MP->B; M<MP->C; M++) M->H=FALSE;		/* H=Matched	*/

for(C=CP->B; C<CP->C; C++) /* for all CF do */
/*** Match CF ***/
{ n1=0; ifTC( n2=nn=0; )
  for(i=0; i<MP->C-MP->B; i++) /* for all Mess do		*/
  { mf=FALSE;
    if (MatchMC(MP->B[i].M,C->C1.C,C->C1.B)) then
    { M1[n1].Id=i; M1[n1++].Val=MP->B[i].I; mf=TRUE; }
ifTC( if (MatchMC(MP->B[i].M,C->C2.C,C->C2.B)) then
      { M2[n2].Id=i; M2[n2++].Val=MP->B[i].I; mf=TRUE; }
      if (mf) then
      { MM[nn].Id=i; MM[nn++].Val=MP->B[i].I; MP->B[i].H=TRUE; } )
  }
  if (!(C->C1.T&2)) then
  { if (n1) then n1=0;
    else { M1[n1].Id=NonId; M1[n1++].Val=DefNMI;
     ifTC( MM[nn].Id=NonId; M1[nn++].Val=DefNMI; ) } }
ifTC(
  if (!(C->C2.T&2)) then
  { if (n2) then n2=0;
    else
    { M2[n2].Id=NonId; M2[n2++].Val=DefNMI;
      if (MM[nn].Id!=NonId)
      then MM[nn].Id=NonId; MM[nn++].Val=DefNMI; }
  } )
  if (n1&&n2) then
  { cy.MCF++;		  	/* for Statistic		*/
    if (CP->BidMode>2) then
    { for(i=0; i<n1; i++)
	Str[M1[i].Id]=MatchMA(MP->B[M1[i].Id].M,C->Act.A,C->Act.B);
      GStr=Str;
      QSort(M1,M1+n1-1,InStrOrder);
      for(i=k=0; i<n1; k++)
      { as=Str[M1[i].Id];
	for(h=i,s=0; i<n1 && as==Str[M1[i].Id]; i++)
	{ s+=M1[i].Val;		/* maybe max better		*/
	  if (M1[i].Val>M1[h].Val) then h=i;
	}
	M1[k].Id=M1[h].Id; M1[k].Val=(int)min(s,MaxInt);
      }
      n1=k;
ifTC( for(s=h=i=0; i<n2; i++)
      { s+=M2[i].Val;
	if (M2[i].Val>M2[h].Val) then h=i; }
      M2[0].Id=M2[h].Id;
      M2[0].Val=(int)min(s,MaxInt); n2=1; )
    }
/*** Bid CF ***/
    switch(CP->BidMode) {
    case 1: case 3:                   	/* BidMode = 1		*/
      if (BP->C>=BP->E) then { Warning(5); goto Full; }
      BP->C->CF=C-CP->B;
ifTC( if (CP->SuppMode==1) then		/* SuppMode = 1 / 2	*/
      { for(s=i=0; i<nn; i++) s+=MM[i].Val; }
      else
      { for(s1=i=0; i<n1; i++) s1+=M1[i].Val;
	for(s2=i=0; i<n2; i++) s2+=M2[i].Val;
	s=n2*s1+n1*s2; } )		/* =Sum over all Tuples	*/
ifnTC( for(s=i=0; i<n1; i++) s+=M1[i].Val; )
      *(long*)&BP->C->BV=s;		/* Supp in .BV & .EV	*/
      ss+=s;
      BP->C->N=n1*n2;                   /* Est-Calc will follow	*/
      BP->C->Tup=TP->C-TP->B;
      for(i=0; i<n1; i++) ifTC( for(k=0; k<n2; k++) )
      { if (TP->C>=TP->E) then { Warning(4); goto Full; }
	TP->C->M1=M1[i].Id;
ifTC(	TP->C->M2=M2[k].Id; )
	TP->C++; }
      BP->C->F=FALSE;
      BP->C++;
      break;
    case 2: case 4:			/* BidMode = 2		*/
      for(i=h=0; i<n1; i++) ifTC( for(k=0; k<n2; k++) )
      {	F[h].Id=h;
	F[h].Val=H[h]=TupSupp1(M1[i],M2[k]);
	if (++h>STupL) then { Warning(8); break; }
      }
      k=min(CP->MBids,h);
      if (k>(k2=TP->E-TP->C)) then { k=k2; Warning(4); }
      if (k>(k2=BP->E-BP->C)) then { k=k2; Warning(5); }
      Select(F,&h,G,k,CP->BidTupSelMode); /* normally h=n1*n2 */
      for(h=0; h<k; h++)
      {	BP->C->CF=C-CP->B;
	BP->C->BV=H[G[h]];
	BP->C->N=1;
	BP->C->Tup=TP->C-TP->B;
	BP->C->F=FALSE;
	TP->C->M1=M1[G[h]/n2].Id;
ifTC(	TP->C->M2=M2[G[h]%n2].Id; )
	BP->C++; TP->C++; }
      break;
    default: Error(7);
} } }
Full:;
for(M=MP->B; M<MP->C; M++)		/* matching statistic	*/
  if (M->H) then cy.MMess++;

/*** Calc BidVal ***/
for(B=BPB; B<BP->C; B++) 		/* for all Bids do	*/
{ if (CP->BidMode==1) then		/* BV is Supp		*/
    B->BV=FPDiv(*(long*)&B->BV,ss);	/* BV is RelSupp / Est	*/
  C=CP->B+B->CF;
  B->BV=FPMult(FPPow(CP->RiskFak,B->BV,CP->RelSuppPow),
	       FPPow(C->S,C->Sp,CP->SpecPow));/* BV is BidValue	*/
  B->EV=B->BV+Noise(FPMult(B->BV,Dev2));      /* EV=BV+Noise	*/
  B->EV=FPMult(FPPow(FixP(1),B->EV,CP->EBidPow),
		 FPPow(FixP(1),C->Sp,CP->ESpecPow));/* Eff-Bid	*/
} }
/*------------------------------*/
	Fire(CP,MP,BP,TP,NP)	/* Fire Messages		*/
/*------------------------------*/
TCFL	*CP;
TMessL	*MP;
TBidL	*BP;
TTupL	*TP;
TMessL	*NP;
{ TIdVal FB[SBidL],FT[STupL];
  index	S,GT[STupL];
  int	i,k,NT;
  TCF	*C;
  TBid	*B;
  TTup	*T;
  int	N=BP->C-BP->B;
  bool	Stop=FALSE;
  int	r=NP->E-NP->C;

  for(C=CP->B; C<CP->C; C++) C->H=CP->MFire; /* Fire-Counter 	*/
  for(i=0; i<N; i++)
  { FB[i].Id=i;
    FB[i].Val=BP->B[i].EV; }
  MultSelInit(FB,N,CP->FireBidSelMode);

  while(r>0 && N!=0)
  { Select(FB,&N,&S,-1,CP->FireBidSelMode); /* -1 = multiple sel*/
    B=BP->B+S; C=CP->B+B->CF; NT=B->N; T=TP->B+B->Tup;
    k=min(NT,min(r,C->H));
    if (k>0) then
    { for(i=0; i<NT; i++)
      { FT[i].Id=B->Tup+i;
	FT[i].Val=TupSupp2(T->M1,T->M2); }
      Select(FT,&NT,GT,k,CP->FireTupSelMode);
      for(i=0; i<k; i++)
      { NP->C->M=MatchMA(MP->B[TP->B[GT[i]].M1].M,
			 C->Act.A,C->Act.B);
	NP->C->I=B->BV;
	NP->C->CF=B->CF;
	NP->C++; }
      C->H-=k; r-=k;
      B->F=TRUE;
    }
} }
/*------------------------------*/
	Clean(MP)		/* Clean Message-List		*/
/*------------------------------*/
TMessL	*MP;			/* MessList to Clean MP --> MP	*/
{ TMess	 H[SMessL],*HC=H;	/* should and will be empty	*/
  TIdVal F[SMessL+1],*F1=F;
  index	 G[SMessL];
  int	i;
  TString as;
  TMess	*M;
  int	N=MP->C-MP->B;
  TIdVal *F2,*FE=F+N;

  if (N>=MEqMess) then
  { GMB=MP->B;
    for(i=0; i<N; i++)
    { F[i].Id=i; F[i].Val=GMB[i].I; }
    QSort(F,F+N-1,InMessOrder);

    while(F1<FE)
    { as=GMB[F1->Id].M;
      for(F2=F1+1; F2<FE && GMB[F2->Id].M==as; F2++);
      N=F2-F1;
      if (N>MEqMess) then
      { Select(F1,&N,G,MEqMess,DelMessSelMode);
	for(i=0; i<MEqMess; i++)
	  memcpy(HC++,GMB+G[i],sizeof(TMess));
	F1=F2; }
      else
	for(; F1<F2; F1++)
	  memcpy(HC++,GMB+F1->Id,sizeof(TMess));
    }
    memcpy(MP->B,H,(HC-H)*sizeof(TMess));
    MP->C=GMB+(HC-H);
  }
  if (CleanHallF) then
  { for(M=MP->B; M<MP->C;)
      if (MatchMC(M->M,DetMTagC,DetMTagB)) then
	memcpy(M,--MP->C,sizeof(TMess));
      else M++;
} }
/*------------------------------*/
Credit(CP,EP,MP,NP,BP,DP,TP,UP)	/* Credit-Assignment		*/
/*------------------------------*/
TCFL	*CP,*EP;
TMessL	*MP,*NP;
TBidL	*BP,*DP;
TTupL	*TP,*UP;
{ index	BidN;
  fixp	Val;
  long	Sum;
  TCF	*C;
  TMess	*M;
  TBid	*B;
  switch(CreditMode) {
  case 1:			/* Explicit Bucket-Brigade	*/
    for(C=CP->B-1; C<CP->C; C++) /* Test */
      C->Get=C->Pay=FixP(0);
  /* Set .H = ñRate, - = Visited */
    SetMFrac(NP); SetMFrac(MP);
  /* Distribute Reinforcement */
    Sum=0;
    for(B=DP->B; B<DP->C; B++)
      if (B->F) Sum+=CrSum(UP->B+B->Tup,B->N,NP,EP);
    if (Sum) then
    { Val=FPDiv(ReVal,Sum);
      for(B=DP->B; B<DP->C; B++)
	if (B->F) Distr(UP->B+B->Tup,B->N,NP,EP,CP,Val);
    }
  /* Distribute Bids */
    for(B=BP->B; B<BP->C; B++) if (B->F) then
      if (B->N) then
      { Sum=CrSum(TP->B+B->Tup,B->N,MP,CP);
	if (Sum) then
	{ Val=FPDiv(B->BV,Sum);
	  CP->B[B->CF].Pay=Distr(TP->B+B->Tup,B->N,MP,CP,CP,Val);
      } }
    break;
  case 2: Error(8); break;	/* Implicit Bucket-Brigade	*/
  case 3:			/* Profit Sharing Plan		*/
    for(B=BP->B; B<BP->C; B++) if (B->F) then
    { C=CP->B+B->CF;
      Val= (PSPDisMode<3) ? FixP(1) : B->BV;
      if (PSPDisMode&1)
      then C->PSP=max(C->PSP,Val);
      else if ((FixP(127)-C->PSP)<Val)
	   then C->PSP=FixP(127);
	   else C->PSP+=Val;
    }
    if (CycleC%ReRate==0) then
      for(C=CP->B; C<CP->C; C++)
      if (C->PSP) then
      { C->Pay=FPMult(PSPFrac,C->PSP);
	C->Get=FPMult(PSPFrac,ReVal);
	C->PSP=FixP(0); }
      else { C->Pay=C->Get=0; }
    break;
  case 4: /* no Credit-Asignment */
  default: Error(8);		/* No Credit Assignment		*/
} }
/*------------------------------*/
	Taxes(CP,NP,BP)		/* Tax-Payment			*/
/*------------------------------*/
TCFL	*CP;
TMessL	*NP;
TBidL	*BP;
{ TCF	*C;
  TMess	*M;
  TBid	*B;

  for(C=CP->B-1; C<CP->C; C++)
  { C->Tax=HeadTax; C->H=0; }

  for(M=NP->B; M<NP->C; M++)
  { C=CP->B+M->CF;
    if (!C->H || MultMessTaxF) then
    { C->Tax+=MessTax; C->H=1; }
  }
  for(B=BP->B; B<BP->C; B++)
  { C=CP->B+B->CF;
    if ((!(C->H&2) || MultBidTaxF) &&
	(!(C->H&1) || BidTaxMode==1)) then
    { C->Tax+=BidTax; C->H|=2; }
  }
  for(C=CP->B; C<CP->C; C++)
    C->Tax=FPMult(C->S,C->Tax);
}
/*------------------------------*/
	StrUpDate(CP)		/* Strength-Update (Test !!)	*/
/*------------------------------*/
TCFL	*CP;
{ TCF	*C;
  for(C=CP->B; C<CP->C; C++)
    C->S=max(MinStr,min(MaxStr,
	 C->S+C->Get-C->Pay-C->Tax));
}
/*------------------------------*/
	Genetic(CP)		/* Genetic Operations		*/
/*------------------------------*/
TCFL	*CP;
{ TIdVal F[SCFL];
  index  G[SCFL];
  TCF	*C;
  int	i,k;
  int	N=CP->C-CP->B;

  if (prMode>1) then
    prf(LIGHTBLUE,
    "%ld.genetic algorithm envocation\r\n",CycleC/GenRate);

/* Replace CF (and Sender in MessL, not impl.) */
  for(i=0; i<N; i++)
  { F[i].Id=i;
    F[i].Val= CP->B[i].S ? FPDiv(FixP(0.49),CP->B[i].S) : FixP(127);
  }
  Select(F,&N,G,NCFRepl,ReplSelMode);
  for(i=0; i<NCFRepl; i++) RandCF(CP->B+G[i]);

/* Mutate CF */
  for(i=0; i<N; i++)
  { F[i].Id=i;
    F[i].Val= CP->B[i].S ? FPDiv(FixP(0.5),CP->B[i].S) : FixP(127);
  }
  Select(F,&N,G,NCFMut,MutSelMode);
  for(i=0; i<NCFMut; i++)
  { C=CP->B+G[i];
    for(k=0; k<NMutate; k++)
    { MutateCA(&C->C1.C,&C->C1.B,CondSp);
      ifTC( MutateCA(&C->C2.C,&C->C2.B,CondSp); )
      MutateCA(&C->Act.A,&C->Act.B,ActSp);
  } }
}
/*------------------------------*/
	ReInit(o)		/* Re-Initialize		*/
/*------------------------------*/
TCS	*o;
{ TMessL *h;
  TMess	 *M;
  memswap(o->MP,o->NP,sizeof(TMessL));
  o->NP->C=o->NP->B;
  o->OP->C=o->OP->B;
  o->BP->C=o->BP->B;
  o->TP->C=o->TP->B;

  if (DelMessMode) then
  { for(M=o->MP->B; M<o->MP->C;)
      if (DelMessMode==2 || MatchMC(M->M,EffMTagC,EffMTagB)) then
	memcpy(M,--o->MP->C,sizeof(TMess));
      else M++;
} }
/*------------------------------*/
	InitStat(stp)		/* Initialize Statistic		*/
/*------------------------------*/
TStat	*stp;
{ memset(stp,0,sizeof(TStat));
}
/*------------------------------*/
	UpdStat(o)		/* Update Statistic		*/
/*------------------------------*/
TCS	*o;
{ TCF	*C;
  int	i;
  cy.CycleC=1;
  cy.ReVal=ReVal;
  cy.NCFMinStr=cy.NCFMaxStr=cy.Str=0;
  for(C=o->CP->B; C<o->CP->C; C++)
  { cy.Str+=C->S;
    if (C->S==MinStr) then cy.NCFMinStr++;
    if (C->S==MaxStr) then cy.NCFMaxStr++; }
  /* cy.MCF and cy.MMess are updated in MatchBid() */
  cy.NCF  =o->CP->C-o->CP->B;
  cy.NBid =o->BP->C-o->BP->B;
  cy.NTup =o->TP->C-o->TP->B;
  cy.NMess=o->MP->C-o->MP->B;
  for(i=0; i<sizeof(TStat)/sizeof(long); i++)	/* TStat =	*/
    ((long*)&ep)[i]+=((long*)&cy)[i];		/* long A[8]	*/
}
/*------------------------------*/
	MainStep(o)		/* Main Evaluation Cycle	*/
/*------------------------------*/
TCS	*o;
{ if (CycleC%StRate==0) then InitStat(&ep);
  CycleC++;
  Detect(o->MP,MDetM);
  cy.MCF=cy.MMess=0;                          /* for Stat	*/
  MatchBid(o->CP,o->MP,o->BP,o->TP);
  if (DelMessMode!=2) then o->NP->E-=MDetM; /* res. for DetMess	*/
  Fire(o->CP,o->MP,o->BP,o->TP,o->NP);
  if (DelMessMode!=2) then o->NP->E+=MDetM; /* free reserved "	*/
  Clean(o->NP);

  if (CycleC%EffRate==0) then
  { o->DP->B=o->DP->C=o->BP->C;	/* because DP=BP,UP=TP		*/
    o->UP->B=o->UP->C=o->TP->C;
    MatchBid(o->EP,o->NP,o->DP,o->UP);
    Fire(o->EP,o->NP,o->DP,o->UP,o->OP);
    /* maybe create EMess, if OP is Empty */
    Effect(o->OP);
  }
  if (CycleC%ReRate==0)
  then ReVal=Reinf(o->OP);
  else ReVal=FixP(0);
  Credit(o->CP,o->EP,o->MP,o->NP,o->BP,o->DP,o->TP,o->UP);
  Taxes(o->CP,o->NP,o->BP);
  pprCS(prMode,o);
  StrUpDate(o->CP);
  if (CycleC%GenRate==0) then Genetic(o->CP);
  UpdStat(o);
  if (CycleC%StRate==0) then pprStat(prMode,&ep);
  if (SStepF && ((prMode>1)||(CycleC%StRate==0)))
  then  Menu(); else event();
  ReInit(o);
}
/****************************************************************/
/*		M e n u - C o n t r o l				*/
/****************************************************************/

/*------------------------------*/
char	GetKey()		/* Get a Key			*/
/*------------------------------*/
{ char c=getch();
  if (c==0) then c=128+getch();
}
/*------------------------------*/
	Menu()			/* Wait for Key/Menu-Selection	*/
/*------------------------------*/
{ char	c;
  extern chdo(char c);
  do
  { textcolor(WHITE);
    cprintf("Press <C> to continue ... or any other Menu-Key");
    textcolor(STDCOL);
    c=GetKey();
    cprintf("\r"); clreol(); chdo(c);
  }
  while(!strchr("Cc ",c));
  if (!SStepF) prf(LIGHTMAGENTA,"Simulation Continued\r\n");
}
/*------------------------------*/
	prMenu()		/* Display Menu			*/
/*------------------------------*/
{ window(1,1,80,1);
  textbackground(BLUE);
  clrscr();
  cprintf("Retart ESC Cont Break Abort Prot stEp "
	  "Help Display Sound 0123 rdZ Test\r");
  window(1,3,80,NScrL);
  textbackground(BLACK);
}
#define prInt() prf(LIGHTMAGENTA,	\
	"Simulation Interrupted in Cycle %ld\r\n",CycleC);

/*------------------------------*/
	chdo(char c)		/* Branch on Menu-Selection c	*/
/*------------------------------*/
{ extern CFSMain(),CFSExit(),TestFunc();
  switch(toupper(c)) {
  case 'R': CFSExit(); longjmp(jmp,1);	   /* ReStart CFS-Simul.*/
  case 'B': prInt(); BreakPoint(); break;  /* Break to TC++	*/
  case 'C': case ' ': break;		   /* Continue Simul.	*/
  case 'A': CFSExit(); exit(0);		   /* Abort to CFS	*/
  case 'P': SetProt(!ProtF);  break;	   /* Protocoll on/off	*/
  case 'E': SetSStep(!SStepF);break;	   /* SingleStep on/off	*/
  case 'H': case 187: pprInfo(); break;	   /* Printf Help-Info	*/
  case 'D': pprCS(max(prMode,2),o); break; /* Print Status	*/
  case '0': case '1': case '2':		   /* PrintMode 0123	*/
  case '3': SetprMode(c-'0'); break;
  case 'S': SetSound(!SoundF); break;	   /* Sound on/off	*/
  case 'Z': randomize(); break;		   /* randomize		*/
  case 'T': TestFunc(); break;		   /* Testfunction	*/
  default : Sound(2500,10);		   /* Wrong Key		*/
} }
/*------------------------------*/
char	event()			/* look for KeyBoard-Event	*/
/*------------------------------*/
{ char	c;
  if (!kbhit()) then return(0);
  c=GetKey();
  if (c==ESC) then { prInt(); Menu(); } else chdo(c);
  return(c);
}
/****************************************************************/
/*		  T e s t - P r o c e d u r e s			*/
/****************************************************************/

/*------------------------------*/
	TestFunc()		/* Testfunction			*/
/*------------------------------*/
{ int i;
  prf(LIGHTCYAN,"This is a test ...\r\n");
  Error(0);
}
/****************************************************************/
/*	I n i t - E x i t - M a i n - P r o c e d u r e s	*/
/****************************************************************/

#define	oalloc(P,S)         			\
	P->B=malloc((S+1)*sizeof(*P->B));	\
	if (P->B==NULL) then Error(6);		\
	P->B=P->C=P->B+1; P->E=P->B+S;

/*------------------------------*/
	InitMessL(MP,S)        	/* Init Mess-List		*/
/*------------------------------*/
TMessL	*MP;
int	S;
{ MP->B=malloc((S+1)*sizeof(TMess));
  if (MP->B==NULL) then Error(6);
  MP->B->M=0; MP->B->I=DefNMI; MP->B->CF=NonId;
  MP->B=MP->C=MP->B+1; MP->E=MP->B+S;
}
/*------------------------------*/
	InitCFL(CP,S)        	/* Init CF-List			*/
/*------------------------------*/
TCFL	*CP;
int	S;
{ CP->B=malloc((S+1)*sizeof(TCF));
  if (CP->B==NULL) then Error(6);
  CP->B->S=FixP(1); /* ... */
  CP->B=CP->C=CP->B+1; CP->E=CP->B+S;
}
/*------------------------------*/
	     CFSInit()		/*	Initialisierung		*/
/*------------------------------*/
{ char	**S;
  char	T[SStr+1];

/* Other Initializations */
  memset(WC,0,sizeof(WC));
  memset(WP,0,sizeof(WP));
  srand(12345);

/* Create Arrays */
  InitMessL(o->MP,SMessL);
  InitMessL(o->NP,SMessL);
  InitMessL(o->OP,SOutL);
  InitCFL(o->CP,SCFL);
  InitCFL(o->EP,SEffL);
  oalloc(o->BP,SBidL);
  memcpy(o->DP,o->BP,sizeof(TBidL));
  oalloc(o->TP,STupL);
  memcpy(o->UP,o->TP,sizeof(TTupL));

/* Init Classifier & Effectors & Enviroment */
  for(S=CFSL; *S; S++)
    StoCF(*S,o->CP->C++,DefStr,DefStrDev);
  while(o->CP->C<o->CP->E) RandCF(o->CP->C++);
  for(S=EffSL;*S; S++)
    StoCF(*S,o->EP->C++,FixP(1),FixP(0));
  InitEnv();

/* Read Detector/Effector-Tags */
  memset(T,'#',SStr); T[SStr]='\0';
  memcpy(T,DetMessTag,min(strlen(DetMessTag),SStr));
  StoCB(T,&DetMTagC,&DetMTagB);
  memset(T,'#',SStr); T[SStr]='\0';
  memcpy(T,EffMessTag,min(strlen(EffMessTag),SStr));
  StoCB(T,&EffMTagC,&EffMTagB);

/* Open Devices */
  textmode(C4350); textcolor(YELLOW);
  devP=fopen(ProtDev,"ab");
  CycleC=0; ProtF=TRUE; SStepF=FALSE;
  textbackground(BLACK);
  clrscr(); prMenu();
  if (prMode>0) then { prf(LIGHTCYAN,
    "%s\r\n%s\r\n%s\r\n%s\r\n%s\r\n%s%s%s\r\n%s\r\n\n",
    "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»",
    "º  C l a s s i f i e r - S y s t e m - S i m u l a t o r  º",
    "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ",
    "º  Copyright by Marcus Hutter     01.04.91     Vers. 1.0  º",
    "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ",
    "º       Simulation Run ("  ,   ActTime()   ,   ")         º",
    "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ");
  }
  SetProt(FALSE);
  SetSStep(TRUE);
}
/*------------------------------*/
	     CFSMain()		/*	Main-Routinen		*/
/*------------------------------*/
{ Menu();
  FOREVER MainStep(o);
}
/*------------------------------*/
	     CFSExit()		/*	Exit-Routinen		*/
/*------------------------------*/
{ fclose(devP); fclose(lpt1);
  free(o->TP->B-1); free(o->BP->B-1);
  free(o->EP->B-1); free(o->CP->B-1);
  free(o->OP->B-1); free(o->NP->B-1); free(o->MP->B-1);
}
/*------------------------------*/
	     main()		/*	Main-Program		*/
/*------------------------------*/
{ setjmp(jmp);
  CFSInit();
  CFSMain();
  CFSExit();			/* not needed */
  exit(0);			/* not needed */
}