Traveling Salesman Algorithm (MCMC again…)

TravelSalesman

The traveling salesman problem is super easy to understand and (partly because of the problem’s simplicity) is a staple in most computer science algorithms courses.  The problem statement says:  Given the task of traveling through n cities and the restriction that each city must be visited exactly once, can we find a travel plan that minimizes the total distance traveled?

Below is a recently written algorithm that takes a natural number, n, for an argument and then solves an arbitrary traveling salesman problem with n nodes inside a unit square.  The algorithm then outputs the cities (ordered pairs) in the correct order and produces a visualization with a directed graph of the results.  The optimization mechanism for this result is a Monte Carlo Markov Chain with a fair amount of tuning (convergence speed vs absolute precision).

set.seed(321)

travel<-function(n){

#here we specify the number of points from the function argument
	nsim=n
	
#here we generate n random points in the unit square
	x_values<-c(rep(0,nsim))
	y_values<-c(rep(0,nsim))
	cities<-c(1:nsim)
	for(i in 1:nsim){x_values[i]=runif(1,0,1)}
	for(i in 1:nsim){y_values[i]=runif(1,0,1)}
	
#here we generate the distance matrix used to minimize the route
	distance<-matrix(0,nsim,nsim)
	candidate<-list()
	t=1
	s=1
	route_distance<-c()
	for(i in 1:nsim){
		for(j in 1:nsim){
			distance[i,j]=sqrt((x_values[i]-x_values[j])^2+(y_values[i]-
			y_values[j])^2)
		}
	}
	route<-sample(cities,nsim)


#here we repeatedly propose and accept/reject possible routes in order to arrive at a 
#global maximum.
	for(k in 1:100000){
		if(k>1000){s=10}
		if(k>2000){s=20}
		if(k>3000){s=50}
		if(k>4000){s=60}
		if(k>5000){s=70}
		if(k>6000){s=80}
		if(k>7000){s=90}
		if(k>8000){s=120}
#proposal step
	route_new<-route
	choose<-sample(route,2,replace=FALSE)
	route_new[choose[1]]=route[choose[2]]
	route_new[choose[2]]=route[choose[1]]
	
#acceptance/rejection step
	sumvector_TOP<-c(rep(0,nsim))
		for(i in 1:nsim-1){sumvector_TOP[i]=distance[route_new[i],route_new[i+1]]}
	sumvector_BOTTOM<-c(rep(0,nsim))
		for(i in 1:nsim-1){sumvector_BOTTOM[i]=distance[route[i],route[i+1]]}
		if(rbinom(1,1,min(1,(sum(sumvector_TOP)/sum(sumvector_BOTTOM))^(-s)))==1){
		route=route_new;
		candidate[[t]]<-route_new;
		route_distance[t]=sum(sumvector_TOP);
		t=t+1
		}
	}
#here we create a plot of the random points and connect them with directed edges
#the function requires the igraph package
best<-candidate[[which.min(route_distance)]]
output<-cbind(cities,x_values,y_values)
solution<-cbind(x_values,y_values)
best_odd<-c()
best_even<-c()
z<-c()

library(igraph)
layout<-solution
best_odd<-best
for(i in 2:nsim){
	best_even[i-1]<-best[i]
}
best_even[nsim]=best[1]
z=as.vector(rbind(best_odd,best_even))
G<-graph(z)
plot(G,layout=layout)

cat("the total distance for the shortest path is: ",min(route_distance),"\n")
cat("the route that generates this distance is: ",
candidate[[which.min(route_distance)]],"\n")
cat("the random points generated were: ","\n")
return(output)
}

#call the function
travel(20)

#the total distance for the shortest path is:  3.431226 
#the route that generates this distance is:  18 9 11 20 15 17 13 10 1 2 7 3 14 6 
#12 19 5 8 4 16 
#the random points generated were:  
#      cities   x_values   y_values
# [1,]      1 0.95589376 0.63596776
# [2,]      2 0.93728552 0.98987845
# [3,]      3 0.23822045 0.93117401
# [4,]      4 0.25507364 0.48550475
# [5,]      5 0.39051197 0.57468926
# [6,]      6 0.34117986 0.75123825
# [7,]      7 0.45238060 0.99272238
# [8,]      8 0.28993282 0.43086438
# [9,]      9 0.45067322 0.12436502
#[10,]     10 0.80659572 0.59426029
#[11,]     11 0.60572107 0.21050458
#[12,]     12 0.36284109 0.71025331
#[13,]     13 0.76633847 0.67582987
#[14,]     14 0.04508695 0.99290506
#[15,]     15 0.59217188 0.66287874
#[16,]     16 0.20163219 0.43870601
#[17,]     17 0.63273803 0.71822766
#[18,]     18 0.40358999 0.02558309
#[19,]     19 0.29050341 0.67232996
#[20,]     20 0.64045901 0.54095314

#   user  system elapsed 
#   2.248   0.036   2.961

Quartz %d

Advertisement

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s