ga_optim.c

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

    {
    MPI_Recv(&mpi_rank, 1, MPI_INT, MPI_ANY_SOURCE, GA_TAG_SLAVE_NOTIFICATION, MPI_COMM_WORLD, &status);

/*
 * 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);
    }

  for (i=1; i<mpi_size; i++)
    {
/*    printf("DEBUG: Sending detach instruction to %d\n", i);*/
    MPI_Send(&instruction, 1, MPI_INT, i, GA_TAG_INSTRUCTION, MPI_COMM_WORLD);
    }

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

  return;
  }


/**********************************************************************
  gaul_entity_swap_rank()
  synopsis:	Swap the ranks of a pair of entities.
  parameters:	population *pop
		const int rank1
		const int rank2
  return:	none
  last updated:	11 Jun 2002
 **********************************************************************/

static void gaul_entity_swap_rank(population *pop, const int rank1, const int rank2)
  {
  entity	*tmp;		/* Swapped entity. */

  tmp = pop->entity_iarray[rank1];
  pop->entity_iarray[rank1] = pop->entity_iarray[rank2];
  pop->entity_iarray[rank2] = tmp;

  return;
  }


/**********************************************************************
  gaul_migration()
  synopsis:	Migration cycle.
  parameters:	population *pop
  return:	none
  last updated:	11 Jun 2002
 **********************************************************************/

static void gaul_migration(const int num_pops, population **pops)
  {
  int		pop0_osize;		/* Required for correct migration. */
  int		current_island;			/* Current current_island number. */
  int		i;			/* Loop over members of population. */

  plog( LOG_VERBOSE, "*** Migration Cycle ***" );

  pop0_osize = pops[0]->size;
  for(current_island=1; current_island<num_pops; current_island++)
    {
    for(i=0; i<pops[current_island]->size; i++)
      {
      if (random_boolean_prob(pops[current_island]->migration_ratio))
        {
        ga_entity_clone(pops[current_island-1], pops[current_island]->entity_iarray[i]);
/* printf("%d, %d: Cloned %d %f\n", mpi_get_rank(), current_island, i, pops[current_island]->entity_iarray[i]->fitness);*/
        }
      }
    }

  for(i=0; i<pop0_osize; i++)
    {
    if (random_boolean_prob(pops[0]->migration_ratio))
      ga_entity_clone(pops[num_pops-1], pops[0]->entity_iarray[i]);
/*  printf("%d, 0: Cloned %d %f\n", mpi_get_rank(), i, pops[current_island]->entity_iarray[i]->fitness);*/
    }

/*
 * Sort the individuals in each population.
 * Need this to ensure that new immigrants are ranked correctly.
 * FIXME: It would be more efficient to insert the immigrants correctly.
 */
#pragma omp parallel for \
   shared(pops,num_pops) private(current_island) \
   schedule(static)
  for(current_island=0; current_island<num_pops; current_island++)
    {
    sort_population(pops[current_island]);
    }

  return;
  }


/**********************************************************************
  gaul_crossover()
  synopsis:	Mating cycle. (i.e. Sexual reproduction).
  parameters:	population *pop
  return:	none
  last updated:	11 Jun 2002
 **********************************************************************/

static void gaul_crossover(population *pop)
  {
  entity	*mother, *father;	/* Parent entities. */
  entity	*son, *daughter;	/* Child entities. */

  plog(LOG_VERBOSE, "*** Mating cycle ***");

  if (pop->crossover_ratio <= 0.0) return;

  pop->select_state = 0;

  /* Select pairs of entities to mate via crossover. */
#pragma intel omp parallel taskq
  while ( !(pop->select_two(pop, &mother, &father)) )
    {

    if (mother && father)
      {
#pragma intel omp task \
  private(son,daughter) captureprivate(mother,father)
        {
        plog(LOG_VERBOSE, "Crossover between %d (rank %d fitness %f) and %d (rank %d fitness %f)",
             ga_get_entity_id(pop, mother),
             ga_get_entity_rank(pop, mother), mother->fitness,
             ga_get_entity_id(pop, father),
             ga_get_entity_rank(pop, father), father->fitness);

        son = ga_get_free_entity(pop);
        daughter = ga_get_free_entity(pop);
        pop->crossover(pop, mother, father, daughter, son);
        }
      }
    else
      {
      plog( LOG_VERBOSE, "Crossover not performed." );
      }
    }

  return;
  }


