用GA解VRP.docx
《用GA解VRP.docx》由会员分享，可在线阅读，更多相关《用GA解VRP.docx（30页珍藏版）》请在冰豆网上搜索。
用GA解VRP
【程序的算法单元delphi写的】
unituEA;
interface
uses
uUtilsEA,uIEA,uITSP,Classes,GaPara,windows,SysUtils,fEA_TSP;
type
TIndividual=class（TInterfacedObject,IIndividual）
private
//Theinternallystoredfitnessvalue
fFitness:
TFloat;
fWeConstrain:
integer;
fBackConstrain:
integer;
fTimeConstrain:
integer;
procedureSetFitness（constValue:
TFloat）;
functionGetFitness:
TFloat;
functionGetWeConstrain:
integer;
procedureSetWeConstrain（constValue:
integer）;
procedureSetBackConstrain（constValue:
integer）;
functionGetBackConstrain:
integer;
functionGetTimeConstrain:
integer;
procedureSetTimeConstrain（constValue:
integer）;
public
propertyFitness:
TFloatreadGetFitnesswriteSetFitness;
propertyWeConstrain:
integerreadGetWeConstrainwriteSetWeConstrain;
propertyBackConstrain:
integerreadGetBackConstrainwriteSetBackConstrain;
propertyTimeConstrain:
integerreadGetTimeConstrainwriteSetTimeConstrain;
end;
TTSPIndividual=class（TIndividual,ITSPIndividual）
private
//Theroutewetravel
fRouteArray:
ArrayInt;
fWeConstrain:
integer;
fBackConstrain:
integer;
fTimeConstrain:
integer;
functionGetRouteArray（I:
Integer）:
Integer;
procedureSetRouteArray（I:
Integer;constValue:
Integer）;
procedureSetSteps（constValue:
Integer）;
functionGetSteps:
Integer;
functionGetWeConstrain:
integer;
procedureSetWeConstrain（constValue:
integer）;
procedureSetBackConstrain（constValue:
integer）;
procedureSetTimeConstrain（constValue:
integer）;
functionGetBackConstrain:
integer;
functionGetTimeConstrain:
integer;
public
//Constructor,calledwithinitialroutesize
constructorCreate（Size:
TInt）;reintroduce;
destructorDestroy;override;
propertyRouteArray[I:
Integer]:
IntegerreadGetRouteArraywriteSetRouteArray;
//Thenumberofstepsontheroute
propertySteps:
IntegerreadGetStepswriteSetSteps;
propertyFitness:
TFloatreadGetFitnesswriteSetFitness;
propertyWeConstrain:
integerreadGetWeConstrainwriteSetWeConstrain;
propertyBackConstrain:
integerreadGetWeConstrainwriteSetBackConstrain;
propertyTimeConstrain:
integerreadGetTimeConstrainwriteSetTimeConstrain;
end;
TTSPCreator=class（TInterfacedObject,ITSPCreator）
private
//TheControlcomponentweareassociatedwith
fController:
ITSPController;
functionGetController:
ITSPController;
procedureSetController（constValue:
ITSPController）;
public
//Functiontocreatearandomindividual
functionCreateIndividual:
IIndividual;
functionCreateFeasibleIndividual:
IIndividual;
propertyController:
ITSPControllerreadGetControllerwriteSetController;
end;
TKillerPercentage=class（TInterfacedObject,IKillerPercentage）
private
fPer:
TFloat;
procedureSetPercentage（constValue:
TFloat）;
functionGetPercentage:
TFloat;
public
functionKill（Pop:
IPopulation）:
Integer;
//Percentageofpopulationtobekilled
propertyPercentage:
TFloatreadGetPercentagewriteSetPercentage;
end;
TParentSelectorTournament=class（TInterfacedObject,IParentSelector）
public
functionSelectParent（Population:
IPopulation）:
IIndividual;
end;
TTSPBreederCrossover=class（TInterfacedObject,IBreeder）
public
functionBreedOffspring（PSelector:
IParentSelector;Pop:
IPopulation）:
IIndividual;
end;
TTSPMutator=class（TInterfacedObject,ITSPMutator）
private
fTrans:
TFloat;
fInv:
TFloat;
procedureSetInv（constValue:
TFloat）;
procedureSetTrans（constValue:
TFloat）;
functionGetInv:
TFloat;
functionGetTrans:
TFloat;
public
procedureMutate（Individual:
IIndividual）;
published
//Probabilityofdoingatransposition
propertyTransposition:
TFloatreadGetTranswriteSetTrans;
//Probabilityofdoinganinversion
propertyInversion:
TFloatreadGetInvwriteSetInv;
end;
TTSPExaminer=class（TInterfacedObject,ITSPExaminer）
private
//TheControlcomponentweareassociatedwith
fController:
ITSPController;
functionGetController:
ITSPController;
procedureSetController（constValue:
ITSPController）;
public
//Returnsthefitnessofanindividualasarealnumberwhere0=>best
functionGetFitness（Individual:
IIndividual）:
TFloat;
propertyController:
ITSPControllerreadGetControllerwriteSetController;
end;
TPopulation=class（TInterfacedObject,IPopulation）
private
//Thepopulation
fPop:
TInterfaceList;
//Workerforbreeding
fBreeder:
IBreeder;
//Workerforkilling
fKiller:
IKiller;
//Workerforparentselection
fParentSelector:
IParentSelector;
//Workerformutation
fMutator:
IMutator;
//Workerforinitialcreation
fCreator:
ICreator;
//Workerforfitnesscalculation
fExaminer:
IExaminer;
//OnChangeevent
FOnChange:
TNotifyEvent;
procedureChange;
//GettersandSetters
functionGetIndividual（I:
Integer）:
IIndividual;
functionGetCount:
Integer;
functionGetBreeder:
IBreeder;
functionGetCreator:
ICreator;
functionGetExaminer:
IExaminer;
functionGetKiller:
IKiller;
functionGetMutator:
IMutator;
functionGetOnChange:
TNotifyEvent;
functionGetParentSelector:
IParentSelector;
procedureSetBreeder（constValue:
IBreeder）;
procedureSetCreator（constValue:
ICreator）;
procedureSetExaminer（constValue:
IExaminer）;
procedureSetKiller（constValue:
IKiller）;
procedureSetMutator（constValue:
IMutator）;
procedureSetOnChange（constValue:
TNotifyEvent）;
procedureSetParentSelector（constValue:
IParentSelector）;
//notinterfaced
procedureDanQuickSort（SortList:
TInterfaceList;L,R:
Integer;SCompare:
TInterfaceCompare）;
procedureSort（Compare:
TInterfaceCompare）;
protected
//ComparisonfunctionforSort（）
functionCompareIndividuals（I1,I2:
IIndividual）:
Integer;
//Sortthepopulation
procedureSortPopulation;
public
//Theconstructor
constructorCreate;
//Thedestructor
destructorDestroy;override;
//Addsanindividualtothepopulation
procedureAdd（New:
IIndividual）;
//Deletesanindividualfromthepopulation
procedureDelete（I:
Integer）;
//Runsasinglegeneration
procedureGeneration;
//Initialisethepopulation
procedureInitialise（Size:
Integer）;
//Clearourselvesout
procedureClear;
//Getthefitnessofanindividual
functionFitnessOf（I:
Integer）:
TFloat;
//Accesstothepopulationmembers
propertyPop[I:
Integer]:
IIndividualreadGetIndividual;default;
//Thesizeofthepopulation
propertyCount:
IntegerreadGetCount;
propertyParentSelector:
IParentSelectorreadGetParentSelectorwriteSetParentSelector;
propertyBreeder:
IBreederreadGetBreederwriteSetBreeder;
propertyKiller:
IKillerreadGetKillerwriteSetKiller;
propertyMutator:
IMutatorreadGetMutatorwriteSetMutator;
propertyCreator:
ICreatorreadGetCreatorwriteSetCreator;
propertyExaminer:
IExaminerreadGetExaminerwriteSetExaminer;
//Anevent
propertyOnChange:
TNotifyEventreadGetOnChangewriteSetOnChange;
end;
TTSPController=class（TInterfacedObject,ITSPController）
private
fXmin,fXmax,fYmin,fYmax:
TFloat;
{Thearrayof'cities'}
fCities:
arrayofTPoint2D;
{Thearrayof'vehicles'}
fVehicles:
arrayofTVehicle;
{Thearrayof'vehiclenumber'}
fNoVehicles:
ArrayInt;/////////////////////
{Thenumberof'newcities'}
fCityCount:
Integer;
{Thenumberof'oldcities'}
foldCityCount:
Integer;
{Thenumberof'travelers'}
fTravelCount:
Integer;///////////////////////
{Thenumberof'depots'}
fDepotCount:
Integer;///////////////////////
{Getters...}
functionGetCity（I:
Integer）:
TPoint2D;
functionGetNoVehicle（I:
Integer）:
TInt;
functionGetCityCount:
Integer;
functionGetOldCityCount:
Integer;
functionGetTravelCount:
Integer;
functionGetDepotCount:
Integer;
functionGetXmax:
TFloat;
functionGetXmin:
TFloat;
functionGetYmax:
TFloat;
functionGetYmin:
TFloat;
{Setters...}
procedureSetCityCount（constValue:
Integer）;
procedureSetOldCityCount（constValue:
Integer）;
procedureSetTravelCount（constValue:
Integer）;/////////////
procedureSetDepotCount（constValue:
Integer）;/////////////
procedureSetXmax（constValue:
TFloat）;
procedureSetXmin（constValue:
TFloat）;
procedureSetYmax（constValue:
TFloat）;
procedureSetYmin（constValue:
TFloat）;
functionTimeCostBetween（C1,C2:
Integer）:
TFloat;
functionGetTimeConstraint（Individual:
IIndividual）:
TInt;
functionDateSpanToMin（d1,d2:
TDateTime）:
integer;
functionGetVehicleInfo（routeInt:
Tint）:
integer;
procedurewriteTimeArray;
procedurewriteCostArray;
public
{Theconstructor}
constructorCreate;
{Thedestructor}
destructorDestroy;override;
{Getthedistancebetweentwocities}
functionDistanceBetween（C1,C2:
Integer）:
TFloat;
{Getthecostbetweentwocities}
functionCostBetween（C1,C2:
Integer）:
TFloat;
functionGetWeightConstraint（Individual:
IIndividual）:
TInt;
functionGetBackConstraint（Individual:
IIndividual）:
TInt;
{Placesthecitiesatrandompoints}
procedureRandomCities;
{Arealimits}
propertyXmin:
TFloatreadGetXminwriteSetXmin;
propertyXmax:
TFloatreadGetXmaxwriteSetXmax;
propertyYmin:
TFloatreadGetYminwriteSetYmin;
propertyYmax:
TFloatreadGetYmaxwriteSetYmax;
{Properties...}
propertyCityCount:
IntegerreadGetCityCountwriteSetCityCount;
propertyOldCityCount:
IntegerreadGetOldCityCountwriteSetOldCityCount;
propertyTravelCount:
IntegerreadGetTravelCountwriteSetTravelCount;///////////
propertyDepotCount:
IntegerreadGetDepotCountwriteSetDepotCount;///////////
{Accesstothecitiesarray}
propertyCities[I:
Integer]:
TPoint2DreadGetCity;
propertyNoVehicles[I:
Integer]:
TIntreadGetNoVehicle;///////////////
end;
implementation
uses
Math;
{TIndividual}
functionTIndividual.GetFitness:
TFloat;
begin
result:
=fFitness;
end;
functionTIndividual.GetWeConstrain:
integer;
begin
result:
=fWeConstrain;
end;
functionTIndividual.GetBackConstrain:
integer;
begin
res
升级会员 