ga_intrinsics.c

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

  ga_slang_seed()
  synopsis:	Handle S-Lang based seeding operator.
  parameters:
  return:
  last updated:	13 Jun 2002
 **********************************************************************/

static boolean ga_slang_seed(population *pop, entity *adam)
  {

  plog(LOG_FIXME, "ga_slang_seed() is not implemented.");

  return TRUE;
  }


/**********************************************************************
  ga_slang_select_one()
  synopsis:	Handle S-Lang based single selection operator.
  parameters:
  return:
  last updated:	24/04/01
 **********************************************************************/

static boolean ga_slang_select_one(population *pop, entity **mother)
  {

  plog(LOG_FIXME, "ga_slang_select_one() is not implemented.");

  return TRUE;
  }


/**********************************************************************
  ga_slang_select_two()
  synopsis:	Handle S-Lang based double selection operator.
  parameters:
  return:
  last updated:	24/04/01
 **********************************************************************/

static boolean ga_slang_select_two(population *pop, entity **mother, entity **father)
  {

  plog(LOG_FIXME, "ga_slang_select_two() is not implemented.");

  return TRUE;
  }


/**********************************************************************
  ga_slang_adapt()
  synopsis:	Handle S-Lang based adaption operator.
  parameters:
  return:
  last updated:	24/04/01
 **********************************************************************/

static entity *ga_slang_adapt(population *pop, entity *child)
  {
  entity	*adult;		/* Optimised entity. */

/* Checks */
  if (!pop) die("Null pointer to population structure passed.");
  if (!child) die("Null pointer to entity structure passed.");

  adult = ga_get_free_entity(pop);

  if ( SLang_run_hooks( "adapt_hook", 3,
                        ga_get_population_id(pop), 
                        ga_get_entity_id(pop, child), 
                        ga_get_entity_id(pop, adult)) == -1 )
    die("Error calling S-Lang function \"adapt_hook\".");

  return adult;
  }


/**********************************************************************
  ga_slang_crossover()
  synopsis:	Handle S-Lang based crossover operator.
  parameters:
  return:
  last updated:	24/04/01
 **********************************************************************/

static void ga_slang_crossover(population *pop, entity *father, entity *mother, entity *daughter, entity *son)
  {

/* Checks */
  if (!pop) die("Null pointer to population structure passed.");
  if (!father || !mother || !son || !daughter)
    die("Null pointer to entity structure passed.");

  if ( SLang_run_hooks( "crossover_hook", 5,
                        ga_get_population_id(pop), 
                        ga_get_entity_id(pop, father), 
                        ga_get_entity_id(pop, mother), 
                        ga_get_entity_id(pop, son), 
                        ga_get_entity_id(pop, daughter)) == -1 )
    die("Error calling S-Lang function \"crossover_hook\".");

  return;
  }


/**********************************************************************
  ga_slang_mutate()
  synopsis:	Handle S-Lang based mutation operator.
  parameters:
  return:
  last updated:	24/04/01
 **********************************************************************/

static void ga_slang_mutate(population *pop, entity *father, entity *son)
  {

/* Checks */
  if (!pop) die("Null pointer to population structure passed.");
  if (!father || !son) die("Null pointer to entity structure passed.");

#if 0
/*
 * Duplicate the initial data.
 */
  for (i=0; i<pop->num_chromosomes; i++)
    {
    memcpy(son->chromosome[i], father->chromosome[i], pop->len_chromosomes*sizeof(int));
    ga_copy_data(pop, son, father, i);
    }
#endif

  if ( SLang_run_hooks( "mutate_hook", 3,
                        ga_get_population_id(pop), 
                        ga_get_entity_id(pop, father), 
                        ga_get_entity_id(pop, son)) == -1 )
    die("Error calling S-Lang function \"mutate_hook\".");

  return;
  }


/**********************************************************************
  ga_slang_replace()
  synopsis:	Handle S-Lang based replacement operator.
  parameters:
  return:
  last updated:	08 Apr 2003
 **********************************************************************/

