Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

genetic algorithm

• To: mathgroup at smc.vnet.net
• Subject: [mg122018] genetic algorithm
• From: Amy Poole <amy.poole at psi.ch>
• Date: Sun, 9 Oct 2011 03:52:23 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com

Hullo,


I wrote a routine that is supposed to be a bit like a genetic
algorithm that will minimise a function that requires testing
different integer combinations.  It works nicely for simple test
functions but not for more complex ones and I cannot understand why,
I have attached the algorithm and the function that works.  I would be
interested in your feedback.


Amy

p.s. The code is quite short, but not very short.



geneticAlgorithm[function_, energy_, variables__List,
  fitControlInt___Integer, fitControlReal___Real] :=

 Module[{lVar, varNames, conList, startList,

   iterations, sampleSize,

   mixingFactor, mutationFactor, diversityFactor,
   sampleMixingFactor, sampleMutationFactor, sampleDiversityFactor,

   ranList, numTable, pickList, ranPart,

   sample, replaceList, best, random},


  (**assign input values to internal variable names**)

  (*assign length of variables list*)

  lVar = Length[{variables}[[1]]];
  (*assign input variables names*)
  varNames = {variables}[[1]];

  (*assign constraints*)
  If[Length[{variables}] > 1,
   conList = {variables}[[2]];
   If[Length[{variables}] > 2,
    startList = {variables}[[3]]
    ],
   conList = Table[1, {n, lVar}]
   ];

  (*assign fitControlInt*)

  (*iterations of do loop*)
  iterations = lVar^2 10;
  (*number of values in sample table*)
  sampleSize = lVar^2 10;

  If[Length[{fitControlInt}] > 0,
   iterations = {fitControlInt}[[1]];
   If[Length[{fitControlInt}] > 1,
    sampleSize = {fitControlInt}[[2]];
    ]
   ];


  mixingFactor = 0.9;
  mutationFactor = 0.01;
  diversityFactor = 0.05;


  If[Length[{fitControlReal}] > 0,
   mixingFactor = {fitControlReal}[[1]];
   If[Length[{fitControlReal}] > 1,
    mutationFactor = {fitControlReal}[[2]];
    If[Length[{fitControlReal}] > 2,
     diversityFactor = {fitControlReal}[[3]]
     ]
    ]
   ];

  (*amount of mixing that takes place - the lower the mixingFactor -
  the less mixing - the factor runs from 0 to 1 and is on a log
scale*)

    sampleMixingFactor := sampleSize^(1 - mixingFactor);
  (*number of values replaced by random numbers - default is 1%,
0.01*)

    sampleMutationFactor := sampleSize lVar mutationFactor;
  (*number of random values added to the test sample -
  default is 5% of the length of the sample*)

  sampleDiversityFactor = sampleSize diversityFactor;


  (**define internal functions**)

  (*random number list generator*)

  ranList := RandomInteger /@ conList;
  (*random table generator*)

  numTable[func_, numList_] :=
   Reap[function /. Thread[varNames -> Sow[numList]]];
  (*random mixing function*)
  pickList :=
   Table[
    {IntegerPart[
      0.1 sampleSize RandomReal[
         ExponentialDistribution[sampleMixingFactor]] + 1], n}, {n,
     lVar}];

  (*random single position generator*)

  ranPart := {RandomInteger[{1, sampleSize}],
    RandomInteger[{1, lVar}]};



  (**calculations**)

  (*calculate initial random set of numbers*)

  sample = Table[numTable[function, ranList], {n, sampleSize}];
  (*if starting values are included add these to sample*)

  If[Length[{variables}] > 2,
   PrependTo[sample, numTable[function, startList]]];

  sample = Sort[sample];

  Clear[startList];

  (**Make new sample using best values from old sample**)

  Do[

   (*Take the best five percent of the sample*)

   best = sample[[1 ;; IntegerPart[sampleSize 0.05] + 1, 2, 1, 1]];
   (*Make the mixed table -
   nb larger table is made when the mixing factor is small*)

   sample =
    Table[Extract[sample[[All, 2, 1, 1]],
      pickList], {n, (2 - mixingFactor) sampleSize}];

   (*Make a table of random postitions (the number of positions is \
described by the mutation factor)*)
   replaceList = Table[ranPart, {n, sampleMutationFactor}];

   (*assign to these random positions random numbers that obey the \
constraints for that position*)

   replaceList =
    Table[replaceList[[n]] -> ranList[[replaceList[[n, 2]] ]], {n,
      sampleMutationFactor} ];

   (*insert mutations into the sample*)

   sample = ReplacePart[sample, replaceList];

   (*Make a random set of values to append to the sample (the size is
\
described by the diversity factor)*)

   random = Table[ranList, {n, IntegerPart[sampleDiversityFactor]}];

   sample = DeleteDuplicates[Join[best, random, sample]];

   If[sampleSize > Length[sample], sampleSize = Length[sample]];

   Clear[best, random];

   sample = Table[numTable[function, sample[[n]]], {n, sampleSize}];

   sample = Sort[sample],

   {i, iterations}];

  {sample[[1, 1]], sample[[1, 2, 1, 1]]}
  ]


input :
gA[function[variables], variables,
optional lists (constraints, starting values),
optional integers (number of iterations, size of initial sample ),
optional reals (mixing coefficient, mutation coefficient, diversity
coeffcient)]


Example that works:

func[x__] := Total[{x}];

a = b = c = 10

geneticAlgorithm[
 func[a, b, c, v1, v2, v3, v4, v5], {v1, v2, v3, v4, v5}, {1, 0, 1, 1,
   1}, {0, 1, 0, 1, 0}, 100, 1000, 0.95]