/**********************************************************************
  gaul_mutation()
  synopsis:	Mutation cycle.  (i.e. Asexual reproduction)
  parameters:	population *pop
  return:	none
  last updated:	11 Jun 2002
 **********************************************************************/

static void gaul_mutation(population *pop)
  {
  entity	*mother;		/* Parent entities. */
  entity	*daughter;		/* Child entities. */

  plog(LOG_VERBOSE, "*** Mutation cycle ***");

  if (pop->mutation_ratio <= 0.0) return;

  pop->select_state = 0;

  /*
   * Select entities to undergo asexual reproduction, in each case the child will
   * have a genetic mutation of some type.
   */
#pragma intel omp parallel taskq
  while ( !(pop->select_one(pop, &mother)) )
    {

    if (mother)
      {
#pragma intel omp task \
  private(daughter) captureprivate(mother)
        {
        plog(LOG_VERBOSE, "Mutation of %d (rank %d fitness %f)",
             ga_get_entity_id(pop, mother),
             ga_get_entity_rank(pop, mother), mother->fitness );

        daughter = ga_get_free_entity(pop);
        pop->mutate(pop, mother, daughter);
        }
      }
    else
      {
      plog( LOG_VERBOSE, "Mutation not performed." );
      }
    }

  return;
  }


/**********************************************************************
  gaul_evaluation_slave_mp()
  synopsis:	Fitness evaluations and adaptations are performed here.
  parameters:	population *pop
  return:	none
  last updated:	03 Feb 2003
 **********************************************************************/

