Little useless-useful R functions – Greedy Salesman
This article is originally published at https://tomaztsql.wordpress.com
Travelling Salesman Problem is an NP-complete problem and an old mathematical problem. For this useless function, we will look for the nearest city from the previous city (or starting point) and repeat until we visit all cities. The greedy solution is fairly simplified but one disadvantage; it might not give you the best path (optimal solution) and proving that the solution is correct is an additional issue 
So, the code will be looking for local optimum. And continue to optimize the best local solution to find global optima by selecting the best next choice (closest city). Compute complexity of greedy algorithms is O(n log(n)) with no guarantee that a global optimum is found.
Create some random data:
df_size <- 50
set.seed(2908)
cities <- data.frame(x = sample(rnorm(1,100,10),df_size,replace=TRUE),
y = sample(rnorm(1,100,10),df_size,replace=TRUE),
rn = 1:df_size)
And two functions. First function will be for searching the nearest city and the other one will be the complete algorithm:
# Absolute Nearest city function
nearest_city_absolute <- function(pos, cities){
if (which.min(colSums((t(cities[,c("x","y")]) - pos)^2)) >= which.min(colSums((t(cities[,c("y","x")]) - pos)^2))) {
id <- which.min(colSums((t(cities[,c("x","y")]) - pos)^2))
} else {
id <- which.min(colSums((t(cities[,c("y","x")]) - pos)^2))
}
return(cities[id, ])
}
# Greedy TSP algorithm
greedy_TSP <- function(cities){
pos.ix <- (cities[sample(1:nrow(cities), 1), ])
pos.ix.c <- c(pos.ix$y,pos.ix$x)
tour <- pos.ix
unvisited <- cities[!(cities$rn %in% pos.ix$rn), ]
while (nrow(unvisited) > 0) {
pos.ix <- tail(tour,1)
pos.ix.c <- c(pos.ix$x, pos.ix$y)
found <- nearest_city_coordinate(pos.ix.c, unvisited)
tour <- rbind(tour, found)
unvisited <- unvisited[!(unvisited$rn %in% found$rn), ]
}
tour$name <- as.character(seq.int(nrow(tour)))
return(tour)
}
And we can visualise the path of a greedy salesman
library(gganimate)
greedy_TSP(cities) %>%
select (x, y, name) %>%
mutate(time_name=as.numeric(name)) %>%
uncount(df_size, .id = "frame") %>%
filter(time_name <= frame) %>%
arrange(frame, time_name) %>%
group_by(frame) %>%
mutate(x_lag = lag(x),
y_lag = lag(y),
tail = last(time_name) - time_name,
point_alpha = if_else(tail == 0, 1, 0.3),
segment_alpha = pmax(0, (df_size-tail)/df_size)) %>%
ungroup() %>%
ggplot(aes(x=y, y=x, xend = y_lag, yend = x_lag, group = time_name)) +
geom_segment(aes(alpha = segment_alpha)) +
geom_point(aes(alpha = point_alpha, colour="red"), show.legend = FALSE) +
labs(title = 'Greedy Salesman travelling between the cities', x= 'X-axis', y = 'Y-axis') +
scale_alpha(range = c(0,1)) +
guides(alpha = F) +
transition_manual(frame)
As always, code is available on the Github in the same Useless_R_function repository. Check Github for future updates.
Happy R-coding and stay healthy!“
Thanks for visiting r-craft.org
This article is originally published at https://tomaztsql.wordpress.com
Please visit source website for post related comments.
