ga_optim.c

关于遗传算法的一些见地。特别是关于简单遗传程序设计的实现。

/**********************************************************************
  ga_optim.c
 **********************************************************************

  ga_optim - Optimisation and evolution routines.
  Copyright ©2000-2005, Stewart Adcock <[e-mail]>
  All rights reserved.

  The latest version of this program should be available at:
  http://gaul.sourceforge.net/

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.  Alternatively, if your project
  is incompatible with the GPL, I will probably agree to requests
  for permission to use the terms of any other license.

  This program is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY WHATSOEVER.

  A full copy of the GNU General Public License should be in the file
  "COPYING" provided with this distribution; if not, see:
  http://www.gnu.org/

 **********************************************************************

  Synopsis:     Routines for optimisation and evolution.

                Note that the temperatures in the simulated annealling
                and MC functions do not exactly run from the initial
                temperature to the final temperature.  They are offset
                slightly so that sequential calls to these functions
                will have a linear temperature change.  The SA and MC
		code in this file is deprecated anyway - these routines
		have been replaced with much more flexible alternatives
		and will be removed in the near future.

  To do:	Finish rewriting parallel versions, ga_evolution_mp() in particular.
		Write ga_evolution_pvm().
		Need to fix elitism/crowding stuff.
		Remove much duplicated code.
		OpenMOSIX fix.  See below.
		gaul_adapt_and_evaluate_forked() and gaul_adapt_and_evaluate_threaded() are only parallelized for the case that no adaptation occurs.

 **********************************************************************/

#include "gaul/ga_optim.h"

/*
 * Here is a kludge.
 *
 * This constant, if defined, causes a 10 microsecond delay to be
 * inserted after each fork() call.  It shouldn't be needed, but
 * apparently on OpenMOSIX lots of processes started at the same
 * time cause all sorts of problems (mostly bus errors).  This
 * delay gives OpenMOSIX a chance to migrate some processes to
 * other nodes before this becomes a problem (hopefully).
 *
 * A long-term fix fix will be to check the return value from the
 * forked processes and repeat them if they died.  This may be
 * added... eventually.
 *
 * I don't think this is needed anymore for recent versions of
 * OpenMOSIX.
 */
#define NEED_MOSIX_FORK_HACK 1

#if HAVE_MPI == 1
/*
 * Convenience wrappers around MPI functions:
 *
 * These are used in the *_mp() functions.
 */
static int	rank=-1;				/* Current process's rank. */
static int	size=0;					/* Total number of processes. */
static int	namelen;				/* Length of processor name. */
static char	node_name[MPI_MAX_PROCESSOR_NAME];	/* String containing processor name. */

/*
 * MPI tags.
 */
#define GA_TAG_SLAVE_NOTIFICATION	1001
#define GA_TAG_BUFFER_LEN		1002
#define GA_TAG_INSTRUCTION		1003
#define GA_TAG_FITNESS			1004
#define GA_TAG_CHROMOSOMES		1005

/**********************************************************************
  mpi_init()
  synopsis:	Ensure that MPI is initialised and prepare some global
		variables.
  parameters:
  return:	TRUE if master process, FALSE otherwise.
  last updated:	23 Sep 2003
 **********************************************************************/

static void mpi_init(void)
  {

  if (rank==-1)
    {
/*
 * FIXME: Test for prior MPI_Init() call here.
 */
    MPI_Comm_size(MPI_COMM_WORLD, &size);
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    MPI_Get_processor_name(node_name, &namelen);
    }

  return;
  }


/**********************************************************************
  mpi_ismaster()
  synopsis:	Is this the master process?
  parameters:
  return:	TRUE if master process, FALSE otherwise.
  last updated:	03 Feb 2003
 **********************************************************************/

static boolean mpi_ismaster(void)
  {
  return (rank==0);
  }


/**********************************************************************
  mpi_get_num_processes()
  synopsis:	Return the total number of MPI processes.
  parameters:
  return:	int	number of processes.
  last updated:	03 Feb 2003
 **********************************************************************/

static int mpi_get_num_processes(void)
  {
  return (size);
  }


/**********************************************************************
  mpi_get_rank()
  synopsis:	Return the rank of this process.
  parameters:
  return:	int	rank
  last updated:	03 Feb 2003
**********************************************************************/

static int mpi_get_rank(void)
  {
  return (rank);
  }


/**********************************************************************
  mpi_get_next_rank()
  synopsis:	Return the rank of the next node in a circular
		topology.
  parameters:
  return:	int	rank
  last updated:	03 Feb 2003
 **********************************************************************/

