// Copyright Andy Singleton, 1993,1994
// This code is released for non-commercial use only
// For questions or upgrades contact:
// Andy Singleton, Creation Mechanics Inc.
// PO Box 248, Peterborough, NH 03458
// Internet: p00396@psilink.com
// Compuserve 73313,757
// Phone: (603) 563-7757

// GPQUICK
// C++ prefix stack implementation
// Divides GP system into classes:
//    Chrome-Function  - representation of the genetic program
//    Pop - Runs the GA
//    Problem - fitness and primitive functions


#include "pch.h"
#include "chrome.h"

// Global variables
char scratch[100];

#ifdef FASTEVAL
	// Global evaluation variables.  Eliminates parameter passing
	// If you can get IpGlobal into a register, you will run near the speed
	// limit for S-expression evaluation
	Chrome * ChromeGlobal;                  // currently evaluating Chrome
	evalnode ExprGlobal[EXPRLEN];   // expression expanded to evalnodes
	evalnode * IpGlobal;            // Current instruction pointer
#endif


//**************************************************************************
//////////////////////////////////// Utility functions

void NoMoreMem()		// Out of memory exit
{
	cout << "\nOut of Memory.  Aborting Execution.\n";
	exit(1);
}

int min(int value1, int value2)
   {
	  return ( (value1 < value2) ? value1 : value2);
   };
int max(int value1, int value2)
   {
	  return ( (value1 > value2) ? value1 : value2);
   };

// Comment out if included in your implementation (e.g. Borland)
	// upper case string
char* strupr(char* s)
{
	int i=0;
	while (s[i])
		if (s[i]>='a' && s[i]<='z') s[i]=s[i]-32;
    i++;
	return s;
}

	// compare strings without case sensitivity
int strcmpi(char* s1, char* s2)         // only checks equality
{
	int mismatch=0;
	while (*s1 && *s2 && !mismatch)
	{
		if (*s1>='a' && *s1<='z' && *s2<='Z')
			mismatch = *s1-32 != *s2;               
		else if (*s1>='A' && *s1<='Z' && *s2>='a')
		mismatch = *s1+32 !=*s2;

		else
			mismatch = *s1!=*s2;
		s1++;s2++;
	}
	return mismatch || *s1 || *s2;
}


//**************************************************************************
//////////////Function member function (separated for use in a DLL)
char* Function::getprint(Chrome* chrome)
{
	// NUMBER has its own getprint to write the correct number
	// This is fancy footwork for other functions with operands
	// these are written as <name>_<operand number>
	if (varnum) sprintf(scratch,"%s_%-d",name,VARNUM(chrome->expr[chrome->ip]));
	return (varnum? scratch : name);
}



//**************************************************************************
/// Chrome functions ///////////////////////////////////////////

Chrome::Chrome(ChromeParams* p,CSelector* cf,Problem* pr,Function** f,retval* c,BOOL doinit) {
// initialize a expr using the functions in array f

	int depth = p->params[pInitExpr];
	funcbag=cf;
		params = p;
	probl = pr;
	funclist = f;
	constlist = c;
	MaxExpr=params->params[pMaxExpr];
	ExprBytes=MaxExpr*sizeof(node);
	expr=new node[MaxExpr];
    if (expr==NULL) NoMoreMem();		// Out of memory?
	ip=0;
	funccount = params->funccount;          // how many primitives?
	
	birth = 0;
	if (doinit)
	{
		// DO "ramped half and half from 2 to depth"
		if (depth > 0)
		{
						SubInit(1,rnd(depth-1)+1,rnd(2));       // go to some depth less than max, full or half full
		}
		else
			SETNODE(expr[ip],0,0);                                  // stick in a stub constant
	}
		nfitness  = probl->GetFitnessObj();
		// allocates a FitnessValue object;  GetFitnessObj  calls new
}

