## ============================================================
## Coca-Cola Denmark Sales Route Optimiser
## Method : TSP via Minimum Spanning Tree (MST) + nearest-
## neighbour 2-opt crossing removal
## CRS : UTM Zone 32N (EPSG:32632)
## Output : RStudio Plots panel + A4 Portrait PDF
## ============================================================
## ---- 0. Install / load packages ----------------------------
pkgs <- c("sf", "ggplot2", "rnaturalearth", "rnaturalearthdata",
"igraph", "dplyr", "ggspatial")
for (p in pkgs) {
if (!requireNamespace(p, quietly = TRUE)) install.packages(p)
}
library(sf)
## Warning: package 'sf' was built under R version 4.3.3
## Linking to GEOS 3.11.2, GDAL 3.8.2, PROJ 9.3.1; sf_use_s2() is TRUE
library(ggplot2)
library(rnaturalearth)
library(rnaturalearthdata)
## Warning: package 'rnaturalearthdata' was built under R version 4.3.3
##
## Attaching package: 'rnaturalearthdata'
## The following object is masked from 'package:rnaturalearth':
##
## countries110
library(igraph)
## Warning: package 'igraph' was built under R version 4.3.3
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:igraph':
##
## as_data_frame, groups, union
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggspatial)
set.seed(42)
## ---- 1. Denmark boundary -----------------------------------
denmark_wgs <- ne_countries(country = "Denmark",
scale = "medium",
returnclass = "sf") |> st_geometry()
utm32 <- st_crs(32632)
denmark_utm <- st_transform(denmark_wgs, utm32)
## ---- 2. Copenhagen depot -----------------------------------
cph_wgs <- st_sfc(st_point(c(12.5683, 55.6761)), crs = 4326)
cph_utm <- st_transform(cph_wgs, utm32) |> st_coordinates()
depot <- data.frame(name = "Copenhagen",
X = cph_utm[1, "X"],
Y = cph_utm[1, "Y"],
depot = TRUE)
## ---- 3. 100 towns inside Denmark (rejection sampling) ------
bbox <- st_bbox(denmark_utm)
towns <- data.frame()
while (nrow(towns) < 100) {
xs <- runif(3000, bbox["xmin"], bbox["xmax"])
ys <- runif(3000, bbox["ymin"], bbox["ymax"])
pts <- st_as_sf(data.frame(X = xs, Y = ys),
coords = c("X", "Y"), crs = utm32)
ok <- st_within(pts, st_union(denmark_utm), sparse = FALSE)[, 1]
cr <- st_coordinates(pts[ok, ])
towns <- rbind(towns, data.frame(X = cr[, "X"], Y = cr[, "Y"]))
}
towns <- towns[1:100, ]
towns$name <- paste0("T", sprintf("%03d", 1:100))
towns$depot <- FALSE
## ---- 4. All nodes ------------------------------------------
all_nodes <- bind_rows(depot, towns)
rownames(all_nodes) <- NULL
n_nodes <- nrow(all_nodes) # 101
## ---- 5. Distance matrix ------------------------------------
coords_mat <- as.matrix(all_nodes[, c("X", "Y")])
dist_mat <- as.matrix(dist(coords_mat))
## ---- 6. MST -> DFS tour ------------------------------------
g <- graph_from_adjacency_matrix(dist_mat, mode = "undirected",
weighted = TRUE, diag = FALSE)
mst_g <- mst(g)
dfs_res <- dfs(mst_g, root = 1, neimode = "all", unreachable = FALSE)
## Warning: The `neimode` argument of `dfs()` is deprecated as of igraph 1.3.0.
## ℹ Please use the `mode` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
tour <- c(as.integer(dfs_res$order), 1L) # close loop
## ---- 7. 2-opt crossing removal to prevent line crossings ---
## Repeatedly test all (i,j) pairs; reverse sub-tour if it
## shortens the route. Stops when no improvement found.
two_opt <- function(tour, dm) {
n <- length(tour) - 1 # last = first (depot), so n unique stops
improved <- TRUE
while (improved) {
improved <- FALSE
for (i in 1:(n - 2)) {
for (j in (i + 2):n) {
# skip the edge that wraps around
if (i == 1 && j == n) next
d_old <- dm[tour[i], tour[i+1]] +
dm[tour[j], tour[j+1]]
d_new <- dm[tour[i], tour[j]] +
dm[tour[i+1], tour[j+1]]
if (d_new < d_old - 1e-6) {
tour[(i+1):j] <- rev(tour[(i+1):j])
improved <- TRUE
}
}
}
}
tour
}
tour <- two_opt(tour, dist_mat)
## ---- 8. Assign sequential stop numbers ---------------------
## Depot = 0, first town visited = 1, ..., last = 100
unique_tour <- tour[1:n_nodes]
stop_num <- integer(n_nodes)
for (i in seq_along(unique_tour)) stop_num[unique_tour[i]] <- i - 1L
all_nodes$stop_num <- stop_num
all_nodes$map_label <- ifelse(all_nodes$depot,
"Copenhagen",
as.character(stop_num))
## ---- 9. Tour stats -----------------------------------------
tour_coords <- all_nodes[tour, ]
tour_length_km <- round(
sum(dist_mat[cbind(head(tour, -1), tail(tour, -1))]) / 1000, 1)
cat(sprintf("Tour length (after 2-opt): %.1f km\n", tour_length_km))
## Tour length (after 2-opt): 1978.1 km
## ---- 10. sf objects ----------------------------------------
route_line <- st_sfc(st_linestring(as.matrix(tour_coords[, c("X","Y")])),
crs = utm32)
all_sf <- st_as_sf(all_nodes, coords = c("X","Y"), crs = utm32)
towns_df <- all_nodes[!all_nodes$depot, ]
depot_df <- all_nodes[ all_nodes$depot, ]
## ---- 11. Build map -----------------------------------------
p <- ggplot() +
## Country – white fill, black border, no colour tint
geom_sf(data = denmark_utm,
fill = "white", colour = "black", linewidth = 0.5) +
## Route lines – red
geom_sf(data = route_line,
colour = "#CC0000", linewidth = 0.45, alpha = 0.9) +
## Town circles – blue filled
geom_point(data = towns_df,
aes(x = X, y = Y),
shape = 21, fill = "#2171b5",
colour = "black", size = 2.0, stroke = 0.4) +
## Copenhagen circle – green filled
geom_point(data = depot_df,
aes(x = X, y = Y),
shape = 21, fill = "#238b45",
colour = "black", size = 4.0, stroke = 0.8) +
## Town number labels (numbers only, no "Stop")
geom_text(data = towns_df,
aes(x = X, y = Y, label = map_label),
size = 1.7,
colour = "black",
hjust = 0,
nudge_x = 3200,
check_overlap = TRUE) +
## Copenhagen plain text label (no box)
geom_text(data = depot_df,
aes(x = X, y = Y, label = map_label),
size = 3.0,
colour = "black",
fontface = "bold",
nudge_y = 16000,
hjust = 0.5) +
## Scale bar & north arrow
annotation_scale(location = "bl", width_hint = 0.22,
unit_category = "metric") +
annotation_north_arrow(location = "tr",
style = north_arrow_fancy_orienteering()) +
## Title: black, bold, UPPER CASE, underlined via element_text
labs(
title = "COCACOLA OPTIMAL DISTRIBUTION ROUTE IN DENMARK",
subtitle = sprintf(
"100 towns | Distribution Centre: Copenhagen | Total route: %.1f km | UTM Zone 32N (EPSG:32632)",
tour_length_km),
x = "Easting",
y = "Northing"
) +
theme_minimal(base_size = 10) +
theme(
## Title: black, bold, underlined
plot.title = element_text(size = 11, face = "bold",
colour = "black",
hjust = 0.5,
margin = margin(b = 4),
decoration = "underline"),
plot.subtitle = element_text(size = 7, colour = "black",
hjust = 0.5),
## No caption
plot.caption = element_blank(),
## White/plain backgrounds – no colour tint
panel.background = element_rect(fill = "white", colour = NA),
plot.background = element_rect(fill = "white", colour = NA),
panel.grid.major = element_line(colour = "#cccccc", linewidth = 0.25),
axis.text = element_text(size = 7),
axis.title = element_text(size = 8)
)
## Warning in element_text(size = 11, face = "bold", colour = "black", hjust = 0.5, : `...` must be empty.
## ✖ Problematic argument:
## • decoration = "underline"
## ---- 12. Show in RStudio Plots panel -----------------------
print(p)
## ---- 13. Save as A4 Landscape PDF -------------------------
## A4 landscape in inches: 11.69 wide x 8.27 tall
pdf_dir <- "C:/Users/User/Desktop/CLASS NOTES/4.2 Notes/GIS Applications/Assignments/Assignment 5"
if (!dir.exists(pdf_dir)) {
dir.create(pdf_dir, recursive = TRUE)
message("Created directory: ", pdf_dir)
}
pdf_file <- file.path(pdf_dir, "denmark_tsp_route.pdf")
pdf(pdf_file, width = 11.69, height = 8.27, paper = "a4r")
print(p)
dev.off()
## png
## 2
cat(sprintf("\nPDF (A4 Landscape) saved to:\n %s\n", pdf_file))
##
## PDF (A4 Landscape) saved to:
## C:/Users/User/Desktop/CLASS NOTES/4.2 Notes/GIS Applications/Assignments/Assignment 5/denmark_tsp_route.pdf
## ---- 14. Tour order summary --------------------------------
cat("\n--- Tour order ---\n")
##
## --- Tour order ---
for (i in seq_along(unique_tour)) {
idx <- unique_tour[i]
lbl <- if (all_nodes$depot[idx]) "Copenhagen (Depot)" else
paste0("Stop ", stop_num[idx])
cat(sprintf(" %3d : %s\n", i - 1L, lbl))
}
## 0 : Copenhagen (Depot)
## 1 : Stop 1
## 2 : Stop 2
## 3 : Stop 3
## 4 : Stop 4
## 5 : Stop 5
## 6 : Stop 6
## 7 : Stop 7
## 8 : Stop 8
## 9 : Stop 9
## 10 : Stop 10
## 11 : Stop 11
## 12 : Stop 12
## 13 : Stop 13
## 14 : Stop 14
## 15 : Stop 15
## 16 : Stop 16
## 17 : Stop 17
## 18 : Stop 18
## 19 : Stop 19
## 20 : Stop 20
## 21 : Stop 21
## 22 : Stop 22
## 23 : Stop 23
## 24 : Stop 24
## 25 : Stop 25
## 26 : Stop 26
## 27 : Stop 27
## 28 : Stop 28
## 29 : Stop 29
## 30 : Stop 30
## 31 : Stop 31
## 32 : Stop 32
## 33 : Stop 33
## 34 : Stop 34
## 35 : Stop 35
## 36 : Stop 36
## 37 : Stop 37
## 38 : Stop 38
## 39 : Stop 39
## 40 : Stop 40
## 41 : Stop 41
## 42 : Stop 42
## 43 : Stop 43
## 44 : Stop 44
## 45 : Stop 45
## 46 : Stop 46
## 47 : Stop 47
## 48 : Stop 48
## 49 : Stop 49
## 50 : Stop 50
## 51 : Stop 51
## 52 : Stop 52
## 53 : Stop 53
## 54 : Stop 54
## 55 : Stop 55
## 56 : Stop 56
## 57 : Stop 57
## 58 : Stop 58
## 59 : Stop 59
## 60 : Stop 60
## 61 : Stop 61
## 62 : Stop 62
## 63 : Stop 63
## 64 : Stop 64
## 65 : Stop 65
## 66 : Stop 66
## 67 : Stop 67
## 68 : Stop 68
## 69 : Stop 69
## 70 : Stop 70
## 71 : Stop 71
## 72 : Stop 72
## 73 : Stop 73
## 74 : Stop 74
## 75 : Stop 75
## 76 : Stop 76
## 77 : Stop 77
## 78 : Stop 78
## 79 : Stop 79
## 80 : Stop 80
## 81 : Stop 81
## 82 : Stop 82
## 83 : Stop 83
## 84 : Stop 84
## 85 : Stop 85
## 86 : Stop 86
## 87 : Stop 87
## 88 : Stop 88
## 89 : Stop 89
## 90 : Stop 90
## 91 : Stop 91
## 92 : Stop 92
## 93 : Stop 93
## 94 : Stop 94
## 95 : Stop 95
## 96 : Stop 96
## 97 : Stop 97
## 98 : Stop 98
## 99 : Stop 99
## 100 : Stop 100
cat(" --> Return to Copenhagen\n")
## --> Return to Copenhagen