static int mpi_get_next_rank(void)
  {
  int	next=rank+1;		/* The rank of the next process */

  if (next==size) next=0;	/* Last process sends to first process */

  return (next);
  }


/**********************************************************************
  mpi_get_prev_rank()
  synopsis:	Return the rank of the previous node in a circular
		topology.
  parameters:
  return:	int	rank
  last updated:	03 Feb 2003
 **********************************************************************/

static int mpi_get_prev_rank(void)
  {
  int	prev=rank;		/* The rank of the previous process */

  if (prev==0) prev=size;	/* First process sends to last process */

  return (prev-1);
  }


/**********************************************************************
  gaul_bond_slaves_mpi()
  synopsis:	Register, set up and synchronise slave processes.
  parameters:	population *pop
  return:	none
  last updated:	10 May 2004
 **********************************************************************/

static void gaul_bond_slaves_mpi(population *pop, int buffer_len, int buffer_max)
  {
  int		i;			/* Loop variable over slave processes. */
  int		mpi_rank;		/* Rank of slave process. */
  int		mpi_size;		/* Number of slave processes. */
  MPI_Status	status;			/* MPI status structure. */
  int		two_int[2];		/* Send buffer. */

  MPI_Comm_size(MPI_COMM_WORLD, &mpi_size);

  two_int[0] = buffer_len;
  two_int[1] = buffer_max;

/*
 * Listen for all slave processes.
 */
  for (i=1; i<mpi_size; i++)
    {
    MPI_Recv(&mpi_rank, 1, MPI_INT, MPI_ANY_SOURCE, GA_TAG_SLAVE_NOTIFICATION, MPI_COMM_WORLD, &status);
    /* FIXME: Check status here. */

/*
 * Send slave the buffer length that it will require.
 */
    MPI_Send(two_int, 2, MPI_INT, status.MPI_SOURCE, GA_TAG_BUFFER_LEN, MPI_COMM_WORLD);
    }

  return;
  }


/**********************************************************************
  gaul_debond_slaves_mpi()
  synopsis:	Release and synchronise slave processes.
  parameters:	population *pop
  return:	none
  last updated:	10 May 2004
 **********************************************************************/

static void gaul_debond_slaves_mpi(population *pop)
  {
  int		i;			/* Loop variable over slave processes. */
  int		instruction=1;		/* New population instruction. */
  int		mpi_size;		/* Number of slave processes. */

  MPI_Comm_size(MPI_COMM_WORLD, &mpi_size);

/*
 * Send instructions to all slave processes.
 */
  for (i=1; i<mpi_size; i++)
    {
/*    printf("DEBUG: Sending debond instruction to %d\n", i);*/
    MPI_Send(&instruction, 1, MPI_INT, i, GA_TAG_INSTRUCTION, MPI_COMM_WORLD);
    }

  return;
  }

#endif


/**********************************************************************
  ga_attach_mpi_slave()
  synopsis:	Slave MPI process routine.
  parameters:	none
  return:	none
  last updated:	10 May 2004
 **********************************************************************/