Chrome* Chrome::Copy()
{
	Chrome* nw=new Chrome(params,funcbag,probl,funclist,constlist,FALSE);
	if (nw==NULL) NoMoreMem();		// Out of memory?
	nw->Dup(this);
	return nw;
}

void Chrome::Dup(Chrome* source)                // make a copy nondestructively
{
	funcbag=source->funcbag;
	params=source->params;
	funclist=source->funclist;
	funccount=source->funccount;
		constlist=source->constlist;
	
		memcpy(expr,source->expr,ExprBytes);
	nfitness->Copy(source->nfitness);
	ip=0;
}

retval Chrome::evalAll() // eval the whole expression anew
{
#ifndef FASTEVAL
	ip=-1;
	return eval();
#else
	
	IP=ExprGlobal;
	//cout<<"FUNC="<< IP->op;
	return (IP->ef)();
#endif
}

void Chrome::SetupEval()
{
#ifdef FASTEVAL
		// expand stack into evalnodes in global eval stack
	int args;
	node* spp=expr;
	evalnode* ip=ExprGlobal;
	args=1;
	while (args > 0)
	{
		SETEVALNODE(ip,spp->op,spp->idx);
		args=args+PARGNUM(spp)-1;
		ip++;
		spp++;
	}
		// set global eval pointers
	ChromeGlobal=this;
#endif
}

void Chrome::SubInit(int argstogo,int depth,int isfull)     // Initialize a subtree half full
{
	int i;
	int maxargs,thisargs;
	maxargs = MaxExpr -(ip+argstogo);       // max number of args to add
	i=funcbag->roulette();

	// terminal required
	if (maxargs == 0 || depth == 0 )
		while (funclist[i]->argnum>0) i=funcbag->roulette();

	// node required
	else if (isfull || ip==0)
		if (maxargs > 5)
			while (funclist[i]->argnum == 0) i=funcbag->roulette();
		else                    // not enough room.  Take what you can get.
			while (funclist[i]->argnum>maxargs) i=funcbag->roulette();

	// terminal allowed 50% of the time
	else
		if (rnd(2))             // terminal required
			while (funclist[i]->argnum>0) i=funcbag->roulette();
		else            // node required
			if (maxargs > 5)
				while (funclist[i]->argnum == 0) i=funcbag->roulette();
			else                    // not enough room.  Take what you can get.
				while (funclist[i]->argnum>maxargs) i=funcbag->roulette();

	SETNODE(expr[ip],i,rnd(funclist[i]->varnum));
	ip++;
	thisargs=funclist[i]->argnum;
	argstogo += funclist[i]->argnum-1;

	for (i=0;i<thisargs;i++)
	{
		SubInit(argstogo,depth-1,isfull);
		argstogo--;
	}
}

void Chrome::Traverse() {             // skip the next expression
	int args = 1;
	while (args > 0)
	{
				 args=args+ARGNUM()-1;
				 ip++;
	}
}


void Chrome::TraverseGlobal() {             // skip the next expression
	int args = 1;
	while (args > 0)
	{
				 args=args+PARGNUM(IP)-1;
				 IP++;
	}
}

				// Write the next subexpression to a stream
				// pretty flag controls parentheses, indenting
				// PRETTY_NONE = no indenting, just a stream, with parens
				// PRETTY_NOPARENS = indented, one function per line, no parens
				// PRETTY_PARENS = indented, one function per line, parens
void Chrome::SubWrite(ostream& ostr,int pretty) {
	int args,i;
	ip++;
	args = ARGNUM();
	if (pretty)                                     // indent?
	{
		ostr<< '\r' << '\n';
		for (i=0;i<depth;i++){
				ostr << " : ";
		}
	}
	else
		ostr << ' ';
	if (args>0)
	{                               // write (FUNC args)
		if (pretty != PRETTY_NOPARENS)
			ostr << '(';
		ostr << funclist[FUNCNUM(expr[ip])]->getprint(this);
		depth++;
		while (args-- > 0) SubWrite(ostr,pretty);
		depth--;
		if (pretty != PRETTY_NOPARENS)
			ostr << ")";
	}
	else {                          // write an atom
		ostr << funclist[FUNCNUM(expr[ip])]->getprint(this);
	}
}