#if HAVE_MPI == 1
static void gaul_evaluation_slave_mp(population *pop)
  {
  MPI_Status	status;			/* MPI status structure. */
  int		single_int;		/* Receive buffer. */
  byte		*buffer;		/* Receive buffer. */
  boolean	finished=FALSE;		/* Whether this slave is done. */
  entity	*entity, *adult;	/* Received entity, adapted entity. */
  int	len=0;			/* Length of buffer to receive. */

/*
 * Allocate receive buffer.
 * FIXME: This length data shouldn't be needed!
 */
  MPI_Recv(&len, 1, MPI_INT, 0, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
  buffer = s_malloc(len*sizeof(byte));

/*printf("DEBUG: slave %d recieved %d (len)\n", rank, len);*/

/*
 * Instruction packet.
 */
  do
    {
    MPI_Recv(&single_int, 1, MPI_INT, 0, MPI_ANY_TAG, MPI_COMM_WORLD, &status);

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

    switch (single_int)
      {
      case 0:
        /* Evaluation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(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, 0, MPI_COMM_WORLD);
        break;
      case 1:
        /* Baldwinian adaptation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(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, 0, MPI_COMM_WORLD);
        break;
      case 2:
        /* Lamarkian adaptation required. */
        entity = ga_get_free_entity(pop);
        MPI_Recv(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, 0, MPI_COMM_WORLD);
        pop->chromosome_to_bytes(pop, adult, &buffer, &len);
        MPI_Send(buffer, len, MPI_CHAR, 0, 0, MPI_COMM_WORLD);
        break;
      case 3:
        /* No more jobs. */
        finished=TRUE;
        break;
      default:
        die("Unknown instruction packet recieved");
      }

    } while (finished==FALSE);

/*
 * Synchronise population on this process with that on the master process.
 */
  ga_genocide(pop,0);
  ga_population_append_receive(pop, 0);

  s_free(buffer);

  return;
  }
#endif


/**********************************************************************
  gaul_ensure_evaluations()
  synopsis:	Fitness evaluations.
		Evaluate all previously unevaluated entities.
		No adaptation.
  parameters:	population *pop
  return:	none
  last updated:	01 Jul 2004
 **********************************************************************/

static void gaul_ensure_evaluations(population *pop)
  {
  int		i;			/* Loop variable over entity ranks. */

#pragma omp parallel for \
   shared(pop) private(i) \
   schedule(static)
  for (i=0; i<pop->size; i++)
    {
/*printf("DEBUG: gaul_ensure_evaluations() parallel for %d on %d/%d.\n", i, omp_get_thread_num(), omp_get_num_threads());*/
    if (pop->entity_iarray[i]->fitness == GA_MIN_FITNESS)
      {
      if ( pop->evaluate(pop, pop->entity_iarray[i]) == FALSE )
        pop->entity_iarray[i]->fitness = GA_MIN_FITNESS;
      }
    }

  return;
  }


/**********************************************************************
  gaul_ensure_evaluations_mp()
  synopsis:	Fitness evaluations.
		Evaluate all previously unevaluated entities.
		No adaptation.
  parameters:	population *pop
  return:	none
  last updated:	03 Feb 2003
 **********************************************************************/

#if HAVE_MPI == 1
static void gaul_ensure_evaluations_mp(population *pop)
  {
  int		i;			/* Loop variable over entity ranks. */

  plog(LOG_FIXME, "Need to parallelise this!");

  for (i=0; i<pop->size; i++)
    {
    if (pop->entity_iarray[i]->fitness == GA_MIN_FITNESS)
      if ( pop->evaluate(pop, pop->entity_iarray[i]) == FALSE )
        pop->entity_iarray[i]->fitness = GA_MIN_FITNESS;
    }

  return;
  }
#endif


/**********************************************************************
  gaul_ensure_evaluations_mpi()
  synopsis:	Fitness evaluations.
		Evaluate all previously unevaluated entities.
		No adaptation.
  parameters:	population *pop
  return:	none
  last updated:	10 May 2004
 **********************************************************************/

#if HAVE_MPI == 1
static void gaul_ensure_evaluations_mpi( population *pop, int *eid,
                        byte *buffer, int buffer_len, int buffer_max )
  {
  MPI_Status	status;			/* MPI status structure. */
  double	single_double;		/* Recieve buffer. */
  int		instruction=2;		/* Detach instruction. */
  int		mpi_size;		/* Number of slave processes. */
  int		process_num;		/* Number of remote processes running calculations. */
  int		eval_num;		/* Id of entity being processed. */
  byte		*chromo=NULL;		/* Chromosome in byte form. */

  MPI_Comm_size(MPI_COMM_WORLD, &mpi_size);

/*
 * A process is notifed to begin each fitness evaluation until
 * all processes are busy, at which point we wait for
 * results before initiating more.
 *
 * Skip evaluations for entities that have been previously evaluated.
 */
  process_num = 0;
  eval_num = 0;

  /* Skip to the next entity which needs evaluating. */
  while (eval_num < pop->size && pop->entity_iarray[eval_num]->fitness!=GA_MIN_FITNESS) eval_num++;

  while (process_num < mpi_size-1 && eval_num < pop->size)
    {
    eid[process_num] = eval_num;

/* Send instruction and required data. */
    MPI_Send(&instruction, 1, MPI_INT, process_num+1, GA_TAG_INSTRUCTION, MPI_COMM_WORLD);
    if (buffer_max==0)
      {
      pop->chromosome_to_bytes(pop, pop->entity_iarray[eval_num], &chromo, &buffer_max);
      MPI_Send(chromo, buffer_len, MPI_CHAR, process_num+1, GA_TAG_CHROMOSOMES, MPI_COMM_WORLD);
      }
    else
      {
      pop->chromosome_to_bytes(pop, pop->entity_iarray[eval_num], &buffer, &buffer_len);
      MPI_Send(buffer, buffer_len, MPI_CHAR, process_num+1, GA_TAG_CHROMOSOMES, MPI_COMM_WORLD);
      }

    process_num++;
    eval_num++;

    /* Skip to the next entity which needs evaluating. */
    while (eval_num < pop->size && pop->entity_iarray[eval_num]->fitness!=GA_MIN_FITNESS) eval_num++;
    }

  while (process_num > 0)
    { /* Wait for a process to finish. */
    MPI_Recv(&single_double, 1, MPI_DOUBLE, MPI_ANY_SOURCE, GA_TAG_FITNESS, MPI_COMM_WORLD, &status);
    /* FIXME: Check status here. */

    /* Find which entity this process was evaluating. */
    if (eid[status.MPI_SOURCE-1] == -1) die("Internal error.  eid is -1");

    pop->entity_iarray[eid[status.MPI_SOURCE-1]]->fitness = single_double;

    if (eval_num < pop->size)
      {
      eid[status.MPI_SOURCE-1] = eval_num;