遗传算法的基本代码

最新推荐文章于 2025-05-12 17:57:52 发布

vriuswgq

最新推荐文章于 2025-05-12 17:57:52 发布

阅读量1.2k

点赞数

CC 4.0 BY-SA版权

分类专栏： delphi 文章标签：算法 integer random statistics generation function

本文链接：https://blog.youkuaiyun.com/vriuswgq/article/details/2562930

本文档提供了一个用Delphi编写的遗传算法的基本代码实现，包括遗传算法的初始化、种群生成、交叉、变异等核心操作。代码中包含了随机数生成、适应度计算和种群统计等功能，适用于理解和学习遗传算法的原理。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

unit GADelphi;

interface

uses

  Math, SysUtils;



type



  PUnsigned = array of Cardinal;



  Pint = ^integer;

  individual = record

    chrom: PUnsigned;

    fitness: double;

    varible: double;

    xsite: integer;

    parent: array[0..1] of integer;

    utility: Pint;

  end;



  bestever = record

    chrom: PUnsigned;

    fitness: Double;

    varible: Double;

    generation: Integer;

  end;

  //* 随机数发生器使用的静态变量 */



  TGA = class(Tobject)

  public

    oldpop, temp, newpop: array of individual;

    bestfit: bestever;

    sumfitness: double;

    max, avg, min: double;

    pcross, pmutation: single;

    popsize, lchrom, chromsize, gen, maxgen, run, maxruns: integer;

    printstrings: integer; //* 输出染色体编码的判断，0 -- 不输出, 1 -- 输出 */

    nmutation: integer; //* 当前代变异发生次数 */

    ncross: integer;

    procedure initpop;

    procedure objfunc(var critter: individual);

    function flip(prob: single): boolean;

    function select: integer;

    function crossover(var parent1, parent2, child1, child2: PUnsigned): integer;

    function rnd(low, high: integer): integer;

    procedure mutation(child: PUnsigned);

    procedure generation;

    procedure preselect;

    constructor Create;

    procedure initdata;

    procedure initmalloc;

    procedure statistics(pop: array of individual);

    procedure initreport;

    procedure skip(skipcount: integer);

    procedure Go;

    procedure report;

    procedure repchar(ch: pchar; repcount: integer);

    procedure writepop;

    procedure writechrom(chrom: PUnsigned);

    procedure GARandomize;

    procedure advance_random;

    function randomperc: single;

    function randomnormaldeviate: double;

    procedure warmup_random(random_seed: single);

  end;



implementation

var

  oldrand: array[0..54] of double;

  jrand: integer;

  rndx2: double;

  rndcalcflag: integer;



procedure TGA.GARandomize; // * 设定随机数种子并初始化随机数发生器 * /

var

  randomseed: single;

  j1: integer;

begin

  for j1 := 0 to 54 do

    oldrand[j1] := 0.0;

  jrand := 0;

  repeat

    write('随机数种子[0 - 1]: ');

    readln(randomseed);

  until not ((randomseed < 0.0) and (randomseed > 1.0));

  warmup_random(randomseed);

end;



procedure TGA.warmup_random(random_seed: single); // * 初始化随机数发生器 * /

var

  j1, ii: integer;

  new_random, prev_random: double;

begin

  oldrand[54] := random_seed;

  new_random := 0.000000001;

  prev_random := random_seed;

  for j1 := 1 to 54 do

  begin

    ii := (21 * j1) mod 54;

    oldrand[ii] := new_random;

    new_random := prev_random - new_random;

    if (new_random < 0.0) then

      new_random := new_random + 1.0;

    prev_random := oldrand[ii];

  end;

  advance_random;

  advance_random();

  advance_random();

  jrand := 0;

end;



procedure TGA.advance_random; //* 产生55个随机数 */

var

  j1: integer;

  new_random: double;

begin

  for j1 := 0 to 23 do

  begin

    new_random := oldrand[j1] - oldrand[j1 + 31];

    if (new_random < 0.0) then

      new_random := new_random + 1.0;