Chrome* Chrome::CrossTree(Chrome* mate)
// Return a new Chrome that is a cross with mate

{
		Chrome* newexpr = Copy();
	int thislen;        // total length of expression
	int thissubptr;     // pointer to subexpression
	int thissublen;
	int matelen;
	int matesubptr;
	int matesublen;
	thislen=SubLen(0);
	matelen=mate->SubLen(0);
	if (rnd(101)>params->params[pUnRestrictWt])
	{
		thissubptr=GetIntNode();
		matesubptr=mate->GetIntNode();
	}
	else
    {
		thissubptr=GetAnyNode();
		matesubptr=mate->GetAnyNode();
	}
	thissublen = SubLen(thissubptr);
	matesublen=mate->SubLen(matesubptr);

	if (thislen+matesublen-thissublen > MaxExpr){      // take smaller side of swap
		memcpy(newexpr->expr,mate->expr,matesubptr*sizeof(node));
		memcpy(&(newexpr->expr[matesubptr]),&(expr[thissubptr]),thissublen*sizeof(node));
		memcpy(&(newexpr->expr[matesubptr+thissublen]),&(mate->expr[matesubptr+matesublen]),(matelen-(matesubptr+matesublen))*sizeof(node));
	}
	else {
		memcpy(newexpr->expr,expr,thissubptr*sizeof(node));
		memcpy(&(newexpr->expr[thissubptr]),&(mate->expr[matesubptr]),matesublen*sizeof(node));
		memcpy(&(newexpr->expr[thissubptr+matesublen]),&(expr[thissubptr+thissublen]),(thislen-(thissubptr+thissublen))*sizeof(node));
	}
	return newexpr;
}

int Chrome::GetAnyNode()                // get a node for crossover
{
	return rnd(SubLen(0));
}

int Chrome::GetIntNode()                // get an internal node for crossover
{
	int rval;
	int l=SubLen(0);
	if (l>2)
	{
		rval=rnd(l);
		while (funclist[FUNCNUM(expr[rval])]->argnum <1)
			rval=rnd(l);
	}
	else
		rval=0;
	return rval;
}

				// Mutate the current Chrome
void Chrome::Mutate()                   // mutate nodes with rate r
{
		int end,i,args;
	int rate=params->params[pMuteRate];
	ip=0;
	Traverse();
	end=ip;
	ip=0;
	while (ip<end)
	{
		if (rnd(1024) < rate)
		{
			args=ARGNUM();
			i=funcbag->roulette();
			while (funclist[i]->argnum!=args) i=funcbag->roulette();
			SETNODE(expr[ip],i,rnd(funclist[i]->varnum));
		}
		ip++;
	}
}


void Chrome::MutateC()                  // jiggle constants with a random walk 
{
	int i,end,newconst;
	int oldconst;
	int radius=8;
	ip= 0;
	Traverse();
	end=ip;
	ip=0;
	while (ip<end)
	{
				if (FUNCNUM(expr[ip])==0)
		{
			oldconst=VARNUM(expr[ip]);
			newconst=oldconst;
			for (i=0;i<radius;i++)
				newconst+=rnd(2);
			newconst-=radius/2;
			newconst=min(CONSTARRAYSIZE-1,max(newconst,0));
			if ((constlist[oldconst]>100 && constlist[newconst]<0) || (constlist[oldconst]<-100 && constlist[newconst]>0))  // overrun?
		newconst=oldconst;
			SETNODE(expr[ip],0,newconst);
		}
	ip++;
    }
}