static void ga_slang_replace(population *pop, entity *child)
  {

/* Checks */
  if (!pop) die("Null pointer to population structure passed.");
  if (!child) die("Null pointer to entity structure passed.");

  if ( SLang_run_hooks( "replace_hook", 2,
                        ga_get_population_id(pop), 
                        ga_get_entity_id(pop, child)) == -1 )
    die("Error calling S-Lang function \"replace_hook\".");

  return;
  }
#endif
#endif


/**********************************************************************
  ga_intrinsic_sladd()
  synopsis:	Register the S-Lang intrinsics.
  parameters:	none
  return:	success/failure.
  last updated:	18 Mar 2003
 **********************************************************************/

#if HAVE_SLANG==0
boolean ga_intrinsic_sladd(void)
  {
  plog(LOG_WARNING, "No S-Lang support compiled into GAUL.");
  return TRUE;
  }
#else

boolean ga_intrinsic_sladd(void)
  {
  static double	fitnessmin=GA_MIN_FITNESS;      /* Minimum fitness. */
  static int	schemes[7]={GA_SCHEME_DARWIN, GA_SCHEME_LAMARCK_PARENTS, GA_SCHEME_LAMARCK_CHILDREN, GA_SCHEME_LAMARCK_ALL, GA_SCHEME_BALDWIN_PARENTS, GA_SCHEME_BALDWIN_CHILDREN, GA_SCHEME_BALDWIN_ALL};
  static int	elitism[5]={GA_ELITISM_UNKNOWN, GA_ELITISM_PARENTS_SURVIVE, GA_ELITISM_ONE_PARENT_SURVIVES, GA_ELITISM_PARENTS_DIE, GA_ELITISM_RESCORE_PARENTS};

  if (  SLadd_intrinsic_variable("GA_SCHEME_DARWIN", &(schemes[0]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_LAMARCK_PARENTS", &(schemes[1]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_LAMARCK_CHILDREN", &(schemes[2]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_LAMARCK_ALL", &(schemes[3]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_BALDWIN_PARENTS", &(schemes[4]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_BALDWIN_CHILDREN", &(schemes[5]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_SCHEME_BALDWIN_ALL", &(schemes[6]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_ELITISM_UNKNOWN", &(elitism[0]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_ELITISM_PARENTS_SURVIVE", &(elitism[1]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_ELITISM_ONE_PARENT_SURVIVES", &(elitism[2]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_ELITISM_PARENTS_DIE", &(elitism[3]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_ELITISM_RESCORE_PARENTS", &(elitism[4]), SLANG_INT_TYPE, TRUE)
     || SLadd_intrinsic_variable("GA_FITNESS_MIN", &fitnessmin, SLANG_DOUBLE_TYPE, TRUE)
     ) return FALSE;

  if (
         SLadd_intrinsic_function("ga_population_new",
            (FVOID_STAR) ga_population_new_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_seed",
            (FVOID_STAR) ga_entity_seed_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_id_from_rank",
            (FVOID_STAR) ga_entity_id_from_rank_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_rank_from_id",
            (FVOID_STAR) ga_entity_rank_from_id_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_seed",
            (FVOID_STAR) ga_population_seed_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_write",
            (FVOID_STAR) ga_population_write_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_STRING_TYPE)
      || SLadd_intrinsic_function("ga_population_read",
            (FVOID_STAR) ga_population_read_slang, SLANG_INT_TYPE, 1,
            SLANG_STRING_TYPE)
      || SLadd_intrinsic_function("ga_entity_write",
            (FVOID_STAR) ga_entity_write_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_STRING_TYPE)
      || SLadd_intrinsic_function("ga_entity_read",
            (FVOID_STAR) ga_entity_read_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_STRING_TYPE)
      || SLadd_intrinsic_function("ga_entity_kill",
            (FVOID_STAR) ga_entity_kill_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_erase",
            (FVOID_STAR) ga_entity_erase_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_new",
            (FVOID_STAR) ga_entity_new_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_clone",
            (FVOID_STAR) ga_entity_clone_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_copy_chromosome",
            (FVOID_STAR) ga_entity_copy_chromosome_slang, SLANG_INT_TYPE, 4,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_copy_all_chromosomes",
            (FVOID_STAR) ga_entity_copy_all_chromosomes_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_evolution",
            (FVOID_STAR) ga_evolution_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_evolution_forked",
            (FVOID_STAR) ga_evolution_forked_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_evolution_threaded",
            (FVOID_STAR) ga_evolution_threaded_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
/*
      || SLadd_intrinsic_function("ga_evolution_mpi",
            (FVOID_STAR) ga_evolution_mpi_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
*/
      || SLadd_intrinsic_function("ga_population_set_parameters",
            (FVOID_STAR) ga_population_set_parameters_slang, SLANG_INT_TYPE, 6,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE)
      || SLadd_intrinsic_function("ga_population_get_size",
            (FVOID_STAR) ga_population_get_size_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_maxsize",
            (FVOID_STAR) ga_population_get_maxsize_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_stablesize",
            (FVOID_STAR) ga_population_get_stablesize_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_set_stablesize",
            (FVOID_STAR) ga_population_set_stablesize_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_crossoverratio",
            (FVOID_STAR) ga_population_get_crossoverratio_slang, SLANG_DOUBLE_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_set_crossoverratio",
            (FVOID_STAR) ga_population_set_crossoverratio_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_DOUBLE_TYPE)
      || SLadd_intrinsic_function("ga_population_get_mutationratio",
            (FVOID_STAR) ga_population_get_mutationratio_slang, SLANG_DOUBLE_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_set_mutationratio",
            (FVOID_STAR) ga_population_set_mutationratio_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_DOUBLE_TYPE)
      || SLadd_intrinsic_function("ga_population_get_migrationratio",
            (FVOID_STAR) ga_population_get_migrationratio_slang, SLANG_DOUBLE_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_set_migrationratio",
            (FVOID_STAR) ga_population_set_migrationratio_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_DOUBLE_TYPE)
      || SLadd_intrinsic_function("ga_population_set_scheme",
            (FVOID_STAR) ga_population_set_scheme_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_set_elitism",
            (FVOID_STAR) ga_population_set_elitism_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_chromosomenum",
            (FVOID_STAR) ga_population_get_chromosomenum_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_chromosomelen",
            (FVOID_STAR) ga_population_get_chromosomelen_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_get_generation",
            (FVOID_STAR) ga_population_get_generation_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_get_fitness",
            (FVOID_STAR) ga_entity_get_fitness_slang, SLANG_DOUBLE_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_isallocated",
            (FVOID_STAR) ga_entity_isallocated_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_extinction",
            (FVOID_STAR) ga_extinction_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_genocide",
            (FVOID_STAR) ga_genocide_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_genocide_by_fitness",
            (FVOID_STAR) ga_genocide_by_fitness_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_DOUBLE_TYPE)
      || SLadd_intrinsic_function("ga_allele_search",
            (FVOID_STAR) ga_allele_search_slang, SLANG_INT_TYPE, 6,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_sa",
            (FVOID_STAR) ga_sa_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_tabu",
            (FVOID_STAR) ga_tabu_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_simplex",
            (FVOID_STAR) ga_simplex_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_nahc",
            (FVOID_STAR) ga_nahc_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_rahc",
            (FVOID_STAR) ga_rahc_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_random_search",
            (FVOID_STAR) ga_random_search_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_search",
            (FVOID_STAR) ga_search_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_sort",
            (FVOID_STAR) ga_population_sort_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_population_score_and_sort",
            (FVOID_STAR) ga_population_score_and_sort_slang, SLANG_INT_TYPE, 1,
            SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_score",
            (FVOID_STAR) ga_entity_score_slang, SLANG_INT_TYPE, 2,
            SLANG_INT_TYPE, SLANG_INT_TYPE)
      || SLadd_intrinsic_function("ga_entity_migrate",
            (FVOID_STAR) ga_entity_migrate_slang, SLANG_INT_TYPE, 3,
            SLANG_INT_TYPE, SLANG_INT_TYPE, SLANG_INT_TYPE)
     ) return FALSE;

  return TRUE;
  }

#endif