library(EMFGeneticos) #library(ggplot2) # detach(package:ggplot2)
rm(list=ls()) #limpa
############# ############# ############# 0 : CARREGA O PROBLEMA!
#problema <- EMF.Gen.Cvrp.LoadProblem(filename = "tests/cvrp/A-n37-k6.vrp")
############# ############# ############# 1 : DEFINE FUNCOES DE CRIACAO E FITNESS!
cvrp.generate.simples <- function(){
#Função para gerar um cromossomo aleatório a partir do domínio, sem nenhuma inteligencia
r = sample( problema$cromossomoAmostra );
return( r );
}
cvrp.generate <- function(){
#Função para gerar um cromossomo aleatório a partir do domínio, com distribuição para os veículos
clientes = sample( problema$clientes );
cs = list(); #Cria a lista de segmento do cromossomo por veículo (Vazia)
for(i in 1:problema$qtdeVeiculos){
cs[[i]] = problema$veiculos[i];
}
veiculo = 1;
carga = 0;
for(i in 1:(problema$dimensoes-1)){ #Distribui os clientes em veículos
carga = carga + problema$demanda[clientes[i]];
if(carga >= problema$capacidadeVeiculos && veiculo < problema$qtdeVeiculos){
veiculo = veiculo + 1;
carga = problema$demanda[clientes[i]];
}
cs[[veiculo]] = c( cs[[veiculo]] , clientes[i]);
}
#r = sample( problema$cromossomoAmostra );
r = cvrp.getCromossomoFromRotas(cs);
return( r );
}
cvrp.generate.bestInsertion <- function(){
#Função para gerar um cromossomo aleatório a partir do domínio com melhor posicionamento (não foi utilizado)
clientes = sample( problema$clientes );
veiculos = sample( problema$veiculos, size = problema$dimensoes-1, replace = TRUE)
cs = list(); #Cria a lista de segmento do cromossomo por veículo (Vazia)
for(i in 1:problema$qtdeVeiculos){
cs[[i]] = problema$veiculos[i];
clientesRota = clientes[ veiculos == problema$veiculos[i] ];
if(length(clientesRota) > 0)
for( j in 1:length(clientesRota)){
cs[[i]] = cvrp.bestInsertion(cs[[i]], clientesRota[j]);
}
}
#r = sample( problema$cromossomoAmostra );
r = cvrp.getCromossomoFromRotas(cs);
return( r );
}
cvrp.getRotas <- function(c){
#Funcao que desmembra o cromossomo e o converte em uma lista de rotas
c = c( problema$veiculos[1], c); #Adiciona o Veículo 1, pois o primeiro veículo não é representado no cromossomo
#encontra as posicoes dos veiculos no cromossomo
veiculos = which( c>problema$dimensoes);
#Adiciona um separador ponto de segmento final para ganho de performance
veiculos = c(veiculos, problema$tamanhoCromossomo + 2 );
cs = list(); #Cria a lista de segmento do cromossomo por veículo (Vazia)
for(i in 1:problema$qtdeVeiculos){
cs[[i]] = c[ veiculos[i] : (veiculos[i+1]-1)];
}
return (cs);
}
cvrp.getCromossomoFromRotas <- function(cs){
#Funcão que gera um cromossomo a partir de uma lista de rotas (inverso do cvrp.getRotas)
rotas = length(cs);
ret = NULL;
if(length(cs[[1]]) > 1) #Trata a primeira rota
ret = cs[[1]][2:length(cs[[1]])]
if(rotas > 1){
for(i in 2:rotas){
ret = c(ret, cs[[i]])
}
}
return (ret);
}
cvrp.evaluateTruck <- function(cp){
#Função para avaliar a rota de 1 único veículo!
#Se o veiculo estiver vazio, retorna ZERO.
if( length(cp) == 1 )
return ( 0 );
#Adiciona a origem (deposito) e o destino final (deposito)
rota = c( problema$deposito, cp[2:length(cp)], problema$deposito);
#Calcula o custo das distancias
custo = 0;
for(i in 1:(length(rota)-1)){
custo = custo + problema$distancias[ rota[i], rota[i+1]];
}
#Calcula o OverCapacity
peso = sum( problema$demanda[rota] );
over = max( 0, (peso - problema$capacidadeVeiculos)) * problema$gamaOverCapacity;
#print( paste("Caminhao:", cp[1], "custo:", custo, "peso:", peso) );
return(custo + over);
}
cvrp.evaluate <- function(c){
#Função que avalia TODO o cromossomo (Divide em segmentos e retorna o fitness)
if(!cvrp.checkRapido(c))
return ( Inf );
cs = cvrp.getRotas(c); #Cria a lista de segmento do cromossomo por veículo (Vazia)
#Loop que totaliza o fitness por veículo
ret = 0;
for(i in 1:problema$qtdeVeiculos){
ret = ret + cvrp.evaluateTruck( cs[[i]] );
}
return (ret);
}
cvrp.corrige <- function(c){
#Funcão que recebe um cromossomo "errado" e o corrige, COLOCANDO NO FINAL
#1 - Remove as duplicidades
ret = unique(c);
#2 - Remove o que não deveria estar no cromossomo
ret = ret[ret %in% problema$cromossomoAmostra];
#3 - Identifica Adiciona algo que esteja faltando
falta = problema$cromossomoAmostra[ ! problema$cromossomoAmostra %in% ret];
if( length(falta) > 1 ){
ret = c( ret, sample( falta ) );
}else{
ret = c( ret, falta );
}
return ( ret );
}
cvrp.corrigeTruck <- function(cp){
#Funcão que recebe uma rota de um veículo e determina o MENOR trajeto UNICAMENTE DA ROTA
#A função sempre avalia a menor distância entre os endereços, a partir do depósito
#Esta função foi utilizada apenas para testes e não nos problemas do relatório
if(length(cp) <= 3 ) #Até 2 entregas (caminhao+2) não faz diferença a ordem
return (cp);
enderecosOrdenar = cp[2:length(cp)];
ret = cp[1]; #Sempre inicia com o caminhao
#Insere cliente a cliente na melhor opção
for( j in 1:length(enderecosOrdenar)){
ret = cvrp.bestInsertion(ret, enderecosOrdenar[j]);
}
return ( ret );
}
cvrp.checkRapido <- function(c){
#Função que avalia rapidamente se o cromossomo é válido ou não
#1 - Verifica o tamanho
if( length(c) != problema$tamanhoCromossomo )
return ( FALSE );
#2 - Verifica se tem duplicidades
if( length(unique(c)) != problema$tamanhoCromossomo )
return ( FALSE );
#3 - Verifica se tem algum valor nao "Autorizado"
if( length( c[ !c %in% problema$cromossomoAmostra ] ) > 0 )
return ( FALSE );
return ( TRUE );
}
cvrp.crossover.pmx.batch <- function( p1, p2 ){
#executa um loop de crossover PMX, para performance
linhas = dim(p1)[1];
ret = NULL;
for(i in 1:linhas){
ret = rbind( ret, cvrp.crossover.pmx(p1[i,], p2[i,]) );
}
return (ret);
}
cvrp.crossover.pmx <- function( p1, p2 )
{
#Funçao de Crossover específico para o problema. Faz um crossover de 2 pontos e garante que não se repete nada
size = length(p1);
#Obtem os 2 pontos do CrossOver
crossOverPoints = sample(1:(size-1),2);
cop1 = min(crossOverPoints);
cop2 = max(crossOverPoints);
#cat("{");cat(cop1);cat(",");cat(cop2);cat("}");
#O cromossomo será dividido em 3 segmentos: left (esquerda), core (centro), right (direito)
#O Core é gerado primeiro e cada cromossomo seguinte terá cross se já não estiver no Core.
child1 = c( rep( NA, cop1 ), p1[(cop1+1) : cop2], rep( NA, size - cop2));
child2 = c( rep( NA, cop1 ), p2[(cop1+1) : cop2], rep( NA, size - cop2));
child2[1:cop1] = p1[!(p1 %in% child2)][1:cop1]; #Adiciona o que sobrou em child2, na ordem de p1
child2[(cop2+1) : size] = p1[!(p1 %in% child2)];
child1[1:cop1] = p2[!(p2 %in% child1)][1:cop1]; #Adiciona o que sobrou em child1, na ordem de p2
child1[(cop2+1) : size] = p2[!(p2 %in% child1)];
ret = matrix( c(child1, child2), nrow = 2, ncol=size, byrow = TRUE );
return ( ret );
}
cvrp.crossover.repara <- function( p1, p2 ){
ret = EMF.Gen.CrossOver.Simple( p1, p2 ); #Primeiro, faz o crossover simples de 2 pontos
nRows = nrow(ret);
for(i in 1:nRows){
ret[i,] = cvrp.corrige( ret[i,] ) ; #E então, repara os descendentes
}
return (ret);
}
cvrp.mutate <- function(
original,
mutationRate = 0.10,
chromosomeRandFunc=NULL )
{
#Função com mutação simples, o que danifica o cromossomo. Não foi utilizada
#Get the size of the chromosome
size = length(original);
#prepare the return
ret = original;
#define a order to mutate
orderToSubstitute = sample(1:size, size);
for(c in 1:size)
if(runif(1) <= mutationRate)
{
substituteIndex = orderToSubstitute[c];
substituteValue = ret[substituteIndex];
ret[substituteIndex] = ret[c];
ret[c] = substituteValue;
}
return (ret);
}
cvrp.mutate.permut <- function(
original,
mutationRate = 0.10,
chromosomeRandFunc=NULL )
{
#Permuta de posição, 2 genes do cromossomo.
#Get the size of the chromosome
size = length(original);
#prepare the return
ret = original;
#define a order to mutate
indices = sample(1:size, 2);
ret[indices[1]] = original[indices[2]];
ret[indices[2]] = original[indices[1]];
return (ret);
}
cvrp.mutate.change <- function(
original,
mutationRate = 0.10,
chromosomeRandFunc=NULL )
{
#Similar à permutaçñao, mas move um bloco de genes. Não foi utilizada.
#Get the size of the chromosome
size = length(original);
ret = original;
#Escolhe 2 posições: 1 gene do cromossomo e determina 1 local onde ele será inserido
indices = sample(1:size, 2);
escolhido = indices[1];
novaposicao = indices[2];
#prepare the return, sem o cromossomo removido
temp = original[-escolhido];
#Insere no final
if(novaposicao == size){
ret = c(temp, original[escolhido]);
}else if(novaposicao == 1){#insere no início
ret = c(original[escolhido], temp);
}else{#Insere no meio
ret = c( temp[1:(novaposicao-1)], original[escolhido] , temp[novaposicao:(size-1)]);
}
return (ret);
}
cvrp.mutate.composto <- function(
original,
mutationRate = 0.10,
chromosomeRandFunc=NULL )
{
#Um híbrido de mutaçñao. Não foi utilizada.
#Verifica se deve mutar apenas dentro do cromossomo.
ret = NULL;
chance = runif(1, 0, 1);
if(chance<= 0.40){ #40% para alterar dentro da rota
cs = cvrp.getRotas(c = original);
idRotaAlterar = sample(problema$qtdeVeiculos, 1);
rotaAlterar = cs[[idRotaAlterar]];
if(length(rotaAlterar) >2){
trocas = sample(2:length(rotaAlterar), 2);
cs[[idRotaAlterar]][trocas[1]] = rotaAlterar[trocas[2]];
cs[[idRotaAlterar]][trocas[2]] = rotaAlterar[trocas[1]];
}
ret = cvrp.getCromossomoFromRotas(cs);
#print(cs);
}else{
ret = cvrp.mutate.permut(original);
}
return (ret);
}
cvrp.mutate.srm <- function(
original,
mutationRate = 0.10,
chromosomeRandFunc=NULL )
{
#baseado no artigo de 2004, escolhe um determinado cliente e tenta melhorá-lo na própria rota ou em outras rotas
ret = NULL;
chance = runif(1, 0, 1);
#Obtem as rotas e escolhe uma a alterar (rota deve possuir mais que 1 entrega)
cs = cvrp.getRotas(c = original);
idRotaRemover = sample(problema$qtdeVeiculos, 1);
rotaRemover = cs[[idRotaRemover]];
idRotaInserir = 0;
rotaInserir = NULL;
while(length(rotaRemover) <=2){
idRotaRemover = sample(problema$qtdeVeiculos, 1);
rotaRemover = cs[[idRotaRemover]];
}
#Remove algum indivíduo da rota
idItemRemover = sample(2:length(rotaRemover), size = 1);
itemRemovido = rotaRemover[idItemRemover];
rotaRemover = rotaRemover[-idItemRemover];
#Tem 30% de chance de inserir na própria rota, senão escolhe outra
if(chance <= 0.30 || problema$qtdeVeiculos < 2 ){
idRotaInserir = idRotaRemover;
rotaInserir = rotaRemover;
}else if(problema$qtdeVeiculos == 2){
idRotaInserir = (1:problema$qtdeVeiculos)[-idRotaRemover];
rotaInserir = cs[[idRotaInserir]];
}else{
idRotaInserir = sample((1:problema$qtdeVeiculos)[-idRotaRemover], size = 1);
rotaInserir = cs[[idRotaInserir]];
}
#print(paste("idRotaRemover:", idRotaRemover, ", idItemRemover:", idItemRemover, ", idRotaInserir:", idRotaInserir, ",chance:", chance));
rotaInserir = cvrp.bestInsertion(rotaInserir, itemRemovido); #Insere na "Best Insertion"
#Atualiza o array de rotas
cs[[idRotaRemover]] = rotaRemover;
cs[[idRotaInserir]] = rotaInserir;
return (cvrp.getCromossomoFromRotas(cs));
}
cvrp.bestInsertion <- function(rotaInserir, itemInserir){
#Insere no melhor lugar da rota. Serve de apoio ao SRM ou a qualquer outra utilizacao
if(length(rotaInserir) <= 2) #Rotas de 0 ou 1 entrega, insere no final
return ( c(rotaInserir, itemInserir) );
melhorRota = NULL;
melhorFitness = Inf;
for(i in 2:(length(rotaInserir) +1)){
esqIndex = 1:(i-1);
dirIndex = (i):length(rotaInserir);
if(i == length(rotaInserir) +1) dirIndex = NULL;
rotaCandidata = c( rotaInserir[esqIndex], itemInserir, rotaInserir[dirIndex]);
fitnessCandidato = cvrp.evaluateTruck(rotaCandidata);
if(fitnessCandidato < melhorFitness){
melhorFitness = fitnessCandidato;
melhorRota = rotaCandidata;
}
}
return (melhorRota);
}
cvrp.monitor <- function(r){
#Função que monitora a execução e plota gráficos
if( (r$generation >= 10) && ((r$generation %% 10) == 0) && (r$worst[r$generation] != Inf))
{
EMF.Gen.Plot(r, title = "Solução parcial do CVRP", ylab = "Fitness", includeWorst = TRUE);
}
#Para se todos avaliados (menos o Elitismo) forem infinitos
# if(r$lastEvaluations[r$input.params$elitism+1] == Inf){
# print("Interrompida execução. Excesso de indivíduos inválidos");
# return (TRUE);
# }
#Para se todos avaliados (INCLUINDO o Elitismo) forem infinitos
if(r$lastEvaluations[1] == Inf){
print("Interrompida execução. Excesso de indivíduos inválidos");
return (TRUE);
}
return (FALSE);
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.