void Chrome::MutateShrink()             // shrink by promoting a subtree
{
	int tree,treelen,subtree,subtreelen,l;
	node *temp;
	int argnum;
	argnum=0;
	l=SubLen(0);
	if (l>argnum+1)
    {
		// node required
		temp = new node[MaxExpr];
		if (temp==NULL) NoMoreMem();		// Out of memory?
		tree=rnd(l);
		while (funclist[FUNCNUM(expr[tree])]->argnum == 0) tree=rnd(l);

		// now pick a subtree
		treelen=SubLen(tree);
		subtree=tree+rnd(treelen-1)+1;
	subtreelen=SubLen(subtree);

		memcpy(temp,expr,l*sizeof(node));               // save the old expr
		memcpy(expr+tree,temp+subtree,subtreelen*sizeof(node)); // add the subtree
		memcpy(expr+tree+subtreelen,temp+tree+treelen,sizeof(node)*(l-(tree+treelen)));         // add the rest
		delete[] temp;
    }
}

int Chrome::Load(istream& ifile,int issource)
// Load an expression from a stream
// issource should always be TRUE

{
	int x,tempop, tempidx;
	int rval=LOAD_OK;
	node* buf;

	if (!issource)
	{
		for(x=0;x<MaxExpr;x++)
		{
			ifile >> tempop;
			expr[x].op =(unsigned) tempop;
			ifile >> tempidx;
			expr[x].idx=(unsigned) tempidx;
		}
	}
	else            // load a Source file
	{
		ip=0;
		buf=new node[MaxExpr];
		if (buf==NULL) NoMoreMem();		// Out of memory?
		if ((rval=SubLoad(ifile,buf)) == LOAD_OK)
		{
			delete[] expr;
			expr=buf;
		} else
			delete[] buf;
	}
	return rval;
}

#define EATSPACE c=istr.peek();while(isspace(c)||c==':') {istr.get();c=istr.peek();}
#define GETTOK tp=0;c=istr.peek();while(c!=EOF && !isspace(c) && c!=':' && c!='(' && c!=')' &&tp<79) {scratch[tp++]=istr.get(); c=istr.peek();} scratch[tp]='\0'

int Chrome::SubLoad(istream& istr,node* buf)
// load a sub-expression from source format
// Return LOAD_OK or an error value
// text expression is in istr
// nodes go into buf

{
	int rval = LOAD_OK;
	char c;
//      char token[80];
	int tp;
	int func;
	int args;
	int vnum;
	char* s;
	scratch[0]='\0';
	EATSPACE;
	if (istr.peek()==')' || istr.peek()==EOF)
	{
		rval=LOAD_TOOFEW;                       // missing expression body
	}
	else if (ip>=MaxExpr)
	{
		rval=LOAD_TOOLONG;
	}
	else if (istr.peek()=='(')              // Get an expression and the close paren
	{
		istr >> c;
		rval = SubLoad(istr,buf);
		if (rval==LOAD_OK)
	{
			EATSPACE;
			istr >> c;
			if (c!=')')
				rval=LOAD_TOOMANY;
	}
	}
	else                            // Get an expression.  Return if you hit a close paren.
	{
		GETTOK;
		if (strlen(scratch)==0)
			rval=LOAD_TOOFEW;
		else
		{
			if (isdigit(scratch[0]) || scratch[0]=='-')     // it's a number.  Function 0
			{
				func=atoi(scratch);
				if (func>=0-CONSTARRAYSIZE/2 && func<CONSTARRAYSIZE/2)
				{
					SETNODE(buf[ip],0,func+CONSTARRAYSIZE/2);
					ip++;
					rval=LOAD_OK;
				}
				else rval=LOAD_BADCONST;
			}
			else       // look up a function name
			{
				vnum=0;
				if (strchr(scratch,'_')!=NULL)
				{
					// parse it to take off the variable number?
					// This is fancy footwork for functions with operands
					// Except for NUMBER (function 0) these functions are
					// written as <name>_operand
					s=strrchr(scratch,'_');
					if (strchr("0123456789",s[1]))  // it is an underscore followed by numbers