void ga_attach_mpi_slave( population *pop )
  {
#if HAVE_MPI == 1
  MPI_Status	status;			/* MPI status structure. */
  int		single_int;		/* Receive buffer. */
  byte		*buffer=NULL;		/* Receive buffer. */
  byte		*chromo=NULL;		/* Chromosome. */
  boolean	finished=FALSE;		/* Whether this slave is done. */
  entity	*entity, *adult;	/* Received entity, adapted entity. */
  int		buffer_len=0;		/* Length of buffer to receive. */
  int		buffer_max=0;		/* Chromosome byte representation length. */
  int		mpi_rank;		/* Rank of MPI process; should never be 0 here. */
  int		two_int[2];		/* Send buffer. */

/*
 * Rank zero process is master.  This handles evolution.  Other processes are slaves
 * which simply evaluate entities, and should be attached using ga_attach_slave().
 */
  MPI_Comm_rank(MPI_COMM_WORLD, &mpi_rank);
  if (mpi_rank == 0) die("ga_attach_mpi_slave() called by process with rank=0.");

/*
 * Send notification to master.
 */
/*  printf("DEBUG: Process %d notifying master\n", mpi_rank);*/
  MPI_Send(&mpi_rank, 1, MPI_INT, 0, GA_TAG_SLAVE_NOTIFICATION, MPI_COMM_WORLD);

/*
 * Allocate chromosome transfer buffer.
 */
  MPI_Recv(two_int, 2, MPI_INT, 0, GA_TAG_BUFFER_LEN, MPI_COMM_WORLD, &status);
  buffer_len = two_int[0];
  buffer_max = two_int[1];
  buffer = s_malloc(buffer_len*sizeof(byte));

/* printf("DEBUG: slave buffer len %d %d\n", buffer_len, buffer_max);*/

/*
 * Enter task loop.
 */
  do
    {
/*
 * Recieve instruction packet.
 */
    MPI_Recv(&single_int, 1, MPI_INT, 0, GA_TAG_INSTRUCTION, MPI_COMM_WORLD, &status);

/*    printf("DEBUG: slave %d recieved instruction %d\n", mpi_rank, single_int);*/

    switch (single_int)
      {
      case 0:
        /* No more jobs. */
/*        printf("DEBUG: slave %d recieved detach instruction.\n", mpi_rank);*/
        finished=TRUE;
        break;
      case 1:
        /* Prepare for calculations with a new population. */
/* FIXME: Incomplete. */
        MPI_Send(&mpi_rank, 1, MPI_INT, 0, GA_TAG_SLAVE_NOTIFICATION, MPI_COMM_WORLD);
        MPI_Recv(two_int, 2, MPI_INT, 0, GA_TAG_BUFFER_LEN, MPI_COMM_WORLD, &status);
        break;
      case 2:
        /* Evaluation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(buffer, buffer_len, MPI_CHAR, 0, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
        pop->chromosome_from_bytes(pop, entity, buffer);
        if ( pop->evaluate(pop, entity) == FALSE )
          entity->fitness = GA_MIN_FITNESS;
        MPI_Send(&(entity->fitness), 1, MPI_DOUBLE, 0, GA_TAG_FITNESS, MPI_COMM_WORLD);
        ga_entity_dereference(pop, entity);
        break;
      case 3:
        /* Baldwinian adaptation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(buffer, buffer_len, MPI_CHAR, 0, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
        pop->chromosome_from_bytes(pop, entity, buffer);
        adult = pop->adapt(pop, entity);
        MPI_Send(&(adult->fitness), 1, MPI_DOUBLE, 0, GA_TAG_FITNESS, MPI_COMM_WORLD);
        ga_entity_dereference(pop, entity);
        ga_entity_dereference(pop, adult);
        break;
      case 4:
        /* Lamarkian adaptation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(buffer, buffer_len, MPI_CHAR, 0, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
        pop->chromosome_from_bytes(pop, entity, buffer);
        adult = pop->adapt(pop, entity);
        MPI_Send(&(adult->fitness), 1, MPI_DOUBLE, 0, GA_TAG_FITNESS, MPI_COMM_WORLD);
        if (buffer_max==0)
          {
          pop->chromosome_to_bytes(pop, adult, &chromo, &buffer_max);
          MPI_Send(chromo, buffer_len, MPI_CHAR, 0, GA_TAG_CHROMOSOMES, MPI_COMM_WORLD);
          }
        else
          {
          pop->chromosome_to_bytes(pop, adult, &buffer, &buffer_len);
          MPI_Send(buffer, buffer_len, MPI_CHAR, 0, GA_TAG_CHROMOSOMES, MPI_COMM_WORLD);
          }
        ga_entity_dereference(pop, entity);
        ga_entity_dereference(pop, adult);
        break;
      default:
        dief("Unknown instruction type packet recieved (%d).", single_int);
      }

    } while (finished==FALSE);

/*
 * Clean-up and exit.
 */
  if (buffer != NULL)
    s_free(buffer);

#else
  plog(LOG_WARNING, "Attempt to use parallel function without compiled support.");
#endif

  return;
  }


/**********************************************************************
  ga_detach_mpi_slaves()
  synopsis:	Allow all slave processes to continue past the
		ga_attach_mpi_slave() routine.
  parameters:	none
  return:	none
  last updated:	10 May 2004
 **********************************************************************/

void ga_detach_mpi_slaves(void)
  {
#if HAVE_MPI == 1
  int		i;			/* Loop variable over slave processes. */
  int		instruction=0;		/* Detach instruction. */
  int		mpi_size;		/* Number of slave processes. */
  int		mpi_rank;		/* Rank of MPI process; should never be 0 here. */
  int		two_int[2]={0,0};	/* Send buffer. */
  MPI_Status	status;			/* MPI status structure. */

  MPI_Comm_size(MPI_COMM_WORLD, &mpi_size);
  MPI_Comm_rank(MPI_COMM_WORLD, &mpi_rank);

/*
 * Listen for all slave processes.
 * FIXME: This shouldn't be needed really.
 */
  for (i=1; i<mpi_size; i++)