├── .gitignore ├── FreeSerif.ttf ├── README.md ├── algo ├── TS-classdef.lisp ├── TS-utils.lisp ├── TS.lisp ├── algo-conditions.lisp ├── best-insertion.lisp ├── greedy-NN.lisp ├── greedy-append.lisp ├── greedy-best-insertion.lisp ├── iterator.lisp └── tools.lisp ├── doc ├── changelog.txt ├── class-diagram.png └── iterator.png ├── lib ├── batch-run.lisp ├── class-definitions.lisp ├── conditions.lisp ├── config-functions.lisp ├── constraints.lisp ├── draw-solution.lisp ├── fitness.lisp ├── fleet.lisp ├── init-macros.lisp ├── list.lisp ├── network.lisp ├── output.lisp ├── read-cvrp.lisp ├── read-solomon.lisp ├── read-test-case.lisp ├── route.lisp ├── simple-utils.lisp └── solver.lisp ├── open-vrp-lib.asd ├── open-vrp.asd ├── packages.lisp ├── plots ├── .gitignore ├── solomon100-optimal.png └── tsp.png ├── run-frames └── .gitignore ├── run-logs └── .gitignore └── test-cases ├── 100-cust.txt ├── 25-cust.txt ├── C1_6_1.TXT ├── Christofides_01.vrp ├── Christofides_02.vrp ├── Solomon-25 ├── C101.txt ├── C201.txt ├── R101.txt ├── R201.txt ├── RC101.txt └── RC201.txt ├── test-cases.lisp └── test-suite.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore all emacs backup files 2 | *~ 3 | # Ignore newly plotted results 4 | *png 5 | # Ignore compiled list files 6 | *fasl 7 | .DS_Store 8 | 9 | profile-results.txt 10 | -------------------------------------------------------------------------------- /FreeSerif.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mck-/Open-VRP/408cb67063474ab61ddfc1631b5ac39714f2535e/FreeSerif.ttf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Open-VRP 2 | 3 | Check out the [Wiki](https://github.com/mck-/Open-VRP/wiki) for an overview of Open-VRP or scroll down for a summary, [fork](https://github.com/mck-/Open-VRP/fork_select) and get-started! 4 | 5 | ## Synopsis 6 | 7 | Open VRP is a framework to model and solve [VRP-like](http://neo.lcc.uma.es/radi-aeb/WebVRP/) problems for students, academics, businesses and hobbyist alike. This framework allows for quick implementation of simple TSP/VRP problems to more complicated VRPTW, PDPTW, MDCPVRPPDTW, or however cool you want to sound. The library is extensibly written in Common Lisp's CLOS. Depending on your interest/purpose, an algorithm can be: 8 | 9 | * [written from scratch](https://github.com/mck-/Open-VRP/wiki/Using-Open-VRP:-writing-your-algo-from-scratch) 10 | * tweaked from existing implementations - (currently only [Tabu Search implemented](https://github.com/mck-/Open-VRP/wiki/Description-of-the-Tabu-Search-implementation)) 11 | 12 | The Problem object (e.g. VRP) and the Algorithm object (e.g. Genetic Algorithm) are modelled seperately and combined with the generic method (solve-prob problem algo). Different solution algorithms can be tested and compared against each other on the same problem (which you only model once). 13 | 14 | ## Current features (v. 0.6.2) 15 | 16 | * TSP, VRP, CVRP, VRPTW, CVRPTW 17 | * Homogenous/heterogenous fleet 18 | * Demands, duration, capacity, time-windows, speed 19 | * Define network using coordinates or (asymettric) distance matrix 20 | * Tabu Search 21 | * Logging of search progress (to file or to REPL) 22 | * Plotting of final solution or after each iteration 23 | * Test-case loader (Solomon and TSPLIB format) 24 | * Batch-run to test algo on a directory of test-cases 25 | 26 | ## Vision 27 | 28 | Too often have I found myself having to build a VRP model from scratch, just to experiment with some meta-heuristics for a school paper. Academics/students with a background/interest in Mathematics/Operations Research without the skills/patience for die-hard coding (in C++/Java), have no choice but to spend their valuable time stuck in the debug/test/debug cycle. [Here](https://kuomarc.wordpress.com/2012/01/27/why-i-love-common-lisp-and-hate-java/) is [why](http://kuomarc.wordpress.com/2012/03/05/the-uncommon-lisp-approach-to-operations-research/) those in OR should consider Common Lisp as an option. 29 | 30 | With this framework, I hope to catalyze the research and application of routing solutions. Researchers in innovative new algorithms should not need to fiddle in the Eclipse debugger screen. They should be able to focus all their energy and effort in devising their heuristics. OR should be kept fun and engaging. 31 | 32 | The ultimate vision for Open VRP is a simple intuitive toolkit for the OR community, free for anyone. 33 | 34 | ## Installation 35 | 36 | ``` 37 | ~$ git clone git://github.com/mck-/Open-VRP.git 38 | ``` 39 | Add this path and evaluate require: 40 | 41 | ``` 42 | (push "/path/to/Open-VRP/" asdf:*central-registry*) 43 | (require 'open-vrp) 44 | (in-package :open-vrp) 45 | ``` 46 | 47 | ## Usage 48 | Check the [Wiki](https://github.com/mck-/Open-VRP/wiki) for more documentation, the following is a short summary of the main functionality. 49 | 50 | `solve-prob` expects a problem object and an algo object. 51 | 52 | `test-vrp`, `solomon25`, `solomon100`, `christofides-1` and `christofides-2` are pre-loaded demo problems. To use Tabu Search: 53 | 54 | ``` 55 | (solve-prob test-vrp (make-instance 'tabu-search :iterations 10 :animatep T)) 56 | (solve-prob solomon100 (make-instance 'tabu-search :iterations 100)) 57 | (solve-prob christofides-2 (make-instance 'tabu-search :iterations 50)) 58 | ``` 59 | 60 | By default, problems will plot to `plots/name.png` and log to `run-logs/name.txt` where _name_ refers to the `:name` slot of the _Problem_ object. `(toggle-plot )` to disable plotting the final solution. Use `(set-log-mode x)` to switch from [0] no logging, [1] logging to file or [2] logging to the REPL. 61 | 62 | If you don't like the legend in the plot, turn it off with `(toggle-legend )`. 63 | 64 | When :animatep is set to T, each iteration will produce a plot in run-frames/Iteration x.png (much slower, since it needs to plot each iteration). You may use `(toggle-animate )` to turn it on/off. 65 | 66 | You can define your own problem objects with: 67 | 68 | ``` 69 | (define-problem "VRP" fleet-size :node-coords-list node-coords :to-depot T) 70 | (define-problem "CVRP" fleet-size :node-coords-list node-coords :demands demands-list :capacities capacity-list) 71 | (define-problem "VRPTW" fleet-size :node-coords-list node-coords :time-windows time-windows :durations durations :speeds speed) 72 | ``` 73 | 74 | where *node-coords* is a list of pairs, *demands-list* a list of associated demands (must be same length), and *fleet-size* is the number of vehicles. When a *demands-list* and vehicle *capacity* are provided, the resulting problem is a CVRP. If *time-windows* (list of pairs) and *durations* are given, the resulting problem object is a VRPTW. When everything is provided, it creates a CVRPTW. Each class of problem has its own specific constraints to check. 75 | 76 | You may also provide a(n asymmetric) distance matrix instead of node-coords (real-life problems). You won't be able to plot the solution without *node-coords* though. 77 | 78 | ``` 79 | (define-problem "ASYM-CVRP" 3 :demands '(0 1 2 3 2 1) :capacities 8 :dist-array dist-aray) 80 | ``` 81 | Note that the above will create 6 nodes, so the dimensions of the dist-array must be 6x6. Also note that we provide a single number for capacities (instead of a list with length 3), which means that all vehicles will have a capacity of 8. Single numbers are allowed for :demands, :durations, :capacites and :speeds 82 | 83 | Or to load a problem from a text-file (currently supports [Solomon-format](http://neo.lcc.uma.es/radi-aeb/WebVRP/index.html?/Problem_Instances/CVRPTWInstances.html) and [TSPLIB cvrp format](http://neo.lcc.uma.es/radi-aeb/WebVRP/data/Doc.ps)): 84 | 85 | ``` 86 | (defvar test-case-solomon (load-test-case-file "path-to-solomon-file-format.txt")) 87 | (defvar test-case-tsplib (load-test-case-file "path-to-tsplib-file-format.vrp")) 88 | ``` 89 | 90 | When the algo is finished running, it returns the Algo object, which contains :current-sol and :best-sol. Use `iterate-more` to keep searching: 91 | 92 | ``` 93 | (iterate-more int) 94 | ``` 95 | 96 | ## Output 97 | 98 | An example output of Solomon's VRPTW 100-customers benchmark test-case, solved with Tabu Search. 99 | 100 | ![alt Optimal solution](https://github.com/mck-/Open-VRP/blob/master/plots/solomon100-optimal.png?raw=true "Optimal solution") 101 | 102 | ## TODO 103 | 104 | * Extend VRP model to PDPTW 105 | * Run logs/statistics for test-result gathering (including batch runs) 106 | * User-interface (better macros) 107 | * Plotting can be improved (real-time output instead of .png files) 108 | * ... 109 | 110 | ## License 111 | 112 | Open-VRP is licensed under the terms of the [Lisp Lesser GNU 113 | Public License](http://opensource.franz.com/preamble.html), known as 114 | the LLGPL. The LLGPL consists of a preamble (see above URL) and the 115 | LGPL. Where these conflict, the preamble takes precedence. 116 | Open-VRP is referenced in the preamble as the "LIBRARY." 117 | -------------------------------------------------------------------------------- /algo/TS-classdef.lisp: -------------------------------------------------------------------------------- 1 | ;; Tabu Search Classes 2 | ;; --------------------------------------- 3 | ;; - it is possible to define your own moves and initial solution heuristic. 4 | (in-package :open-vrp.algo) 5 | 6 | (defclass tabu-search (algo) 7 | ((name :initform "Tabu Search") 8 | (desc :initform "A local search that escapes local optima by means of declaring certain moves tabu.") 9 | (move-type :accessor ts-move-type :initarg :move-type :initform 'TS-best-insertion-move) 10 | (init-heur :accessor ts-init-heur :initarg :init-heur :initform 'greedy-best-insertion) 11 | (iterations :initform 20) 12 | (aspirationp :accessor ts-aspirationp :initarg :aspirationp :initform T) 13 | (elite-listp :accessor ts-elite-listp :initarg :elite-listp :initform T) 14 | (tabu-list :accessor ts-tabu-list :initarg :tabu-list :initform nil) 15 | (tabu-tenure :accessor ts-tenure :initarg :tabu-tenure :initform 15) 16 | (tabu-parameter-f :accessor ts-parameter-f :initarg :tabu-parameter-f :initform #'ts-pars-n) 17 | (candidate-list :accessor ts-candidate-list :initarg :candidate-list :initform nil) 18 | (stopping-condition :accessor ts-stopping-condition :initarg :stopping-condition :initform #'stopping-conditionp))) 19 | 20 | ;; ---------------------------- 21 | 22 | ;; Tabu search move types 23 | ;; --------------------------- 24 | 25 | ;; Given a node and a vehicle, TS-best-insertion inserts it in the best possible position 26 | (defstruct (TS-best-insertion-move (:include insertion-move))) 27 | -------------------------------------------------------------------------------- /algo/TS-utils.lisp: -------------------------------------------------------------------------------- 1 | ;; Tabu Search utilities 2 | ;; --------------------- 3 | 4 | (in-package :open-vrp.algo) 5 | 6 | ;; Misc 7 | ;; --------------------------- 8 | 9 | (defun toggle-aspiration (ts) 10 | (toggle (ts-aspirationp ts))) 11 | 12 | (defun toggle-elite-list (ts) 13 | (toggle (ts-elite-listp ts))) 14 | 15 | ;; Tabu List 16 | ;; ----------------------------- 17 | 18 | ;; Add 19 | (defun add-to-tabu (ts pars) 20 | "Add pars to the tabu-list of . Expects pars to be a list when more than one parameter is recorded. When tabu-list gets larger than the tenure, will prune away the oldest pars on the list. Destructive." 21 | (let ((tenure (ts-tenure ts))) 22 | (push pars (ts-tabu-list ts)) 23 | (when (> (length (ts-tabu-list ts)) tenure) 24 | (setf (ts-tabu-list ts) (subseq (ts-tabu-list ts) 0 tenure))))) 25 | 26 | (defun add-move-to-tabu (ts mv) 27 | "Adds to tabu-list of . Calls function held in 's :tabu-parameter-f slot." 28 | (add-to-tabu ts (funcall (ts-parameter-f ts) mv))) 29 | 30 | ;; Clear tabu list 31 | (defun clear-tabu-list (ts) 32 | "Given a , erase everything that is on the tabu-list. A useful restart in case all moves were declared tabu." 33 | (setf (ts-tabu-list ts) nil)) 34 | 35 | ;; Check 36 | (defun is-tabup (ts pars) 37 | "Given pars, checks if on tabu list of " 38 | (find pars (ts-tabu-list ts) :test 'equal)) 39 | 40 | (defun is-tabu-movep (ts mv) 41 | "Given a , checks if the parameters returned by calling :tabu-parameter-f are recorded on the list." 42 | (is-tabup ts (funcall (ts-parameter-f ts) mv))) 43 | 44 | ;; Tabu-parameter-f functions 45 | (defun ts-pars-n (mv) 46 | (move-node-id mv)) 47 | 48 | (defun ts-pars-nv (mv) 49 | (list (move-node-id mv) (move-vehicle-ID mv))) 50 | 51 | ;; -------------------------- 52 | 53 | ;; Candidate Lists 54 | ;; ----------------------------- 55 | 56 | (defun improving-movep (move) 57 | "Returns T if move is an improving one, i.e. has a negative fitness." 58 | (< (move-fitness move) 0)) 59 | 60 | (defun create-candidate-list (ts sorted-moves) 61 | "Given a list of sorted moves, return the list with non-tabu improving moves. Will always at least return one (non-tabu) move." 62 | (labels ((iter (moves ans) 63 | (if (or (null moves) (not (improving-movep (car moves)))) 64 | (nreverse ans) 65 | (iter (cdr moves) 66 | (if (is-tabup ts (funcall (ts-parameter-f ts) (car moves))) 67 | ans 68 | (push (car moves) ans)))))) ;only add if move is non-tabu 69 | (iter (cdr sorted-moves) 70 | (handler-bind ((all-moves-tabu #'select-best-tabu)) 71 | (list (select-move ts sorted-moves)))))) 72 | 73 | (defmethod remove-affected-moves ((ts tabu-search) move) 74 | "Given a and one (to be performed), remove all the moves from the candidate-list that do not apply anymore after the selected move is performed." 75 | (let ((sol (algo-current-sol ts))) 76 | (setf (ts-candidate-list ts) 77 | (remove-if #'(lambda (mv) (or (= (move-node-id mv) (move-node-id move)) 78 | (= (move-vehicle-ID mv) (move-vehicle-ID move)) 79 | (eq (route-from mv sol) 80 | (route-from move sol)) 81 | (eq (route-to mv sol) 82 | (route-from move sol)))) 83 | (ts-candidate-list ts))))) 84 | 85 | ;; ------------------------ 86 | 87 | ;; Stopping condition 88 | ;; ------------------------- 89 | 90 | (defun stopping-conditionp (ts) 91 | "Given a , tests whether the number of iterations since the best solution was found is larger than triple tenure value. This is an indicator of cycling behaviour. Minimum 20 iterations in case tenure is smaller than 10. Usefull for many multi-runs." 92 | (let ((iters (- (algo-best-iteration ts) (algo-iterations ts)))) 93 | (and (> iters 20) 94 | (> iters (* 3 (ts-tenure ts)))))) -------------------------------------------------------------------------------- /algo/TS.lisp: -------------------------------------------------------------------------------- 1 | ;;; Tabu Search implementation 2 | ;;; ---------------- 3 | ;;; 0. initialize algo object 4 | ;;; 1. generate moves 5 | ;;; 2. perform move 6 | ;;; 3. select move 7 | ;;; 4. iterate 8 | 9 | (in-package :open-vrp.algo) 10 | 11 | (defmethod run-algo ((prob problem) (ts tabu-search)) 12 | "Initialize (if necessary), iterate till finished. Returns object." 13 | (unless (algo-current-sol ts) (initialize prob ts)) 14 | (while (< 0 (algo-iterations ts)) 15 | (iterate ts)) 16 | ts) 17 | 18 | (defmethod initialize ((prob problem) (ts tabu-search)) 19 | "Creates inital solution and sets it to :algo-current-sol. Returns the object. For Tabu Search, the default heuristic for generating an initial solution is 'greedy-best-insertion, which is read from the slot :init-heur." 20 | (init-algo (algo-current-sol 21 | (run-algo (copy-object prob) (make-instance (ts-init-heur ts)))) 22 | ts) 23 | ts) 24 | 25 | ;; Original attempt was to make generate-moves a general method - using the move-type slot of ts - which can be used to generate all sorts of moves e.g. swap moves.. but the method below enumerates only along node-id (excluding 0) and vehicle-id. This may only be useful for TS-best-insertion-move?? For other moves, we need to define other defmethods? 26 | 27 | (defmacro for-node-ID ((node-ID prob) &body body) 28 | "Map over all node-IDs, except for base." 29 | `(map1-n #'(lambda (,node-ID) 30 | ,@body) 31 | (1- (num-nodes ,prob)))) 32 | 33 | (defmacro for-veh-ID ((veh-ID prob) &body body) 34 | "Map over all veh-IDs capped at fleet-size. Will consider only busy vehicles and one extra idle vehicle." 35 | `(map0-n #'(lambda (,veh-ID) 36 | ,@body) 37 | (min (1+ (vehicle-id (car (last (get-busy-vehicles ,prob))))) 38 | (1- (num-veh ,prob))))) 39 | 40 | (defun useless-move (mv prob) 41 | "Returns T if move is useless. Two options: 1. move concerns node and vehicle that has the node as it's only destination, e.g. (0 2 0). 2. Moving node from one-destination vehicle to empty-vehicle, which becomes another one-destination vehicle." 42 | (let ((route (route-to mv prob))) 43 | (or (and (one-destinationp route) 44 | (= (node-id (cadr route)) (move-node-ID mv))) 45 | (and (empty-routep route) (one-destinationp (route-from mv prob)))))) 46 | 47 | (defmethod generate-moves ((ts tabu-search)) 48 | "Generates a list of instances (depending on what was defined in the ts slot) for all nodes and vehicles." 49 | (flet ((symb (a b) 50 | (intern (format nil "~a-~a" (symbol-name a) (symbol-name b)) :open-vrp.algo))) 51 | (let ((prob (algo-current-sol ts))) 52 | (remove-if #'(lambda (mv) (useless-move mv prob)) 53 | (flatten 54 | (for-node-ID (node-ID prob) 55 | (for-veh-ID (veh-ID prob) 56 | (funcall 57 | (symb 'make (ts-move-type ts)) 58 | :node-ID node-ID 59 | :vehicle-ID veh-ID)))))))) 60 | 61 | ;; the difference between cost (inserting) and saving (removing) 62 | ;; cost of inserting is calculated by (get-best-insertion-move) 63 | ;; saving by removing the connecting arcs before and after, and connecting them directly 64 | (defmethod assess-move ((sol problem) (mv TS-best-insertion-move)) 65 | (with-slots (node-id vehicle-id fitness) mv 66 | (handler-case 67 | (let* ((dist-array (problem-dist-array sol)) 68 | (route (route-from mv sol)) 69 | (pos (position node-id route :key #'node-id)) 70 | (node-before (node-id (nth (1- pos) route))) 71 | (dist-before (distance node-before node-id dist-array))) 72 | (setf fitness 73 | ;cost of insertion 74 | (- (move-fitness (get-best-insertion-move-in-vehicle sol vehicle-id node-id)) 75 | ;save by removing: 76 | (if (= pos (1- (length route))) ;if the node is at end of route 77 | dist-before 78 | (let ((node-after (node-id (nth (1+ pos) route)))) 79 | (- (+ dist-before 80 | (distance node-id node-after dist-array)) ;dist to next node 81 | ;minus direct route, which is 0 if the node-before and node-after are the same. 82 | (handler-case (distance node-before node-after dist-array) 83 | (same-origin-destination () 0)))))))) 84 | (no-feasible-move () (setf fitness nil))))) ;when no feasible-moves exist, set fitness nil 85 | 86 | 87 | (defmethod perform-move ((sol problem) (mv TS-best-insertion-move)) 88 | "Takes with node-ID and uses get-best-insertion to insert in vehicle-ID. DESTRUCTIVE." 89 | (let* ((node-id (move-node-id mv)) 90 | (veh-id (move-vehicle-id mv)) 91 | (best-move (get-best-insertion-move-in-vehicle sol veh-ID node-ID))) 92 | ;if the move of node is intra-route, AND the node is being moved forward 93 | (if (and (= (vehicle-with-node-ID sol node-ID) veh-ID) 94 | (> (move-index best-move) 95 | (position node-id (route-to mv sol) :key #'node-id))) 96 | ;then perform insertion first, afterward remove the old node, positioned before the new 97 | (progn (perform-move sol best-move) (remove-node-ID sol node-ID)) 98 | ;in all other cases, it's okay to remove the node first, then reinsert 99 | (progn (remove-node-ID sol node-ID) (perform-move sol best-move)))) 100 | sol) 101 | 102 | (defmethod select-move ((ts tabu-search) all-moves) 103 | "This function selects best non-tabu move from a list of assessed moves. When aspiration criteria is set to T, then if by performing the move we get a new best solution, circumvent the tabu-list." 104 | (let ((sorted-moves (sort-moves all-moves))) 105 | (unless (move-fitness (car sorted-moves)) (error 'no-feasible-move :moves all-moves)) 106 | (if (and (ts-aspirationp ts) 107 | (< (+ (fitness (algo-current-sol ts)) (move-fitness (car sorted-moves))) 108 | (algo-best-fitness ts))) 109 | (car sorted-moves) 110 | (restart-case 111 | (aif (find-if-not #'(lambda (mv) (is-tabu-movep ts mv)) sorted-moves) it 112 | (error 'all-moves-tabu :moves all-moves :tabu-list (ts-tabu-list ts))) 113 | (select-best-tabu-move () 114 | :report "Choost the best move, you'll need to move somehow, right?" 115 | (car sorted-moves)) 116 | (flush-tabu-list () 117 | :report "Erase everything on the tabu-list and resume." 118 | (clear-tabu-list ts) 119 | (car sorted-moves)))))) 120 | 121 | ;; -------------------- 122 | ;; If there is no candidate-list 123 | ;; generate-assess-sort moves 124 | ;; create a candidate list and perform top move 125 | ;; Perform top move from candidate-list 126 | 127 | (defmethod iterate ((ts tabu-search)) 128 | (let ((sol (algo-current-sol ts))) 129 | (labels ((perform-add-tabu (move) 130 | "add move to tabu-list if unimproving move and perform it" 131 | (when (<= 0 (move-fitness move)) (add-move-to-tabu ts move)) 132 | (perform-move sol move)) 133 | (select-perform-from-cand (ts) 134 | "select best move from candidate-list, remove all related moves and perform" 135 | (let ((best-move (car (ts-candidate-list ts)))) 136 | (remove-affected-moves ts best-move) 137 | (perform-add-tabu best-move)))) 138 | (if (ts-elite-listp ts) 139 | (if (ts-candidate-list ts) 140 | (select-perform-from-cand ts) 141 | (let ((sorted-moves (sort-moves (assess-moves sol (generate-moves ts))))) 142 | (setf (ts-candidate-list ts) (create-candidate-list ts sorted-moves)) 143 | (select-perform-from-cand ts))) 144 | (perform-add-tabu 145 | (handler-bind ((all-moves-tabu #'select-best-tabu)) 146 | (select-move ts (assess-moves sol (generate-moves ts))))))) 147 | ts)) 148 | 149 | ;; -------------------------- 150 | 151 | ;; Stopping condition 152 | ;; -------------------------- 153 | ;; When there is a stopping-condition, check it on the algo. If met, set iterations to 0. 154 | 155 | (defmethod iterate :around ((ts tabu-search)) 156 | (let ((sc (ts-stopping-condition ts))) 157 | (when (and sc (funcall sc ts)) 158 | (setf (algo-iterations ts) 0) 159 | (with-log-or-print (stream (algo-current-sol ts) *start-time*) 160 | (format stream "~&Stopping condition met.~%")) 161 | (unless (log-to-replp ts) 162 | (format t "~&Stopping condition met.~%")))) 163 | (call-next-method)) 164 | 165 | -------------------------------------------------------------------------------- /algo/algo-conditions.lisp: -------------------------------------------------------------------------------- 1 | ;; Algo related conditions 2 | (in-package :open-vrp.algo) 3 | 4 | ;; algo/TS.lisp 5 | (define-condition all-moves-tabu (error) 6 | ((moves :initarg :moves :reader moves) 7 | (tabu-list :initarg :tabu-list :reader tabu-list)) 8 | (:report "All possible moves are on the Tabu-list! Consider reducing tabu-tenure, or override the select-move procedure.")) 9 | 10 | (defun select-best-tabu (c) 11 | (invoke-restart 'select-best-tabu-move)) 12 | 13 | ;; algo/best-insertion.lisp 14 | (define-condition no-feasible-move (error) 15 | ((moves :initarg :moves :reader moves)) 16 | (:report "All moves are infeasible!")) 17 | 18 | (define-condition no-initial-feasible-solution (error)() 19 | (:report "Could not find feasible initial solution!")) 20 | -------------------------------------------------------------------------------- /algo/best-insertion.lisp: -------------------------------------------------------------------------------- 1 | ;; Best Insertion (used by Tabu Search) 2 | ;; ------------- 3 | ;; The following functions are defined to generate-assess-choose the best insertion move 4 | ;; for a node into a vehicle's route. Assumes the route does not include the node already. 5 | ;; - get-best-insertion-move expects a object, a node-id and a vehicle-id. 6 | ;; ----------------------------------------------- 7 | (in-package :open-vrp.algo) 8 | 9 | (defun generate-insertion-moves (sol vehicle-id node-id) 10 | "Given the object, vehicle-id and node-id (integers), create all possible insertion-moves, and return them in a list. Avoid generating moves that won't do anything (when doing intra-route insertion)." 11 | (let* ((route (vehicle-route (vehicle sol vehicle-id))) 12 | (pos (position node-id route :key #'node-id)) ;check if we do intra-route insertion 13 | (moves '())) 14 | (do ((index 1 (1+ index))) 15 | ((> index (if (problem-to-depot sol) (1- (length route)) (length route)))) 16 | (unless (and pos (or (= index pos) (= index (1+ pos)))) ;useless moves avoided 17 | (push (make-insertion-move 18 | :index index 19 | :vehicle-id vehicle-id 20 | :node-id node-id) 21 | moves))) 22 | (nreverse moves))) 23 | 24 | ;; calculates the added distance of performing the insertion-move 25 | ;; when appending to the end, it's just the distance from last location to the node 26 | ;; otherwise it is the distance to the nodes before and after, minus their direct connection 27 | (defmethod assess-move ((sol problem) (m insertion-move)) 28 | (with-slots (node-ID vehicle-ID index) m 29 | (let* ((route (route-to m sol)) 30 | (dist-array (problem-dist-array sol)) 31 | (node-before (node-id (nth (1- index) route)))) 32 | (setf (move-fitness m) 33 | (if (= index (length route)) ;if appending to end of route 34 | (distance (node-id (last-node route)) node-ID dist-array) 35 | (let ((node-after (node-id (nth index route)))) 36 | (- 37 | (+ (distance node-before node-ID dist-array) 38 | (distance node-ID node-after dist-array)) 39 | (handler-case (distance node-before node-after dist-array) 40 | (same-origin-destination () 0))))))))) 41 | 42 | (defmethod perform-move ((sol problem) (m insertion-move)) 43 | "Performs the on ." 44 | (with-slots (node-ID vehicle-ID index) m 45 | (insert-node (vehicle sol vehicle-ID) (node sol node-ID) index) 46 | sol)) 47 | 48 | ;; logging 49 | (defmethod perform-move :after ((prob problem) (mv insertion-move)) 50 | (with-log-or-print (stream prob *start-time*) 51 | (format stream "~&Performing ~A with Node ~A and Vehicle ~A and Index ~A~%" (type-of mv) (move-node-ID mv) (move-vehicle-ID mv) (move-index mv)))) 52 | 53 | ;; ---------------------- 54 | 55 | ;; Optimal insertion (used by Greedy Best Insertion) 56 | ;; --------------------- 57 | 58 | ;; Step 1: find best index, given vehicle-id 59 | (defun get-best-insertion-move-in-vehicle (sol vehicle-id node-id) 60 | "Given the object, vehicle-id and node-id (integers), return the best (i.e. with the lowest fitness) for inserting node-id in vehicle-id. When no move is feasible, throws error." 61 | (let ((sorted (sort-moves (assess-moves sol (generate-insertion-moves sol vehicle-id node-id))))) 62 | (unless (move-fitness (car sorted)) (error 'no-feasible-move :moves sorted)) 63 | (car sorted))) 64 | 65 | ;; Step 2: find best vehicle, given node 66 | (defgeneric get-best-insertion-move (prob node) 67 | (:method (prob node) "optimal-insertion: Expects and .") 68 | (:documentation "Given a node and a solution (that does not have this node yet), return the best .")) 69 | 70 | (defmethod get-best-insertion-move ((sol problem) (n node)) 71 | (labels ((iter (flt best-move) 72 | (if (null flt) (or best-move (error 'no-feasible-move)) 73 | (iter (cdr flt) 74 | (handler-case 75 | (let ((new (get-best-insertion-move-in-vehicle sol 76 | (vehicle-id (car flt)) 77 | (node-id n)))) 78 | (if (or (null best-move) ;first move 79 | (< (move-fitness new) (move-fitness best-move))) ;better? 80 | new 81 | best-move)) 82 | (no-feasible-move () (or best-move))))))) 83 | (iter (problem-fleet sol) nil))) 84 | 85 | ;; ------------------------- 86 | -------------------------------------------------------------------------------- /algo/greedy-NN.lisp: -------------------------------------------------------------------------------- 1 | ;;; Nearest Neighborhood algorithm (greedy) for TSP (NOT defined for (C)VRP(TW)!) 2 | ;;; ----- 3 | ;;; Start at base, and keep choosing the next closest one 4 | (in-package :open-vrp.algo) 5 | 6 | (defclass greedy-NN (algo) 7 | ((name :initform "Greedy NN-algo") 8 | (desc :initform "Nearest Neighborhood algo; from base/random, select next closest one"))) 9 | 10 | ;; Greedy NN algo for TSP problem (no fleet) 11 | 12 | (defmethod run-algo ((p problem) (a greedy-NN)) 13 | "While there exists unchosen nodes, keep appending it. Returns the object when done. Also prints the fitness and solution (run-algo :after method)." 14 | (let ((v (vehicle p 0))) 15 | (awhile (handler-case 16 | (get-closest-node p 0 (route-indices v)) 17 | (list-of-nils () nil)) 18 | (append-node v it))) 19 | (init-algo p a) 20 | a) -------------------------------------------------------------------------------- /algo/greedy-append.lisp: -------------------------------------------------------------------------------- 1 | ;;; Greedy Appending heuristic 2 | ;;; -------------- 3 | ;;; Using a (random) sequence, append the one by one in the nearest 4 | ;;; May cause error for VRPTW or CVRP, when the number of vehicles available are too low 5 | ;;; to append all the nodes. Use greedy-best-insertion instead! 6 | 7 | (in-package :open-vrp.algo) 8 | 9 | (defclass greedy-append (algo) 10 | ((name :initform "Greedy Appending heuristic") 11 | (desc :initform "Random greedy insertion heuristic; append nodes to closest vehicle successively. Used as initial solution for search algos."))) 12 | 13 | (defmethod run-algo ((p problem) (a greedy-append)) 14 | "Randomly append one by one to the closest . Returns object when done. Also prints the fitness and solution." 15 | (loop for id in (random-list-permutation (1- (length (problem-network p)))) 16 | do (append-node (get-closest-feasible-vehicle (node p id) p) ; closest vehicle 17 | (node p id)) 18 | finally (init-algo p a) 19 | (return a))) 20 | 21 | -------------------------------------------------------------------------------- /algo/greedy-best-insertion.lisp: -------------------------------------------------------------------------------- 1 | ;;; Greedy Best Insertion heuristic 2 | ;;; ------- 3 | ;;; Using a (random) sequence, insert the one by one in the best feasible 4 | ;;; and at the optimal location in its route. Used as a feasible initial solution to the 5 | ;;; Tabu Search. Randomizing the sequence assures a broad search space when using multi-run 6 | 7 | (in-package :open-vrp.algo) 8 | 9 | (defclass greedy-best-insertion (algo) 10 | ((name :initform "Greedy Best Insertion heuristic") 11 | (desc :initform "Randomly insert nodes one by one to best vehicle at best location. Used as initial solution for search algos."))) 12 | 13 | (defmethod run-algo ((p problem) (a greedy-best-insertion)) 14 | "Randomly insert one by one to best in best location. Returns object when done." 15 | (handler-case 16 | (loop for node in (shuffle (cdr (map 'list #'(lambda (n) n) (problem-network p)))) 17 | do (perform-move p (get-best-insertion-move p node)) 18 | finally (init-algo p a) 19 | (return a)) 20 | (no-feasible-move () (print "No initial feasible solution!") (error 'no-initial-feasible-solution)))) 21 | 22 | -------------------------------------------------------------------------------- /algo/iterator.lisp: -------------------------------------------------------------------------------- 1 | ;; Iterator framework -- Search-heuristic framework used by Tabu-Search 2 | ;; -------------------------------------------- 3 | (in-package :open-vrp.algo) 4 | 5 | 6 | ;; initializer 7 | ;; ----------------- 8 | (defgeneric initialize (problem algo) 9 | (:method (problem algo) "initialize: Requires and as inputs.") 10 | (:documentation "Initializes the initial solution for the algo object.")) 11 | ;; ---------------- 12 | 13 | ;; Generate-moves 14 | ;; ------------------- 15 | (defgeneric generate-moves (algo) 16 | (:method (algo) 17 | "generate-moves: This algo is not defined; cannot generate moves.") 18 | (:documentation "Given the algo object, that contains the current solution, generate potential for next iteration as defined by the algo. e.g. insertion moves for TS and chromosome pool for GA.")) 19 | 20 | ;; -------------------- 21 | 22 | ;; Perform move 23 | ;; --------------------- 24 | (defgeneric perform-move (sol move) 25 | (:method (sol move) 26 | "perform-move: This move is not defined.") 27 | (:documentation "Performs the move defined in on the solution. Returns the new solution (which is a class of )")) 28 | 29 | ;; ----------------------- 30 | 31 | ;; Assess move(s) 32 | ;; ------------------------ 33 | (defgeneric assess-move (sol move) 34 | (:method (sol move) 35 | "assess-move: This move is not defined.") 36 | (:documentation "The is assessed by calculating the fitness of solution before, and after. The fitness is the difference and is stored in the :fitness slot of the object.")) 37 | 38 | (defun fitness-before-after (sol operation) 39 | "Given object and an #'operation function that takes the as input, return the difference of fitness between after and before." 40 | (let* ((before (fitness sol)) 41 | (clone (copy-object sol))) 42 | (funcall operation clone) 43 | (- (fitness clone) before))) 44 | 45 | (defmethod assess-move ((sol problem) (m move)) 46 | "Assesses the effect on fitness when is performed on (on a clone - undestructive)." 47 | (setf (move-fitness m) 48 | (fitness-before-after sol #'(lambda (x) (perform-move x m))))) 49 | 50 | ;; feasibility check 51 | (defmethod assess-move :around ((sol problem) (m move)) 52 | (if (or (typep m 'TS-best-insertion-move) (feasible-movep sol m)) 53 | (call-next-method) 54 | (setf (move-fitness m) nil))) 55 | 56 | (defun assess-moves (solution moves) 57 | "Given a list of objects, assess them all on the solution (uses assess-move), and setf the move's :fitness slots. Returns the list of moves." 58 | (mapcar #'(lambda (move) (assess-move solution move)) moves) 59 | moves) 60 | 61 | ;; ------------------- 62 | 63 | ;; Select move 64 | ;; ------------------- 65 | (defgeneric select-move (algo moves) 66 | (:method (algo moves) "select-move: not defined for ") 67 | (:documentation "Given an object and the list of , select a move. By default, sort the moves and select the best one, but e.g. for tabu-search, check first of the is tabu.")) 68 | 69 | (defun sort-moves (moves) 70 | "Given a list of s, sort them according to fitness (ascending). Undestructive." 71 | (sort-ignore-nil moves #'< :key #'move-fitness)) 72 | 73 | (defmethod select-move ((a algo) moves) 74 | (unless (move-fitness (car moves)) (error 'no-feasible-move :moves moves)) 75 | (car (sort-moves moves))) 76 | 77 | ;; ------------------------------------------------ -------------------------------------------------------------------------------- /algo/tools.lisp: -------------------------------------------------------------------------------- 1 | ;;; Tools to be shared among algorithms 2 | ;;; --------------------------- 3 | ;;; 0. Miscellaneous 4 | ;;; 1. Move feasibility checks 5 | ;;; 2. Heuristical tools 6 | 7 | (in-package :open-vrp.algo) 8 | 9 | ;; 0. Misc 10 | ;; ------------------------- 11 | (defstruct move fitness) 12 | 13 | (defstruct (insertion-move (:include move) (:conc-name move-)) node-ID vehicle-ID index) 14 | 15 | (defun route-from (ins-move sol) 16 | "Returns the route that contains the node that will be moved." 17 | (vehicle-route (vehicle sol (vehicle-with-node-ID sol (move-node-id ins-move))))) 18 | 19 | (defun route-to (ins-move sol) 20 | "Returns the route that will be affected by the insertion-move." 21 | (vehicle-route (vehicle sol (move-vehicle-ID ins-move)))) 22 | 23 | (defun num-nodes (prob) 24 | "Given a problem, return the number of nodes in the network." 25 | (length (problem-network prob))) 26 | 27 | (defun num-veh (prob) 28 | "Given a problem, return size of the fleet." 29 | (length (problem-fleet prob))) 30 | 31 | ;; -------------------------- 32 | 33 | ;; 1. Feasibility check of moves 34 | ;; --------------------------- 35 | 36 | (defgeneric feasible-movep (sol move) 37 | (:documentation "Given a current solution, assess feasibility of the . For CVRP, just check if it fits in the total vehicle capacity. For VRPTW, check for TW feasibility of the whole route. For CVRPTW, checks both by means of multiple-inheritance and method-combination.") 38 | (:method-combination and)) 39 | 40 | (defmethod feasible-movep and ((sol problem) (m move)) T) 41 | 42 | (defmethod feasible-movep and ((sol CVRP) (m insertion-move)) 43 | (with-slots (node-ID vehicle-ID) m 44 | (let ((veh (vehicle sol vehicle-ID))) 45 | ; if node is already on the route, moving intra-route is feasible 46 | (if (node-on-routep node-ID veh) T 47 | (multiple-value-bind (comply cap-left) (in-capacityp veh) 48 | (unless comply (error 'infeasible-solution :sol sol :func #'in-capacityp)) 49 | (<= (node-demand (node sol node-ID)) cap-left)))))) 50 | 51 | (defmethod feasible-movep and ((sol VRPTW) (m insertion-move)) 52 | (let ((node-id (move-node-id m)) 53 | (veh-id (move-vehicle-id m)) 54 | (index (move-index m))) 55 | (symbol-macrolet ((full-route (vehicle-route (vehicle sol veh-id))) 56 | (ins-node (node sol node-ID)) 57 | (to (if (= 1 i) ins-node (car route))) 58 | (arr-time (+ time (travel-time loc to :dist-array (problem-dist-array sol))))) 59 | (constraints-check 60 | (route time loc i) 61 | ((cdr full-route) 0 (car full-route) index) 62 | ((if (= 1 i) route (cdr route)) ;don't skip after inserting new node 63 | (time-after-serving-node to arr-time) ;set time after new node 64 | to (1- i)) 65 | (<= arr-time (node-end to)) 66 | (and (null route) (< i 1)))))) ; case of append, need to check once more 67 | 68 | ;; for debugging (insert in test-form with progn) 69 | ; (format t "Route: ~A~% Loc: ~A~% To: ~A~% Time: ~A~% Arr-time: ~A~% Node-start: ~A~% Node-end: ~A~% Duration: ~A~% ins-node-end: ~A~% i: ~A~%" (mapcar #'node-id route) (node-id loc) (node-id to) time arr-time (node-start to) (node-end to) (node-duration to) (node-end ins-node) i) 70 | ;; ----------------------------- 71 | 72 | ;; ---------------------------- 73 | 74 | ;; 2. Tools for solution building heuristics 75 | ;; --------------------------- 76 | 77 | ;; Closest node (used by Greedy Nearest Neighborhood) 78 | ;; --------------------------- 79 | 80 | (defun get-min-index-with-tabu (distances tabu) 81 | "Returns index of the first next closest, that is not in chosen (which is a list)." 82 | (with-tabu-indices tabu #'get-min-index distances)) 83 | 84 | (defun get-closest-node (prob veh-id &optional tabu) 85 | "Returns the closest node from the last location of vehicle. Requires and vehicle-ID. A tabu list of node-IDs is optional to exclude consideration of some nodes." 86 | (let* ((loc (last-node (vehicle prob veh-id))) 87 | (dists (get-array-row (problem-dist-array prob) (node-id loc)))) 88 | (aif (get-min-index-with-tabu dists tabu) 89 | (node prob it) 90 | nil))) 91 | ;; -------------------------- 92 | 93 | ;; Closest Vehicle (used by Greedy Append) 94 | ;; --------------------------- 95 | (defun dists-to-vehicles (node prob) 96 | "Given a and a , return the list of all the distances from the to the current positions of the fleet. Used by get-closest-(feasible)-vehicle." 97 | (mapcar #'(lambda (x) (distance (node-id (last-node x)) 98 | (node-id node) 99 | (problem-dist-array prob))) 100 | (problem-fleet prob))) 101 | 102 | ;; challenge: what if the vehicle is located on the node n - use only for initial insertion? 103 | (defun get-closest-vehicle (n prob) 104 | "Returns the closest to . Used by insertion heuristic. When multiple are on equal distance, choose first one (i.e. lowest ID)." 105 | (vehicle prob (get-min-index (dists-to-vehicles n prob)))) 106 | ;; ------------------------- 107 | 108 | ;; Closest Feasible Vehicle 109 | ;; ---------------------------- 110 | (defmethod get-closest-feasible-vehicle ((n node) (prob problem)) 111 | (get-closest-vehicle n prob)) 112 | 113 | ;; Capacity check 114 | (defun capacities-left (prob) 115 | "Returns a list of all capacities left on the vehicles given the present solution." 116 | (mapcar #'(lambda (x) (multiple-value-bind (c cap) 117 | (in-capacityp x) (when c cap))) 118 | (problem-fleet prob))) 119 | 120 | (defmethod get-closest-feasible-vehicle ((n node) (prob CVRP)) 121 | "Returns the vehicle closest to the node and has enough capacity." 122 | (handler-case 123 | (vehicle prob (get-min-index 124 | (mapcar #'(lambda (dist cap) 125 | (unless (> (node-demand n) cap) dist)) 126 | (dists-to-vehicles n prob) 127 | (capacities-left prob)))) 128 | (list-of-nils () (error 'no-feasible-move :moves n)))) 129 | 130 | 131 | ;; Time-window check 132 | (defun times-of-arriving (node prob) 133 | "Returns a list of arrival times of the vehicles to node given the present solution." 134 | (mapcar #'(lambda (x) 135 | (multiple-value-bind (c time) 136 | (veh-in-timep x) (when c (+ time (travel-time (last-node x) node :dist-array (problem-dist-array prob)))))) 137 | (problem-fleet prob))) 138 | 139 | ;; Feasiblility of appending at the end only. 140 | (defmethod get-closest-feasible-vehicle ((n node) (prob VRPTW)) 141 | "Returns the vehicle closest to the node that has enough time at the end of its route. Used for appending nodes. Use get-optimal-insertion instead for inserting feasibly into routes." 142 | (handler-case 143 | (vehicle prob (get-min-index 144 | (mapcar #'(lambda (dist arr-time cap) 145 | (unless (or (> (node-demand n) cap) 146 | (> arr-time (node-end n))) 147 | dist)) 148 | (dists-to-vehicles n prob) 149 | (times-of-arriving n prob) 150 | (capacities-left prob)))) 151 | (list-of-nils () (error 'no-feasible-move :moves n)))) 152 | -------------------------------------------------------------------------------- /doc/changelog.txt: -------------------------------------------------------------------------------- 1 | v. 0.6.3 2 | 3 | Other: 4 | 5 | - Raise error 'no-initial-feasible-solution 6 | 7 | v. 0.6.2 8 | 9 | Other: 10 | 11 | - Bugfix for asymmetric problems with time-windows 12 | 13 | v. 0.6.1 14 | 15 | Features: 16 | 17 | - Generic input file reader (used by batch-run) 18 | 19 | Other: 20 | 21 | - logging in a directory by name of problem 22 | - Moved all output related functions out of batch-run.lisp to output.lisp 23 | - Batch-run table of results will print each test-case as it finishes 24 | (instead of waiting for the whole batch to finish and keeping results in memory) 25 | - Batch-run will return all algo objects holding the solutions 26 | - Add a directory of Solomon-25 test-cases for quick/simple testing of batch runs 27 | 28 | v. 0.6.0 29 | 30 | Features: 31 | 32 | - Batch-run that walks a directory with test-cases and summarises result in table 33 | - Multi-run logging with multi-run-algo 34 | - Timestamped log files to avoid overwriting 35 | 36 | Other: 37 | 38 | - define-problem accepts parameters log-mode and plotp to set at create time 39 | - change function name load-testcase-solomon to load-solomon-vrp-file 40 | - Amalgamated config functions under config-functions.lisp 41 | - changed log-mode method to log-to-replp, since that was its only usage -- DRYer code 42 | 43 | v. 0.5.1 44 | 45 | - Performance increase by 67% (see issue #19) 46 | - Use defstruct for nodes, vehicles, drawer and moves 47 | - improve efficiency of node-on-routep, vehicle-with-node-id and map0-n/map1-n 48 | 49 | 50 | v. 0.5 51 | 52 | - First versioning of a "stable" Open-VRP 53 | -------------------------------------------------------------------------------- /doc/class-diagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mck-/Open-VRP/408cb67063474ab61ddfc1631b5ac39714f2535e/doc/class-diagram.png -------------------------------------------------------------------------------- /doc/iterator.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mck-/Open-VRP/408cb67063474ab61ddfc1631b5ac39714f2535e/doc/iterator.png -------------------------------------------------------------------------------- /lib/batch-run.lisp: -------------------------------------------------------------------------------- 1 | ;; Batch run function -- used for benchmarking/algo testing 2 | ;; Requires a directory with test-case files of same format (may be nested) 3 | ;; -------------------------- 4 | (in-package :open-vrp.util) 5 | 6 | (defmacro batch-run ((x dir-path &key (plotp nil) (log-mode 1)) output-file num-times &body algo-call) 7 | "Given a directory, will call algo-call on each file that is loaded using the loader-fn and bound to x. Output-file is a mandatory filepath to which the results will be written. Algo-call must return an object (e.g. multi-run-algo or solve-prob). Num-times is the number of times the algo-call will run on each test-case, which will be used for stats. Will return a list of list of algo objects holding the solutions. 8 | 9 | Example: (batch-run (test-case \"test-cases/Solomon-25/\") 10 | \"run-logs/Solomon-25-batch.txt\" 20 11 | (solve-prob test-case (make-instance 'tabu-search :iterations 300)))." 12 | (with-gensyms (file str results all-results) 13 | `(progn 14 | (with-open-file (,str (ensure-directories-exist ,output-file) 15 | :if-exists :supersede :direction :output) 16 | (print ',(car algo-call) ,str) ;to record what the algo-call was 17 | (print-batch-run-table-header ,str)) 18 | (let ((,all-results)) 19 | (walk-directory 20 | ,dir-path 21 | (lambda (,file) 22 | (let ((,x (load-test-case-file ,file))) 23 | (setf (drawer-plotp (problem-drawer ,x)) ,plotp) 24 | (set-log-mode ,x ,log-mode) 25 | (let ((,results (multi-run ,num-times ,@algo-call))) 26 | (append-run-result ,output-file ,results) 27 | (push ,results ,all-results))))) 28 | (nreverse ,all-results))))) 29 | -------------------------------------------------------------------------------- /lib/class-definitions.lisp: -------------------------------------------------------------------------------- 1 | ;;; All class definitions for CLOS VRP 2 | ;;; Node, Vehicle, Problem, Drawer and Algo objects 3 | (in-package :open-vrp.classes) 4 | 5 | ;; The node object 6 | ;; ---------------------- 7 | 8 | (defstruct node 9 | (id 0 :type fixnum :read-only t) 10 | (xcor 0 :read-only t) 11 | (ycor 0 :read-only t) 12 | (demand 0 :type fixnum :read-only t) 13 | (start 0 :type fixnum :read-only t) 14 | (end 0 :type fixnum :read-only t) 15 | (duration 0 :type fixnum :read-only t)) 16 | ;; -------------------------- 17 | 18 | ;; The vehicle object 19 | ;; --------------------------- 20 | 21 | (defstruct vehicle 22 | (id 0 :type fixnum :read-only t) 23 | route 24 | (capacity 0 :type fixnum :read-only t) 25 | (speed 1 :read-only t)) 26 | ;; ---------------------------- 27 | 28 | ;; The problem object class 29 | ;; ----------------------- 30 | ;; NOTE: The object is also a object interchangably. 31 | 32 | (defclass problem () 33 | ((name :reader problem-name :initarg :name :initform "VRP") 34 | (desc :reader problem-desc :initarg :desc :initform "Vehicle Routing Problem" :allocation :class) 35 | (network :reader problem-network :initarg :network) 36 | (dist-array :accessor problem-dist-array :initarg :dist-array :initform nil) 37 | (fleet :reader problem-fleet :initarg :fleet) 38 | (to-depot :accessor problem-to-depot :initarg :to-depot :initform T) 39 | (drawer :accessor problem-drawer :initarg :drawer :initform nil) 40 | (log-file :accessor problem-log-file :initarg :log-file :initform nil) 41 | (log-mode :accessor problem-log-mode :initarg :log-mode :initform 1))) 42 | ;; log-mode 0 = off, 1 = output file, 2 = REPL 43 | 44 | (defclass CVRP (problem) 45 | ((name :initform "CVRP") 46 | (desc :initform "Capacitated Vehicle Routing Problem"))) 47 | 48 | (defclass VRPTW (problem) 49 | ((name :initform "VRPTW") 50 | (desc :initform "Vehicle Routing Problem with Time Windows"))) 51 | 52 | (defclass CVRPTW (CVRP VRPTW) 53 | ((name :initform "CVRPTW") 54 | (desc :initform "Capacitated Vehicle Routing Problem with Time Windows"))) 55 | 56 | ;; ---------------------- 57 | 58 | ;; The drawing object class 59 | ;; -------------------------------- 60 | (defstruct drawer 61 | min-coord 62 | max-coord 63 | (x-pos 0) 64 | (y-pos 0) 65 | (max-pix 1000) 66 | (legendp T) 67 | (legend-x 100) 68 | (legend-y 900) 69 | filename 70 | (plotp nil)) 71 | 72 | ;; ----------------------------- 73 | 74 | ;; Algo class 75 | ;; ----------------------- 76 | 77 | (defclass algo () 78 | ((name :reader algo-name :initarg :name) 79 | (desc :reader algo-desc :initarg :desc :allocation :class) 80 | (best-sol :accessor algo-best-sol :initarg :best-sol :initform nil) 81 | (best-fitness :accessor algo-best-fitness :initarg :best-fitness :initform nil) 82 | (best-iteration :accessor algo-best-iteration :initform 0) 83 | (current-sol :accessor algo-current-sol :initarg :current-sol :initform nil) 84 | (iterations :accessor algo-iterations :initarg :iterations) 85 | (animatep :accessor algo-animatep :initarg :animatep :initform nil))) 86 | -------------------------------------------------------------------------------- /lib/conditions.lisp: -------------------------------------------------------------------------------- 1 | ;; Error condition definitions 2 | ;; ------------------------- 3 | 4 | (in-package :open-vrp.util) 5 | 6 | ;; lib/lists.lisp 7 | (define-condition unaccepted-predicate (error) 8 | ((pred :initarg :pred :reader pred)) 9 | (:report "Accepts only #'> or #'<.")) 10 | 11 | (define-condition index-out-of-bounds (error) 12 | ((index :initarg :index :reader index) 13 | (ls :initarg :ls :reader ls))) 14 | 15 | (define-condition list-of-nils (error) 16 | ((ls :initarg :ls :reader ls) 17 | (key :initarg :key :reader key)) 18 | (:report "Cannot get min/max from a list of NIL values.")) 19 | 20 | ;; lib/network.lisp 21 | (define-condition same-origin-destination (error) 22 | ((from :initarg :from :reader from) 23 | (to :initarg :to :reader to)) 24 | (:report "Trying to lookup distance for same origin and destination - NIL")) 25 | 26 | ;; lib/constraints.lisp 27 | (define-condition infeasible-solution (error) 28 | ((sol :initarg :sol :reader sol) 29 | (func :initarg :func :reader func)) 30 | (:report "The provided solution is already infeasible, cannot check for feasibility of the move.")) 31 | 32 | (define-condition no-capacities-vehicle (error) 33 | ((veh :initarg :veh :reader veh)) 34 | (:report "Trying to check capacities for a vehicle that has no defined capacity.")) 35 | 36 | (define-condition no-speed-vehicle (error) 37 | ((veh :initarg :veh :reader veh)) 38 | (:report "Trying to check TW constraints for a vehicle that has no defined speed.")) 39 | 40 | ;; lib/network.lisp lib/fleet.lisp 41 | (define-condition not-equal-length (error) 42 | ((lists :initarg :lists :reader lists)) 43 | (:report "Trying to create objects where input lists are of unequal length!")) 44 | 45 | ;; lib/init-macros.lisp 46 | (define-condition empty-network (error)() 47 | (:report "Network is empty! To create a network requires at least one parameter!")) 48 | 49 | ;; lib/draw-solution.lisp 50 | (define-condition missing-drawer-object (error) 51 | ((prob :initarg :prob :reader prob)) 52 | (:report "Missing a object! Are you trying to plot without node-coords?")) 53 | 54 | ;; lib/read-test-case.lisp 55 | (define-condition file-not-recognized (error) 56 | ((file :initarg :file :reader :file)) 57 | (:report "Input file not recognized!")) 58 | -------------------------------------------------------------------------------- /lib/config-functions.lisp: -------------------------------------------------------------------------------- 1 | ;; Collection of callable configuration functions in one place 2 | ;; ------------------- 3 | (in-package :open-vrp.util) 4 | 5 | ;; Config for plotting 6 | ;; ------------------- 7 | 8 | (define-modify-macro toggle () not) 9 | 10 | (defgeneric toggle-plot (problem/algo) 11 | (:documentation "Toggles plotting on/off of best solution. Config boolean is held by object's plotp slot.")) 12 | 13 | (defmethod toggle-plot ((pr problem)) 14 | (aif (problem-drawer pr) 15 | (toggle (drawer-plotp it)) 16 | (error 'missing-drawer-object :prob pr))) 17 | 18 | (defmethod toggle-plot ((a algo)) 19 | (toggle-plot (algo-best-sol a))) 20 | 21 | (defun toggle-animate (algo) 22 | "Toggles animation, which means plotting every iteration in run-frames/ folder" 23 | (toggle (algo-animatep algo))) 24 | 25 | (defgeneric toggle-legend (problem/algo) 26 | (:documentation "Toggles legend drawing. When is provided, toggles :best-sol")) 27 | 28 | (defmethod toggle-legend ((pr problem)) 29 | (aif (problem-drawer pr) 30 | (toggle (drawer-legendp it)) 31 | (error 'missing-drawer-object :prob pr))) 32 | 33 | (defmethod toggle-legend ((a algo)) 34 | (toggle-legend (algo-best-sol a))) 35 | 36 | (defun set-plot-file (prob path) 37 | "Sets the plot output file location." 38 | (setf (drawer-filename (problem-drawer prob)) path)) 39 | ;; ------------------- 40 | 41 | ;; Config for logging 42 | ;; ------------------- 43 | (defun set-log-mode (prob x) 44 | "Sets log-mode: 0 for no log, 1 for log to log-file, 2 for REPL log." 45 | (setf (problem-log-mode prob) x)) 46 | 47 | (defun set-log-file (prob path) 48 | "Sets the output location of the log-file." 49 | (setf (problem-log-file prob) path)) 50 | 51 | ;; ------------------- 52 | 53 | ;; Config for problem 54 | ;; ------------------- 55 | 56 | (defun set-dist-array (problem dist-array) 57 | "Given a and a 2-dimensional list or array in dist-array, set it in " 58 | (setf (problem-dist-array problem) (if (listp dist-array) 59 | (2d-list-to-array dist-array) 60 | dist-array))) -------------------------------------------------------------------------------- /lib/constraints.lisp: -------------------------------------------------------------------------------- 1 | ;;; Constraint checking functions 2 | ;;; -------------- 3 | ;;; 0. General Constraints Checker tools 4 | ;;; 1. Capacity Constraints 5 | ;;; 2. Time-window Constraints 6 | ;;; --------------- 7 | (in-package :open-vrp.util) 8 | 9 | ;; 0. General tools/definitions 10 | ;; ---------------------------- 11 | 12 | (defgeneric constraintsp (prob) 13 | (:documentation "Tests weather the solution in the is complying with the constraints. If the problem is a CVRP, check for capacity. If it is a VRPTW, check for time-windows. For CVRPTW, that inherits from both classes, check both constraints.") 14 | (:method-combination and)) 15 | 16 | (defmethod constraintsp and ((prob problem)) T) 17 | 18 | (defmethod constraintsp and ((sol CVRP)) (in-capacityp sol)) 19 | 20 | (defmethod constraintsp and ((sol VRPTW)) (in-timep sol)) 21 | 22 | ;; Helper macro for defining constraints-checking methods below 23 | ;; Returns NIL as soon as it finds out that a constraint is violated 24 | (defmacro constraints-check (arglist init-forms next-forms testform &optional endtest) 25 | (let ((iter (gensym))) 26 | `(labels ((,iter ,arglist 27 | (if ,@(if endtest `(,endtest) `((null ,(car arglist)))) 28 | (values T ,@(cdr arglist)) 29 | (and 30 | ,testform 31 | (,iter ,@next-forms))))) 32 | (,iter ,@init-forms)))) 33 | ;; ------------------------- 34 | 35 | ;; 1. Capacity Constraints 36 | ;; ------------------------ 37 | 38 | (defgeneric in-capacityp (veh/cvrp) 39 | (:method (obj) "Expects a / object!") 40 | (:documentation "Tests weather the route on is complying with the capacity constraint. Returns T and the remaining capacity if it does. When is provided, test all vehicles.")) 41 | 42 | (defmethod in-capacityp ((v vehicle)) 43 | (unless (vehicle-capacity v) (error 'no-capacities-vehicle :veh v)) 44 | (constraints-check 45 | (route cap) 46 | ((vehicle-route v) (vehicle-capacity v)) 47 | ((cdr route) (- cap (node-demand (car route)))) 48 | (<= (node-demand (car route)) cap))) 49 | 50 | (defmethod in-capacityp ((pr CVRP)) 51 | (constraints-check 52 | (flt) 53 | ((problem-fleet pr)) 54 | ((cdr flt)) 55 | (in-capacityp (car flt)))) 56 | 57 | ;; ------------------------------ 58 | 59 | ;; 2. Time-window constraints 60 | ;; ------------------------- 61 | 62 | (defun travel-time (n1 n2 &key dist-array (speed 1)) 63 | "Given two and optional speed, return the travel-time. When dist-array is not provided, calculate distance directly using coords." 64 | (handler-case 65 | (/ (if dist-array 66 | (distance (node-id n1) (node-id n2) dist-array) 67 | (node-distance n1 n2)) 68 | speed) 69 | (same-origin-destination () 0))) 70 | 71 | (defun time-after-serving-node (node arrival-time) 72 | "Given a node to serve and the current time, return the new time (if on-time to begin with). When arrival-time is too early, wait till earliest start time." 73 | (cond ((> arrival-time (node-end node)) (error 'infeasible-solution :sol node :func arrival-time :msg "Arrival time is later than latest start-time of node")) 74 | ((< arrival-time (node-start node)) (+ (node-start node) (node-duration node))) ;wait 75 | (t (+ arrival-time (node-duration node))))) 76 | 77 | (defun veh-in-timep (v &optional dist-array) 78 | "Tests weather the route on is complying with the time-window constraints. Returns T and the time of finishing its last task." 79 | (unless (vehicle-speed v) (error 'no-speed-vehicle :veh v)) 80 | (symbol-macrolet ((to (car route)) 81 | (arr-time (+ time (travel-time loc to :dist-array dist-array :speed (vehicle-speed v))))) 82 | (constraints-check 83 | (route time loc) 84 | ((cdr (vehicle-route v)) 0 (car (vehicle-route v))) 85 | ((cdr route) (time-after-serving-node to arr-time) to) 86 | (<= arr-time (node-end to))))) 87 | 88 | (defmethod in-timep ((pr VRPTW)) 89 | (constraints-check 90 | (veh) 91 | ((problem-fleet pr)) 92 | ((cdr veh)) 93 | (veh-in-timep (car veh) (aif (problem-dist-array pr) it)))) 94 | ;; ------------------------- 95 | 96 | 97 | -------------------------------------------------------------------------------- /lib/draw-solution.lisp: -------------------------------------------------------------------------------- 1 | ;;; Plot the solution given in *solution* using vecto 2 | ;;; ------- 3 | ;;; Use (plot-solution ) 4 | ;;; (plot-nodes ) for just the nodes. 5 | 6 | (in-package :open-vrp.util) 7 | 8 | (defparameter *r* 0) 9 | (defparameter *g* 0) 10 | (defparameter *b* 0) 11 | 12 | ;; Helper functions 13 | ;; ----------------------------- 14 | (defun coord->pix (drawer x) 15 | "Given a drawer and a coord, calculate the associated x/y pixel. Includes 1 coord as border." 16 | (let ((min (1- (drawer-min-coord drawer))) 17 | (max (1+ (drawer-max-coord drawer))) 18 | (max-pix (drawer-max-pix drawer))) 19 | (* (- x min) (/ max-pix (- max min))))) 20 | 21 | (defun get-color () 22 | "Returns next color. Deterministically random." 23 | (macrolet ((get-next-color (c inc) 24 | `(setf ,c (mod (+ ,c ,inc) 1)))) 25 | (values (get-next-color *r* 0.15) 26 | (get-next-color *g* 0.23) 27 | (get-next-color *b* 0.32)))) 28 | 29 | ;; anaphoric macro input index of the node, and binds coords, pix-x and pix-y to the node's. 30 | (defmacro use-node (drawer node &body body) 31 | `(let ((pix-x (coord->pix ,drawer (node-xcor ,node))) 32 | (pix-y (coord->pix ,drawer (node-ycor ,node)))) 33 | ,@body)) 34 | 35 | ;; ------------------------------ 36 | 37 | ;; Arrow drawing 38 | ;; ------------------------------ 39 | 40 | ;; Tue Dec 6, 2011 - fixing for CLOS (using defun instead of defmethod for convenience?) 41 | (defun store-pix (drawer pix-x pix-y) 42 | "Store the position of the path (helper function for arrow calculation)." 43 | (setf (drawer-x-pos drawer) pix-x 44 | (drawer-y-pos drawer) pix-y)) 45 | 46 | (defun arrow-to (drawer pix-x pix-y size skew) 47 | "Draws an arrow as in line-to, but creates an arrow in the middle of size. Use with canvas!" 48 | (let* ((v (- pix-x (drawer-x-pos drawer))) 49 | (w (- pix-y (drawer-y-pos drawer))) 50 | (cen-x (+ (drawer-x-pos drawer) (/ v 2))) 51 | (cen-y (+ (drawer-y-pos drawer) (/ w 2))) 52 | (mid-x (+ (drawer-x-pos drawer) (* skew v))) 53 | (mid-y (+ (drawer-y-pos drawer) (* skew w))) 54 | (A-x (- mid-x (* size w))) 55 | (A-y (+ mid-y (* size v))) 56 | (B-x (+ mid-x (* size w))) 57 | (B-y (- mid-y (* size v)))) 58 | (line-to mid-x mid-y) 59 | (line-to A-x A-y) 60 | (line-to cen-x cen-y) 61 | (line-to B-x B-y) 62 | (line-to mid-x mid-y) 63 | (line-to pix-x pix-y))) 64 | 65 | ;; ---------------------------------- 66 | 67 | ;; Node drawing 68 | ;; --------------------------------- 69 | (defun draw-nodes (prob) 70 | "Given the object, plot the nodes only. Usage only with-canvas!" 71 | (map0-n #'(lambda (x) 72 | (let ((node (node prob x))) 73 | (use-node (problem-drawer prob) node 74 | (set-rgb-fill 1.0 0.65 0.3) 75 | (centered-circle-path pix-x pix-y 10) 76 | (fill-path) 77 | (set-rgb-fill 0 0 0) 78 | (draw-centered-string pix-x (- pix-y 5) (write-to-string (node-id node)))))) 79 | (1- (length (problem-network prob))))) 80 | ;; ---------------------------- 81 | 82 | ;; Legend drawing 83 | ;; ----------------------------- 84 | (defun draw-legend-item (drawer veh-obj r g b) 85 | (let ((leg-x (drawer-legend-x drawer)) 86 | (leg-y (drawer-legend-y drawer))) 87 | (set-rgb-fill r g b) 88 | (centered-circle-path leg-x leg-y 12) 89 | (fill-path) 90 | (set-rgb-fill 0 0 0) 91 | (draw-centered-string leg-x (- leg-y 6) (write-to-string (vehicle-id veh-obj))) 92 | (draw-string (+ leg-x 30) (- leg-y 6) (write-to-string (route-indices veh-obj))) 93 | (setf (drawer-legend-y drawer) (- leg-y 30)))) 94 | 95 | ;----------------------------- 96 | 97 | ;; Solution drawing 98 | ;; ----------------------------- 99 | 100 | (defgeneric plot-solution (problem/algo &optional output-file) 101 | ; (:method (problem &optional output-file) "Expects object as input!") 102 | (:documentation "Given a solution object (/), draw the solution in output file given in the drawer object's :filename slot (which is held in problem-drawer slot). When object as input, draw the best found solution by that algo object.")) 103 | 104 | (defmethod plot-solution ((sol problem) &optional output-file) 105 | ;; initial color (determined after trial and error) 106 | (setf *r* 0.3) 107 | (setf *g* 0.28) 108 | (setf *b* 0.62) 109 | 110 | (let ((dr (problem-drawer sol))) 111 | (unless dr (error 'missing-drawer-object :prob sol)) 112 | (with-canvas (:width (drawer-max-pix dr) :height (drawer-max-pix dr)) 113 | (let ((font (get-font (merge-pathnames "FreeSerif.ttf" 114 | (asdf:system-source-directory 'open-vrp)))) 115 | (temp-y (drawer-legend-y dr))) ;save the original value (draw-legend-item sets it) 116 | ;settings 117 | (set-font font 15) 118 | (set-rgb-fill 1.0 1.0 1.0) 119 | (clear-canvas) 120 | (set-line-width 3) 121 | ;iterate over fleet - draw routes & legend together 122 | (dolist (veh (get-busy-vehicles sol)) 123 | (multiple-value-bind (r g b) (get-color) 124 | (when (drawer-legendp dr) 125 | (draw-legend-item dr veh r g b)) ; draw legend item 126 | (set-rgb-stroke r g b)) 127 | 128 | (use-node dr (first (vehicle-route veh)) ; draw path 129 | (centered-circle-path pix-x pix-y 12) ;circle the departing node 130 | (stroke) 131 | (move-to pix-x pix-y) 132 | (store-pix dr pix-x pix-y) 133 | (dolist (node (rest (vehicle-route veh))) 134 | (use-node dr node 135 | (arrow-to dr pix-x pix-y 0.038 0.45) ;draw arrows 136 | (store-pix dr pix-x pix-y)))) 137 | (stroke)) 138 | 139 | (setf (drawer-legend-y dr) temp-y) ;reset to original value 140 | (draw-nodes sol) ;drawing nodes 141 | (draw-string (* 0.1 (drawer-max-pix dr)) (* 0.1 (drawer-max-pix dr)) (write-to-string (fitness sol))) ;solution fitness 142 | 143 | ; save file 144 | (if output-file 145 | (save-png output-file) 146 | (save-png (drawer-filename dr))))))) 147 | 148 | (defmethod plot-solution ((a algo) &optional output-file) 149 | (plot-solution (algo-best-sol a) output-file)) 150 | 151 | (defgeneric plot-nodes (problem) 152 | (:method (problem) "Expects as input!") 153 | (:documentation "Draws only the nodes in output file.")) 154 | 155 | (defmethod plot-nodes ((prob problem)) 156 | (let ((dr (problem-drawer prob))) 157 | (unless dr (error 'missing-drawer-object :prob prob)) 158 | (with-canvas (:width (drawer-max-pix dr) :height (drawer-max-pix dr)) 159 | (let ((font (get-font (merge-pathnames "FreeSerif.ttf" 160 | (asdf:system-source-directory 'open-vrp))))) 161 | ;settings 162 | (set-font font 15) 163 | (set-rgb-fill 1.0 1.0 1.0) 164 | (clear-canvas) 165 | (set-line-width 3) 166 | (draw-nodes prob) 167 | (save-png (drawer-filename dr)))))) 168 | 169 | ;; ---------------------------------------------- -------------------------------------------------------------------------------- /lib/fitness.lisp: -------------------------------------------------------------------------------- 1 | ;;; Fitness functions for each type of problem 2 | ;;; ----------------------------------------- 3 | (in-package :open-vrp.util) 4 | 5 | (defgeneric fitness (problem) 6 | (:method (problem) "Parameter is not a object!") 7 | (:documentation "The generic fitness function. To be defined for each class of specifically. This function allows for custom fitness-functions for your own defined classess. The default fitness function is total distance.")) 8 | 9 | (defmethod fitness ((prob problem)) 10 | (values 11 | (total-dist prob (problem-dist-array prob)) 12 | (constraintsp prob))) -------------------------------------------------------------------------------- /lib/fleet.lisp: -------------------------------------------------------------------------------- 1 | ;;; Fleet related functions 2 | ;;; --------------------------- 3 | ;;; - route-indices (/)- returns list of node IDs 4 | ;;; - vehicle-with-node ( int) - returns that has the node-ID 5 | ;;; - total-dist (/) - returns the total distance 6 | ;;; - vehicle ( int) - returns with id 7 | ;;; - new-vehicle - macro that creates a according to input 8 | 9 | (in-package :open-vrp.util) 10 | 11 | (defgeneric route-indices (obj) 12 | (:method (vehicle) "Input is not a / object!") 13 | (:documentation "When input is a , returns its route as a list of node IDs. When input is /, list all routes.")) 14 | 15 | (defmethod route-indices ((v vehicle)) 16 | (mapcar #'node-ID (vehicle-route v))) 17 | 18 | (defmethod route-indices ((p problem)) 19 | (mapcar #'route-indices (problem-fleet p))) 20 | 21 | (defun node-on-routep (node-id vehicle) 22 | "Returns NIL of does not have the node on its route." 23 | (member node-id (vehicle-route vehicle) :key #'node-id)) 24 | 25 | (defun vehicle-with-node-ID (prob node-ID) 26 | "Given a node-ID, return the vehicle-ID that has the node in its route. The function for the input of the base-node 0 is undefined. Returns NIL if node-ID cannot be found." 27 | (position-if #'(lambda (veh) (node-on-routep node-ID veh)) (problem-fleet prob))) 28 | 29 | (defgeneric total-dist (veh/prob dist-array) 30 | (:method (veh/prob dist-array) "Expects as input!") 31 | (:documentation "Returns total distance of the route(s) given a vehicle or a fleet.")) 32 | 33 | (defmethod total-dist ((v vehicle) dist-array) 34 | (let ((route (vehicle-route v))) 35 | (labels ((iter (togo sum) 36 | (if (null (cdr togo)) sum 37 | (iter (cdr togo) 38 | (+ sum 39 | (handler-case (distance (node-id (car togo)) 40 | (node-id (cadr togo)) 41 | dist-array) 42 | (same-origin-destination () 0))))))) 43 | (iter route 0)))) 44 | 45 | 46 | (defmethod total-dist ((p problem) dist-array) 47 | (sum (mapcar #'(lambda (v) (total-dist v dist-array)) (get-busy-vehicles p)))) 48 | 49 | ;; Accessor functions 50 | ;; ------------------ 51 | (defmethod vehicle ((p problem) id) 52 | (nth id (problem-fleet p))) 53 | ;; ------------------ 54 | 55 | ;; Create Vehicle macro 56 | ;; ------------------ 57 | (defmacro new-vehicle (id base-node to-depot &key capacity speed) 58 | `(make-vehicle 59 | :id ,id 60 | :route ,(if to-depot `(list ,base-node ,base-node) `(list ,base-node)) 61 | ,@(when capacity `(:capacity ,capacity)) 62 | ,@(when speed `(:speed ,speed)))) -------------------------------------------------------------------------------- /lib/init-macros.lisp: -------------------------------------------------------------------------------- 1 | ;;; Creating objects macros 2 | ;;; - create-nodes 3 | ;;; - create-vehicles 4 | ;;; - define-problem 5 | 6 | (in-package :open-vrp.util) 7 | 8 | ;; Initialising Drawer object functions 9 | ;; --------------------------- 10 | (defun get-min-coord (node-coords) 11 | (reduce #'min (flatten node-coords))) 12 | 13 | (defun get-max-coord (node-coords) 14 | (reduce #'max (flatten node-coords))) 15 | ;; --------------------------- 16 | 17 | ;; Create network 18 | ;; ---------------------------- 19 | (defun same-lengthp(&rest lists) 20 | "Returns NIL if lists are not of equal length. Returns their length if all are equal. Accepts NIL arguments or single numbers, which will be ignored. Also accepts 2-dimensional arrays." 21 | (let ((pruned-list (remove-if-not #'consp 22 | (mapcar #'(lambda (x) 23 | (if (arrayp x) (2d-array-to-list x) x)) 24 | lists)))) 25 | (labels ((iter (ls len) 26 | (if (null ls) len 27 | (and (= len (length (car ls))) 28 | (iter (cdr ls) len))))) 29 | (iter (cdr pruned-list) (length (car pruned-list)))))) 30 | 31 | (defmacro create-nodes (&key node-coords demands time-windows durations dist-matrix) 32 | "Will return a vector of nodes that are numbered starting from 0 (which should be the base node, by convention over configuration). All attribute parameters are optional but must be of the same length. Note that dist-matrix parameter is not used, but only to create nodes when no other parameter is passed (called from define-problem)." 33 | (with-gensyms (nodes id coords demand tw dur ln) 34 | ;; Checking if input attributes' length is equal to node-coords' length 35 | `(let ((,ln (same-lengthp ,node-coords ,demands ,time-windows ,durations ,dist-matrix))) 36 | (unless ,ln (error 'not-equal-length 37 | :lists (list ,node-coords ,demands ,time-windows ,durations ,dist-matrix))) 38 | (loop with ,nodes = (make-array ,ln :fill-pointer 0) ;vector of nodes 39 | for ,id from 0 to ,ln 40 | ,@(when node-coords `(and ,coords in ,node-coords)) 41 | ,@(when demands `(and ,demand in ,demands)) 42 | ,@(when time-windows `(and ,tw in ,time-windows)) 43 | ,@(when durations `(and ,dur in ,durations)) 44 | do 45 | (vector-push 46 | (make-node 47 | :id ,id 48 | ,@(when node-coords `(:xcor (car ,coords) :ycor (cdr ,coords))) 49 | ,@(when demands `(:demand ,demand)) 50 | ,@(when time-windows `(:start (car ,tw) :end (cdr ,tw))) 51 | ,@(when durations `(:duration ,dur))) 52 | ,nodes) 53 | finally (return ,nodes))))) 54 | 55 | ;; Create fleet 56 | ;; -------------------------- 57 | (defmacro create-vehicles (fleet-size base-node to-depot &key capacities speeds) 58 | "Returns a list of vehicles, starting with ID 0. The starting location of their routes are all initialized at base-node. When to-depot is set to T, initialize their routes with 2 base nodes (departure and destination). For capacities and speeds, only accepts a list that is of equal lenght to fleet-size." 59 | (with-gensyms (id capacity speed) 60 | `(progn 61 | ;; Checking if input attributes' length is equal to fleet-size 62 | (when (and ,capacities (not (= (length ,capacities) ,fleet-size))) 63 | (error 'not-equal-length :lists (list ,fleet-size ,capacities))) 64 | (when (and ,speeds (not (= (length ,speeds) ,fleet-size))) 65 | (error 'not-equal-length :lists (list ,fleet-size ,speeds))) 66 | 67 | (loop for ,id from 0 to (1- ,fleet-size) 68 | ,@(when capacities `(and ,capacity in ,capacities)) 69 | ,@(when speeds `(and ,speed in ,speeds)) 70 | collect 71 | (new-vehicle ,id ,base-node ,to-depot 72 | ,@(when capacities `(:capacity ,capacity)) 73 | ,@(when speeds `(:speed ,speed))))))) 74 | ;; ----------------------------- 75 | 76 | ;; Create Problem macro 77 | ;; ---------------------------- 78 | 79 | (defmacro define-problem (name fleet-size &key node-coords-list demands capacities time-windows-list durations speeds (to-depot T) plot-filename log-filename dist-matrix log-mode plotp) 80 | "Creates the appropriate object from the inputs. Extra key attributes only accept lists that are of equal length to node-coords-list or fleet-size (depending on what attributes it sets). For demands, durations, capacities and speeds, will also accept a single value, which will set all attributes to this value. 81 | 82 | A(n asymmetric) dist-matrix may be passed, instead of node-coords, in which case plotting will be disabled. dist-matrix must be a list of lists or 2-dimensional array. 83 | 84 | With only the demands-list and capacities, creates a CVRP problem. With time-windows, creates a VRPTW problem. When durations and speeds are not provided, defaults to 0 and 1. When plot-filename is not given, it will plot in \"plots/name.png\". When log-filename is not given, it will log by default in \"run-logs/name.txt\"." 85 | (with-gensyms (ln network fleet drawer) 86 | `(let ((,ln (same-lengthp ,demands ,node-coords-list ,time-windows-list ,durations 87 | ; (if (arrayp ,dist-matrix) 88 | ; (2d-array-to-list ,dist-matrix) 89 | ,dist-matrix))) 90 | (unless ,ln (error 'not-equal-length :lists (list ,demands ,node-coords-list ,time-windows-list ,durations ,dist-matrix))) 91 | (let* ((,network (create-nodes ,@(when node-coords-list 92 | `(:node-coords ,node-coords-list)) 93 | ,@(when demands 94 | `(:demands 95 | (if (listp ,demands) 96 | ,demands 97 | (make-list ,ln 98 | :initial-element ,demands)))) 99 | ,@(when time-windows-list 100 | `(:time-windows ,time-windows-list)) 101 | ,@(when durations 102 | `(:durations 103 | (if (listp ,durations) 104 | ,durations 105 | (make-list ,ln 106 | :initial-element ,durations)))) 107 | ,@(when dist-matrix 108 | `(:dist-matrix ,dist-matrix)))) 109 | (,fleet (create-vehicles ,fleet-size (if (= 0 (length ,network)) 110 | (error 'empty-network) 111 | (aref ,network 0)) ,to-depot 112 | ,@(when capacities 113 | `(:capacities 114 | (if (listp ,capacities) 115 | ,capacities 116 | (make-list ,fleet-size 117 | :initial-element ,capacities)))) 118 | ,@(when speeds 119 | `(:speeds 120 | (if (listp ,speeds) 121 | ,speeds 122 | (make-list ,fleet-size 123 | :initial-element ,speeds)))))) 124 | ,@(when node-coords-list 125 | `((,drawer (make-drawer 126 | ,@(when plotp `(:plotp ,plotp)) 127 | :min-coord (get-min-coord ,node-coords-list) 128 | :max-coord (get-max-coord ,node-coords-list) 129 | :filename (if ,plot-filename ,plot-filename 130 | (merge-pathnames (concatenate 'string "plots/" (string ,name) ".png") 131 | (asdf:system-source-directory 'open-vrp)))))))) 132 | (format t "~&Processed ~A nodes succesfully for ~A" ,ln ,name) 133 | ,@(unless node-coords-list 134 | `((warn "No coords: Plotting function disabled."))) 135 | ,@(unless (or node-coords-list dist-matrix) 136 | `((warn "No dist-matrix: Must set dist-matrix with #'set-dist-matrix first!"))) 137 | (make-instance ,@(cond ((and time-windows-list capacities) '('cvrptw)) 138 | (time-windows-list '('vrptw)) 139 | ((and demands capacities) '('cvrp)) 140 | (t '('problem))) 141 | :name (string ,name) 142 | :fleet ,fleet 143 | :network ,network 144 | ; if dist-matrix is a list, convert it to an array 145 | ,@(if dist-matrix 146 | `(:dist-array 147 | (if (listp ,dist-matrix) 148 | (2d-list-to-array ,dist-matrix) 149 | ,dist-matrix)) 150 | (when node-coords-list ; can only generate dist-matrix with coords 151 | `(:dist-array (generate-dist-array ,node-coords-list)))) 152 | 153 | :to-depot ,to-depot 154 | ,@(when node-coords-list `(:drawer ,drawer)) 155 | ,@(when log-mode `(:log-mode ,log-mode)) 156 | :log-file (if ,log-filename ,log-filename 157 | (merge-pathnames (concatenate 'string "run-logs/" (string ,name) "/" (string ,name) ".txt") 158 | (asdf:system-source-directory 'open-vrp)))))))) 159 | 160 | 161 | 162 | -------------------------------------------------------------------------------- /lib/list.lisp: -------------------------------------------------------------------------------- 1 | ;;; Simple Util for list manipulation. Basic tools used by route.lisp mostly. 2 | 3 | (in-package :open-vrp.util) 4 | 5 | ;; Simple list utils 6 | ;; -------------------- 7 | (defun get-from-list (list pred &key key) 8 | "Gets from list the value (max or min) while ignoring NIL's. Returns NIL if the whole list is nil. Use get-min or get-max!" 9 | (let ((in-list (if key (mapcar key list) list))) 10 | (labels ((iter (ls ans) 11 | (if (null ls) (if ans ans (error 'list-of-nils :ls list :key key)) 12 | (iter (cdr ls) 13 | (let ((x (car ls))) 14 | (cond ((null ans) x) 15 | ((null x) ans) 16 | ((funcall pred x ans) x) 17 | (t ans))))))) 18 | (iter (cdr in-list) (car in-list))))) 19 | 20 | (defun get-min (list &key key) 21 | "Gets the minimum value from a list, while ignoring the NIL values." 22 | (get-from-list list #'< :key key)) 23 | 24 | (defun get-max (list &key key) 25 | "Gets the maximum value from a list, while ignoring the NIL values." 26 | (get-from-list list #'> :key key)) 27 | 28 | (defun get-index-of (list fn &key key) 29 | "Helper function of the below. Use get-min-index or get-max-index!" 30 | (aif (funcall fn list :key key) 31 | (values (position it list :key key) it) 32 | nil)) 33 | 34 | (defun get-min-index (list &key key) 35 | "Returns index of the smallest value on list, while ignoring NIL. Returns index and its value (closest node and value)." 36 | (get-index-of list #'get-min :key key)) 37 | 38 | (defun get-max-index (list &key key) 39 | "Returns index of the largest value on list, while ignoring NIL. Returns index and its value (closest node and value)." 40 | (get-index-of list #'get-max :key key)) 41 | 42 | (defun sort-ignore-nil (list predicate &key key) 43 | "Sorts the sequence with #'< or #'> while passing all NIL values towards the end of result." 44 | (if (find-if-not #'null list :key key) 45 | (let ((ignore (cond ((eq predicate #'<) (1+ (get-max list :key key))) 46 | ((eq predicate #'>) (1- (get-min list :key key))) 47 | (t (error 'unaccepted-predicate :pred predicate))))) 48 | (sort (copy-list list) predicate 49 | :key #'(lambda (x) (or (if key (funcall key x) x) 50 | ignore)))) 51 | list)) 52 | 53 | ;; -------------------------- 54 | 55 | ;; Single route 56 | ;; ------------------------- 57 | 58 | (defun insert-before (object index list) 59 | "Insert object before index of list. 0 implies inserting in front, length of list implies appending at the end. Throws index out of bounds when index is larger." 60 | (unless (<= 0 index (length list)) 61 | (error 'index-out-of-bounds :index index :ls list)) 62 | (labels ((iter (obj i ls) 63 | (if (= 0 i) 64 | (cons obj ls) 65 | (cons (car ls) 66 | (insert-before obj 67 | (1- i) 68 | (cdr ls)))))) 69 | (iter object index list))) 70 | 71 | (defun insert-at-end (object list) 72 | "Appends the object at the end of the list" 73 | (insert-before object (length list) list)) 74 | 75 | (defun remove-index (index list) 76 | "Given a list, remove the object on index. Does not accept index out of bounds. Returns the new list AND the object that was removed." 77 | (unless (< -1 index (length list)) 78 | (error 'index-out-of-bounds :index index :ls list)) 79 | (let ((item)) 80 | (labels ((iter (n lst) 81 | (if (= 0 n) (progn (setf item (car lst)) 82 | (cdr lst)) 83 | (cons (car lst) 84 | (iter (1- n) 85 | (cdr lst)))))) 86 | (values (iter index list) item)))) 87 | 88 | (defun mark-nill (list indices) 89 | "Marks the indices on list with NIL. DESTRUCTIVE." 90 | (mapcar #'(lambda (x) (setf (nth x list) nil)) indices) 91 | list) 92 | 93 | (defmacro with-tabu-indices (tabu-indices fn arg-list) 94 | `(funcall ,fn (mark-nill (copy-list ,arg-list) ,tabu-indices))) 95 | 96 | (defun enumerate-interval (n) 97 | "Returns a list from 1 to n." 98 | (map1-n #'(lambda (x) x) n)) 99 | 100 | (defun random-list-permutation (length) 101 | "Randomly creates a permutation from 1 to length." 102 | (shuffle (enumerate-interval length))) 103 | -------------------------------------------------------------------------------- /lib/network.lisp: -------------------------------------------------------------------------------- 1 | ;;; Utilities for generating a distance table using a list of node coords. 2 | ;;; ----------------------------------------- 3 | ;;; - distance (int int array) - Expects two node-IDs and a dist-array 4 | ;;; - node-distance ( ) - Calculates distance between two objects 5 | ;;; - node ( int) - Returns given a and a node-id 6 | ;;; - generate-dist-array (coord-list) - Returns array of distances 7 | ;;; - new-node - Macro that creates a according to input 8 | (in-package :open-vrp.util) 9 | ;(proclaim '(optimize (speed 3))) 10 | 11 | (defun distance (i j dist-array) 12 | "Read from the distance-table with two indices." 13 | (when (= i j) (error 'same-origin-destination :from i :to j)) 14 | (aref dist-array i j)) 15 | 16 | (defun distance-coords (x1 y1 x2 y2) 17 | "Calculates pythagoras distance" 18 | (flet ((square (x) 19 | (* x x))) 20 | (sqrt (+ (square (- x1 x2)) (square (- y1 y2)))))) 21 | 22 | (defun distance-coord-pair (n1 n2) 23 | "Calculates distance given two coord pairs. Returns NIL if both coords are the same." 24 | (if (eql n1 n2) 25 | NIL 26 | (distance-coords (car n1) (cdr n1) 27 | (car n2) (cdr n2)))) 28 | 29 | (defun node-distance (n1 n2) 30 | "Given two node objects, calculate and return their distance (Cartesian)." 31 | (when (= (node-id n1) (node-id n2)) (error 'same-origin-destination :from n1 :to n2)) 32 | (distance-coords (node-xcor n1) (node-ycor n1) (node-xcor n2) (node-ycor n2))) 33 | 34 | (defun get-array-row (array row-index) 35 | "Given a 2-dimenstional array and a row-index, return the row as a list" 36 | (loop for row to (1- (array-dimension array 0)) 37 | collect (aref array row-index row))) 38 | 39 | (defun generate-dist-array (coord-list) 40 | "Given a list of coord pairs, generate an array of distances." 41 | (let* ((size (length coord-list)) 42 | (dist-array (eval `(make-array '(,size ,size) :initial-element nil)))) 43 | (map0-n #'(lambda (x) 44 | (map0-n #'(lambda (y) 45 | (setf (aref dist-array x y) 46 | (distance-coord-pair (nth x coord-list) 47 | (nth y coord-list)))) 48 | (1- size))) 49 | (1- size)) 50 | dist-array)) 51 | 52 | (defun 2d-list-to-array (matrix) 53 | "Given a list of lists, return a 2-dimensional array." 54 | (make-array (list (length matrix) (length (car matrix))) 55 | :initial-contents matrix)) 56 | 57 | (defun 2d-array-to-list (array) 58 | "Given a 2-dimensional array, return a list of lists." 59 | (loop for i below (array-dimension array 0) 60 | collect (loop for j below (array-dimension array 1) 61 | collect (aref array i j)))) 62 | 63 | ;; ---------------------------------------- 64 | 65 | ;; Accessor functions 66 | ;;-------------------------- 67 | 68 | (defmethod node ((prob problem) id) 69 | (aref (problem-network prob) id)) 70 | 71 | ;; -------------------------------- 72 | 73 | ;; Create Node macro 74 | ;; ------------------ 75 | (defmacro new-node (id xcor ycor &key demand start end duration) 76 | `(make-node :id ,id :xcor ,xcor :ycor ,ycor 77 | ,@(when demand `(:demand ,demand)) 78 | ,@(when start `(:start ,start)) 79 | ,@(when end `(:end ,end)) 80 | ,@(when duration `(:duration ,duration)))) -------------------------------------------------------------------------------- /lib/output.lisp: -------------------------------------------------------------------------------- 1 | ;;; Output functions 2 | ;;; -------------------------- 3 | (in-package :open-vrp.util) 4 | 5 | (defgeneric print-routes (prob/algo &optional stream) 6 | (:documentation "Prints solution given a / object. Also prints the total distance when the input is a / object.")) 7 | 8 | (defmethod print-routes ((prob problem) &optional (stream t)) 9 | (format stream "~&---------------") 10 | (format stream "~&Fitness: ~A" (fitness prob)) 11 | (format stream "~&---------------") 12 | (dolist (busy-veh (get-busy-vehicles prob)) 13 | (format stream "~&[~2D]: ~A~%" (vehicle-ID busy-veh) (route-indices busy-veh))) 14 | (format stream "~&---------------~%")) 15 | 16 | (defmethod print-routes ((a algo) &optional (stream t)) 17 | (print-routes (algo-best-sol a) stream)) 18 | 19 | (defun get-multi-run-stats (algo-objects) 20 | "Given a list of algo-objects, as returned by multi-run, return the stats with (values min max avg std runs time time/run)" 21 | (let ((results (mapcar #'algo-best-fitness algo-objects)) 22 | (run-time (- *multi-run-finish-time* *multi-run-start-time*))) 23 | (values 24 | (get-min results) 25 | (get-max results) 26 | (mean results) 27 | (standard-deviation results) 28 | (length results) 29 | run-time 30 | (/ run-time (length results))))) 31 | 32 | 33 | (defun print-multi-run-stats (algo-objects &optional (str t)) 34 | "Given a list of algo-objects returned by multi-run, print run-stats." 35 | (multiple-value-bind (min max avg std runs time time-p-run) 36 | (get-multi-run-stats algo-objects) 37 | (format str "~&Min: ~8a~%Max: ~8a~%Avg: ~8a~%Std: ~8a~%Runs: ~a~%Time: ~a seconds~%Time/run: ~a seconds~%" 38 | min max avg std runs time time-p-run))) 39 | 40 | 41 | (defun print-final-results (prob algo &optional (stream t)) 42 | "Prints final results of run, helper function to :after methods of run-algo and solve-prob." 43 | (format stream "~&Run took a total of ~A seconds.~%" (- *finish-time* *start-time*)) 44 | (format stream "Final solution of run with ~A on ~A was found on iteration ~A~%" 45 | (string (type-of algo)) (problem-name prob) (algo-best-iteration algo)) 46 | (print-routes algo stream)) 47 | 48 | 49 | ;; --------------------------- 50 | 51 | ;; Object printing methods 52 | ;; --------------------------- 53 | 54 | (defun print-vrp-object (object &optional (stream t)) 55 | "Given object, will print it's object's slots and values" 56 | (format stream "~&--------------") 57 | (format stream "~A object details:" (class-of object)) 58 | (format stream "--------------~%~%") 59 | (dolist (slot (class-slots (class-of object))) 60 | (let ((slot-name (slot-definition-name slot))) 61 | (when (and 62 | (slot-boundp object (slot-definition-name slot)) 63 | (not (or 64 | (equal slot-name (intern "NETWORK" (find-package 'open-vrp.classes))) 65 | (equal slot-name (intern "DIST-ARRAY" (find-package 'open-vrp.classes))) 66 | (equal slot-name (intern "FLEET" (find-package 'open-vrp.classes)))))) 67 | (format stream "~&Slot: ~18a Value: ~a~%" slot-name (slot-value object slot-name))))) 68 | (format stream "------------------------------------~%~%")) 69 | 70 | ;; ------------------------- 71 | 72 | ;; Timestamp printing 73 | ;; ------------------------- 74 | (defun print-timestamp (&optional (stream t)) 75 | "Prints timestamp to stream, source from cl-cookbook." 76 | (let ((days '("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"))) 77 | (multiple-value-bind (second minute hour date month year day-of-week dst-p tz) 78 | (get-decoded-time) 79 | (declare (ignore dst-p)) 80 | (format stream "~&It is now ~2,'0d:~2,'0d:~2,'0d of ~a, ~2,'0d/~2,'0d/~d (GMT~@d)" 81 | hour minute second (nth day-of-week days) month date year (- tz))))) 82 | 83 | (defun universal-time-to-string (&optional (time (get-universal-time))) 84 | "Returns yymmdd-hhmmss in a string. Used for timestamped log-files." 85 | (multiple-value-bind (second minute hour date month year) 86 | (decode-universal-time time) 87 | (with-output-to-string (s) 88 | (format s "~2,'0d~2,'0d~2,'0d-~2,'0d~2,'0d~2,'0d" 89 | year month date hour minute second)))) 90 | 91 | ;; ------------------------- 92 | 93 | ;; Log header printing 94 | ;; ------------------------- 95 | 96 | (defun print-header (prob algo &optional (stream t)) 97 | "Given a and object, print out a short description for the objects, and a line that logs the time of start of solving" 98 | (print-timestamp stream) 99 | (format stream "~&Commencing run with ~A on ~A~%~%" (algo-name algo) (problem-name prob)) 100 | (print-vrp-object prob stream) 101 | (print-vrp-object algo stream)) 102 | 103 | 104 | ;; ------------------------- 105 | 106 | ;; with-log-file macro 107 | ;; ------------------------- 108 | 109 | (defun insert-time-stamp-in-path (path time) 110 | "Given path, return the string of the path with the timestamp inserted before the .xxx" 111 | (let* ((string (namestring path)) 112 | (cutoff (- (length string) 4))) 113 | (concatenate 'string 114 | (subseq string 0 cutoff) 115 | "_" 116 | (universal-time-to-string time) 117 | (subseq string cutoff)))) 118 | 119 | (defmacro with-log-or-print ((stream prob time &optional (appendp T)) &body body) 120 | "A wrapper on top of with-open-file, where we use the filepath stored in the :log-file slot of a problem object. When :log-mode is 0, return nil. If 1, use the file stream; if 2, use the T stream. Optional parameter appendp can be set to NIL in order to :supersede if file exists. By default appends. Returns T if logging is succesful. Requires universal-time, to append to log-file." 121 | (with-gensyms (func) 122 | `(flet ((,func (,stream) 123 | ,@body)) 124 | (ccase (problem-log-mode ,prob) 125 | (0 nil) 126 | (1 (with-open-file (,stream (ensure-directories-exist 127 | (insert-time-stamp-in-path (problem-log-file ,prob) ,time)) 128 | :direction :output 129 | :if-exists (if ,appendp :append :supersede)) 130 | (,func ,stream)) t) 131 | (2 (,func t) t))))) 132 | 133 | ;; -------------------------- 134 | 135 | ;; Batch-run append one-liner 136 | ;; -------------------------- 137 | (defun print-batch-run-table-header (stream) 138 | (format stream "~&| Test-case | Min | Max | Avg | Std | Runs | Time | Time/Run |~%")) 139 | 140 | (defun append-run-result (filepath results) 141 | "Given the output filepath (with table headers initialized) and a list of algo-objects (as returned by multi-run), append one line that summarizes the run (by calling get-multi-run-stats)." 142 | (with-open-file (stream filepath :if-exists :append :direction :output) 143 | (multiple-value-bind (min max avg std runs time time-p-run) 144 | (get-multi-run-stats results) 145 | (format stream "~&|~11a|~9,2f|~9,2f|~9,2f|~9,2f|~6d|~6d|~10,2f|~%" 146 | (problem-name (algo-current-sol (car results))) 147 | min max avg std runs time time-p-run)))) 148 | 149 | 150 | 151 | ;; Acccessors for log-mode 152 | (defgeneric log-to-replp (prob/algo) 153 | (:documentation "Returns T if :log-mode is set to 2, which is REPL.")) 154 | 155 | (defmethod log-to-replp ((p problem)) 156 | (= (problem-log-mode p) 2)) 157 | 158 | (defmethod log-to-replp ((a algo)) 159 | (= (problem-log-mode (algo-current-sol a)) 2)) 160 | -------------------------------------------------------------------------------- /lib/read-cvrp.lisp: -------------------------------------------------------------------------------- 1 | (in-package :open-vrp.util) 2 | 3 | (defun %read-string (stream fn) 4 | (let ((current-char (read-char stream nil nil)) 5 | (result (make-array 0 6 | :element-type 'character 7 | :fill-pointer 0 8 | :adjustable t))) 9 | (while (funcall fn current-char) 10 | (vector-push-extend current-char result) 11 | (setq current-char (read-char stream))) 12 | (unread-char current-char stream) 13 | result)) 14 | 15 | (defun read-string-while-member (stream lst) 16 | (%read-string stream (lambda (char) (member char lst)))) 17 | 18 | (defun read-string-while-not-member (stream lst) 19 | (%read-string stream (lambda (char) (not (member char lst))))) 20 | 21 | (defun load-tsplib-vrp-file (file) 22 | "Load a subset of the VRP in the TSPLIB. Do not support time windows. 23 | ################### 24 | NAME: xxxx 25 | ... 26 | DIMENSION: xxx 27 | ... 28 | EDGE_WEIGHT_FORMAT: FUNCTION 29 | ... 30 | EDGE_WEIGHT_TYPE: EXACT_2D 31 | CAPACITY: xxx 32 | ... 33 | NODE_COORD_SECTION 34 | .... 35 | DEPOT_SECTION 36 | 1 37 | -1 38 | EOF 39 | #################### 40 | EDGE_WEIGHT_FORMAT and EDGE_WEIGHT_TYPE are optional" 41 | (with-open-file (stream file) 42 | (let (keyword 43 | name 44 | (capacity 0) 45 | (customers 0) 46 | (edge-weight-format (intern "FUNCTION")) 47 | (edge-weight-type (intern "EXACT_2D")) 48 | x-coords 49 | y-coords 50 | demands) 51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | ;; specification section ;; 53 | ;;;;;;;;;;;;;;;;;;;;;;;;;;; 54 | (tagbody 55 | :top 56 | (setq keyword (read-string-while-not-member stream '(#\: #\Space #\Tab #\Return #\Linefeed))) 57 | (when (string-equal keyword "NODE_COORD_SECTION") (go :down)) 58 | (read-string-while-member stream '(#\Space #\: #\Tab)) 59 | (cond 60 | ((string-equal keyword "NAME") (setf name (string (read stream)))) 61 | ((string-equal keyword "DIMENSION") (setf customers (read stream))) 62 | ((string-equal keyword "CAPACITY") (setf capacity (read stream))) 63 | (t (read stream nil nil))) 64 | (read-char stream nil nil) 65 | (go :top) 66 | :down) 67 | 68 | (when (not (eq (intern "FUNCTION") edge-weight-format)) 69 | (error "EDGE_WEIGHT_FORMAT must be FUNCTION")) 70 | (when (not (eq (intern "EXACT_2D") edge-weight-type)) 71 | (error "EDGE_WEIGHT_TYPE must be EXACT_2D")) 72 | 73 | ;;;;;;;;;;;;;;;;;; 74 | ;; data section ;; 75 | ;;;;;;;;;;;;;;;;;; 76 | (loop 77 | while (not (eq (intern "DEMAND_SECTION") (read stream))) 78 | collect (read stream) into x 79 | collect (read stream) into y 80 | finally (setf x-coords x y-coords y)) 81 | (when (/= (length x-coords) customers) 82 | (error "The number of customers is incorrect")) 83 | (loop 84 | while (not (eq (intern "DEPOT_SECTION") (read stream))) 85 | collect (read stream) into d 86 | finally (setf demands d)) 87 | (when (/= (length demands) customers) 88 | (error "The demand size is incorrect")) 89 | 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | ;; check depot section and eof keyword ;; 92 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 93 | (when (/= 1 (read stream)) 94 | (error "The number of depots must be 1")) 95 | (when (/= -1 (read stream)) 96 | (error "DEPOT_SECTION must be terminated by a -1")) 97 | (when (not (eq (intern "EOF") (read stream))) 98 | (error "The file must be terminated by EOF")) 99 | 100 | (define-problem name 25 101 | :node-coords-list (couple-lists x-coords y-coords) 102 | :demands demands 103 | :capacities capacity)))) 104 | 105 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /lib/read-solomon.lisp: -------------------------------------------------------------------------------- 1 | ;;; Interface to read in testcases from files 2 | ;;; (Solomon style: http://neo.lcc.uma.es/radi-aeb/WebVRP/index.html?/Problem_Instances/CVRPTWInstances.html) 3 | ;;; --- 4 | (in-package :open-vrp.util) 5 | 6 | (defun couple-lists (list1 list2) 7 | "Given a list of x and y-coords, return a list of pairs usable. Used for node-coords or time-windows." 8 | (loop for x in list1 and y in list2 collect (cons x y))) 9 | 10 | (defun load-solomon-vrp-file (file) 11 | "Load testcase from file, which should be Solomon style." 12 | (with-open-file (in file) 13 | (let ((name (read in)) 14 | (fleet-size (progn (dotimes (n 3) (read in)) (read in))) 15 | (capacities (read in))) 16 | (dotimes (n 12) (read in)) 17 | (loop 18 | while (read in nil) 19 | collect (read in) into x-coords 20 | collect (read in) into y-coords 21 | collect (read in) into demands 22 | collect (read in) into min-times 23 | collect (read in) into max-times 24 | collect (read in) into service-duration 25 | finally 26 | (return 27 | (define-problem name fleet-size 28 | :node-coords-list (couple-lists x-coords y-coords) 29 | :demands demands 30 | :capacities (make-list fleet-size :initial-element capacities) 31 | :time-windows-list (couple-lists min-times max-times) 32 | :durations service-duration)))))) -------------------------------------------------------------------------------- /lib/read-test-case.lisp: -------------------------------------------------------------------------------- 1 | ;;; General test-case reader 2 | ;;; Defining clues, will recognize file format and dispatch to the right reader 3 | ;;; ------------------------- 4 | (in-package :open-vrp.util) 5 | 6 | (defun load-test-case-file (filepath) 7 | "Given a file, will recognize the format based on some cues and dispatch to appropriate reader function to parse the file. File with .vrp extension will be read as TSPLIB." 8 | (with-open-file (in filepath) 9 | (let ((extension (pathname-type filepath))) 10 | (if (string-equal extension "vrp") 11 | (load-tsplib-vrp-file filepath) 12 | (let ((first-word (read in)) 13 | (second-word (read in))) 14 | (declare (ignore first-word)) 15 | (cond ((eq second-word (intern "VEHICLE")) 16 | (load-solomon-vrp-file filepath)) 17 | (t (error 'file-not-recognized :file filepath)))))))) -------------------------------------------------------------------------------- /lib/route.lisp: -------------------------------------------------------------------------------- 1 | ;;; Functions to operate on routes, which are a list of objects 2 | ;;; contained in a 's :route slot. 3 | (in-package :open-vrp.util) 4 | ;;; ------- 5 | ;;; 0. Route utils 6 | ;;; 1. Insert node into the route 7 | ;;; 2. Remove node from the route 8 | ;;; 3. Last location 9 | ;;; -------------------- 10 | 11 | ;; 0. Route utils 12 | ;; --------------------- 13 | (defun empty-routep (route) 14 | "Given a route, return T if the route only has base-nodes." 15 | (not (member 0 route :key #'node-id :test-not #'=))) 16 | 17 | (defun get-busy-vehicles (problem) 18 | "Returns a list of that are not empty, given a object." 19 | (remove-if #'empty-routep (problem-fleet problem) :key #'vehicle-route)) 20 | 21 | (defun one-destinationp (route) 22 | "Return T if there is only one destination on route, excluding base nodes." 23 | (= 1 (length (remove 0 route :key #'node-id)))) 24 | 25 | (defmacro change-route (vehicle &body body) 26 | "Expands into binding the vehicles route to r and setting it to result of body." 27 | `(let ((r (vehicle-route ,vehicle))) 28 | (setf (vehicle-route ,vehicle) ,@body))) 29 | ;; ------------------ 30 | 31 | ;; 1. Insert Node 32 | ;; ------------------- 33 | 34 | (defun insert-node (veh node index) 35 | "Adds the object before the index of the route of . An index of 0 implies inserting in front, length of list implies at the end." 36 | (change-route veh 37 | (insert-before node index r))) 38 | 39 | (defun append-node (veh node) 40 | "Appends to the end of the route of . Wrapper of insert-node. If the route includes returning to-depot, then append before the last return to depot." 41 | (change-route veh 42 | (if (and (cdr (vehicle-route veh)) 43 | (= 0 (node-id (car (last (vehicle-route veh)))))) 44 | (reverse (insert-before node 1 (reverse r))) 45 | (insert-at-end node r)))) 46 | 47 | ;; ------------------------- 48 | 49 | ;; 2. Remove Node 50 | ;; ------------------------- 51 | (defun remove-node-at (veh index) 52 | "Removes the from the route of at index" 53 | (change-route veh 54 | (remove-index index r))) 55 | 56 | (defgeneric remove-node-ID (veh/prob node-ID) 57 | (:method (vehicle node-ID) "Expects / and int as inputs!") 58 | (:documentation "Removes the with node-ID from the route of . Returns NIL if failed to find node-ID.")) 59 | 60 | (defmethod remove-node-ID ((v vehicle) node-ID) 61 | (if (member node-ID (vehicle-route v) :key #'node-id) 62 | (change-route v 63 | (remove node-ID r :key #'node-id :count 1)) ;count 1 for perform-move in TS.lisp. 64 | nil)) 65 | 66 | (defmethod remove-node-ID ((prob problem) node-ID) 67 | (aif (vehicle-with-node-ID prob node-ID) 68 | (remove-node-ID (vehicle prob it) node-ID) 69 | nil)) 70 | ;; ---------------------------- 71 | 72 | ;; 3. Last location 73 | ;; ---------------------------- 74 | (defgeneric last-node (vehicle) 75 | (:method (vehicle) "Expects ") 76 | (:documentation "Returns the last in its route. Depicts the current location (before returning to base).")) 77 | 78 | (defmethod last-node (route) 79 | (let ((r (reverse route))) 80 | (if (= 0 (node-id (car r))) 81 | (or (cadr r) (car r)) ;in case route has only one base-node. 82 | (car r)))) 83 | 84 | (defmethod last-node ((v vehicle)) 85 | (last-node (vehicle-route v))) 86 | 87 | ;; --------------------------- 88 | 89 | 90 | -------------------------------------------------------------------------------- /lib/simple-utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :open-vrp.util) 2 | 3 | ;; Simple utils from Paul Graham's Onlisp 4 | ;; ------------------------------- 5 | 6 | (defun single (lst) 7 | (and (consp lst) (not (cdr lst)))) 8 | 9 | (defun map0-n (fn n) 10 | "maps from 0 to n" 11 | (loop for x from 0 to n 12 | collect (funcall fn x))) 13 | 14 | (defun map1-n (fn n) 15 | "maps from 1 to n" 16 | (loop for x from 1 to n 17 | collect (funcall fn x))) 18 | 19 | (defmacro mac (expr) 20 | `(pprint (macroexpand-1 ',expr))) 21 | 22 | (defmacro while (test &body body) 23 | `(do () 24 | ((not ,test)) 25 | ,@body)) 26 | 27 | (defmacro aif (test-form then-form &optional else-form) 28 | `(let ((it ,test-form)) 29 | (if it ,then-form ,else-form))) 30 | 31 | (defmacro awhile (expr &body body) 32 | `(do ((it ,expr ,expr)) 33 | ((not it)) 34 | ,@body)) 35 | 36 | ;; ---------------------------------------------------------- 37 | (defun sum (list) 38 | "A quick list summer, 4 times as fast as (reduce #'+ list)" 39 | (labels ((helper (todo ans) 40 | (if (null todo) ans 41 | (helper (cdr todo) 42 | (+ ans (car todo)))))) 43 | (helper list 0))) 44 | 45 | (defun max-car (list) 46 | "Provided a list, return the maximum value considering the cars" 47 | (reduce #'max list :key #'car)) 48 | 49 | (defun max-cdr (list) 50 | "Provided a list, return the maximum value considering the cdrs" 51 | (reduce #'max list :key #'cdr)) 52 | 53 | ;; Tue Nov 29, 2011 54 | ;; quick ugly tsp cloner - DUPLICATES NODES! Network nodes != Vehicle route !!! 55 | ;; copies every slot, but if slot contains an object that may contain more objects, recursively copy-object it. If it is a list, then mapcar copy-object it, since this list may contain objects (e.g. objects in a 's route slot. Very non-generic function, might run into trouble when extending. Needs fix? 56 | 57 | (defun vrp-object (object) 58 | "Tests if the object is an instance of a VRP object that needs deep copy. (problem, fleet, vehicle)" 59 | (member (type-of object) '(problem fleet vehicle))) 60 | 61 | (defun copy-object (object) 62 | "A deep-cloner for CLOS." 63 | (let* ((i-class (class-of object)) 64 | (clone (allocate-instance i-class))) 65 | (dolist (slot (class-slots i-class)) 66 | (let ((slot-name (slot-definition-name slot))) 67 | (when (slot-boundp object slot-name) 68 | (let ((value (slot-value object slot-name))) 69 | (setf (slot-value clone slot-name) 70 | (cond ((eq (type-of value) 'network) 71 | value) 72 | ((vrp-object value) 73 | (copy-object (slot-value object slot-name))) 74 | ((listp value) 75 | (mapcar #'copy-object value)) 76 | (t value))))))) 77 | clone)) 78 | -------------------------------------------------------------------------------- /lib/solver.lisp: -------------------------------------------------------------------------------- 1 | ;;; High-level methods to start solving 2 | ;;; -------------------------- 3 | ;;; - run-algo ( ) - DESTRUCTIVE 4 | ;;; - solve-prob ( ) - UNDESTRUCTIVE 5 | ;;; - solve-plot ( ) - plots the best solution after solving 6 | ;;; - multi-run (int algo-call) - Run algo int times - collect all results 7 | ;;; - get-best-solution-from-multi-run - returns the best solution from collection 8 | ;;; - multi-run-algo - Calls multi-run, prints stats and returns best 9 | ;;; - iterate () - run one iteration on 10 | ;;; - iterate-more ( int) - reset number of iterations and call run-algo 11 | ;;; ---------------------------- 12 | (in-package :open-vrp.util) 13 | 14 | ;; Run Algo 15 | ;; ------------------------- 16 | (defun init-algo (sol algo) 17 | "Given a solution, sets the :current-sol, :best-fitness and :best-sol slots of the object. Returns ." 18 | (setf (algo-current-sol algo) sol 19 | (algo-best-fitness algo) (fitness sol) 20 | (algo-best-sol algo) (copy-object sol)) 21 | algo) 22 | 23 | 24 | (defgeneric run-algo (problem algo) 25 | (:method (problem algo) 26 | "run-algo: Either problem or algo is not defined/correct") 27 | (:documentation "Runs the algo on the problem. Destructive - will have side-effects on the and objects. Use solve-prob to prevent object being touched. Will return the object, which will contain the solution (in the form of a copy of the object) in the :best-sol slot. When defining your own algorithms, make sure to implement a run-algo method for your algo, which sets the slots appropriately, and returns the object. For algorithms that just build a solution (like greedy-best-insertion or greedy-append), you can use init-algo to set :current-sol, :best-sol, :best-fitness simultaneously. For search algorithms -- such as local search, population based algorithms -- may make use of the iterate method to automatically set the slots after each iteration.")) 28 | 29 | ;; In case of error or interrupt, bind current state of algo in *algo-backup*. 30 | (defmethod run-algo :around ((p problem) (a algo)) 31 | (unwind-protect 32 | (call-next-method) 33 | (defparameter *algo-backup* a))) 34 | 35 | ;; After method that makes all algos print the final solution 36 | (defmethod run-algo :after ((p problem) (a algo)) 37 | (setq *finish-time* (get-universal-time)) 38 | (with-log-or-print (str p *start-time*) 39 | (print-final-results p a str))) 40 | ;; ----------------------------- 41 | 42 | ;; Solve Prob 43 | ;; --------------------------------- 44 | (defparameter *start-time* nil) 45 | (defparameter *finish-time* nil) 46 | 47 | ;; a wrapper method to prevent destructive behaviour of CLOS. 48 | (defgeneric solve-prob (problem algo) 49 | (:method (problem algo) 50 | "solve-prob: Either problem or algo is not defined/correct") 51 | (:documentation "Solves the problem with the algo. Uses run-algo, but leaves the object untouched ( will suffer side-effects). Works with a clone (copy-object in lib/simple-utils.lisp). NON-destructive wrapper to the run-algo method.")) 52 | 53 | (defmethod solve-prob ((problem problem) (algo algo)) 54 | (let ((clone (copy-object problem))) 55 | (run-algo clone algo))) 56 | 57 | ;; Before method to supersede log-file and print log file heading 58 | ;; This method is not part of the run-algo :before, because that would cause iterate-more 59 | ;; which calls run-algo to supersede instead of append to file. 60 | (defmethod solve-prob :before ((p problem) (a algo)) 61 | (setq *start-time* (get-universal-time)) 62 | (with-log-or-print (str p *start-time* nil) 63 | (print-header p a str))) 64 | 65 | ;; When all logging is done in file, at least print the final solution in repl 66 | (defmethod solve-prob :after ((p problem) (a algo)) 67 | (unless (log-to-replp p) 68 | (print-final-results p a)) 69 | (when (and (problem-drawer p) (drawer-plotp (problem-drawer p))) 70 | (plot-solution (algo-best-sol a)))) 71 | ;; --------------------------- 72 | 73 | ;; Multi-run 74 | ;; --------------------------- 75 | (defparameter *multi-run-start-time* nil) 76 | (defparameter *multi-run-finish-time* nil) 77 | 78 | (defmacro multi-run (times &body algo-call) 79 | "Run algo x times and collect all resulting solution objects in a list." 80 | `(progn 81 | ;so it won't override the first log-file made by solve-prob use -1 seconds 82 | (setq *multi-run-start-time* (- (get-universal-time) 1)) 83 | (loop for ,(gensym) below ,times collect ,@algo-call 84 | finally (setq *multi-run-finish-time* (get-universal-time))))) 85 | 86 | (defun get-best-solution-from-multi-run (solutions) 87 | "Given a list of solutions (from multi-run), return the best solution." 88 | (labels ((iter (sols best) 89 | (if sols 90 | (iter (cdr sols) 91 | (if (< (algo-best-fitness (car sols)) (algo-best-fitness best)) 92 | (car sols) 93 | best)) 94 | best))) 95 | (iter (cdr solutions) (car solutions)))) 96 | 97 | (defmacro multi-run-algo (times &body algo-call) 98 | "Run algo x times, print multi-run-stats and return the best result." 99 | (with-gensyms (prob results best) 100 | `(let* ((,prob ,(cadar algo-call)) 101 | (,results (multi-run ,times ,@algo-call)) 102 | (,best (get-best-solution-from-multi-run ,results))) 103 | (with-log-or-print (str ,prob *multi-run-start-time* nil) 104 | (print-multi-run-stats ,results str) 105 | (print-routes ,best str)) 106 | (unless (log-to-replp ,prob) 107 | (print-multi-run-stats ,results) 108 | (print-routes ,best)) 109 | ,best))) 110 | ;; ------------------- 111 | 112 | ;; Iterate 113 | ;; ------------------- 114 | (defgeneric iterate (algo) 115 | (:method (algo) "iterate: This algo is not defined.") 116 | (:documentation "Runs the algo one iteration. Implementation of this method should use the algo's slot current-sol as current solution and destructively adjust it to a new solution. When algo's slot iterations is 0, then print the best solution found by this algo object. Returns the object. After each iterate, will automatically check if a new best solution has been found and adjust the :best-sol and :best-fitness slots for you. When :animatep is set to T, will plot current solution in run-frames/")) 117 | 118 | (defmethod iterate :around ((a algo)) 119 | (if (< (algo-iterations a) 1) 120 | (progn (format t "No more iterations left.") a) 121 | (call-next-method))) 122 | 123 | (defmethod iterate :after ((a algo)) 124 | (let ((sol (algo-current-sol a))) 125 | ;; reduce iteration 126 | (setf (algo-iterations a) (1- (algo-iterations a))) 127 | 128 | ;; Logging 129 | (with-log-or-print (str sol *start-time*) 130 | (format str "~&Iterations to go: ~A~%" (algo-iterations a)) 131 | (print-routes sol str)) 132 | ;; Print dots in REPL if logging is to file 133 | (unless (log-to-replp a) 134 | (princ ".")) 135 | 136 | ;; Checking if new best solution 137 | (let ((new-fitness (fitness sol)) 138 | (best-fitness (algo-best-fitness a))) 139 | (when (or (null best-fitness) 140 | (< new-fitness best-fitness)) 141 | (setf (algo-best-fitness a) new-fitness 142 | (algo-best-sol a) (copy-object sol) 143 | (algo-best-iteration a) (algo-iterations a)))) 144 | 145 | ;; Plot frame if animatep is set to T 146 | (when (algo-animatep a) 147 | (plot-solution sol (merge-pathnames 148 | (with-output-to-string (s) 149 | (princ "run-frames/Iteration " s) 150 | (princ (algo-iterations a) s) 151 | (princ ".png" s)) 152 | (asdf:system-source-directory 'open-vrp)))))) 153 | 154 | ;; Resume run - add some more iterations 155 | ;; ------------------------ 156 | (defgeneric iterate-more (algo int) 157 | (:method (algo int) "iterate-more: expects and int as inputs") 158 | (:documentation "When an algo finished (i.e. iterations = 0) using iterate-more allows you to keep running it x more iterations. Also resets :best-iteration, which the stopping condition uses. Calls run-algo on the :current-sol of and with .")) 159 | 160 | (defmethod iterate-more ((a algo) int) 161 | (setf (algo-iterations a) int 162 | (algo-best-iteration a) int) 163 | (run-algo (algo-current-sol a) a)) 164 | 165 | (defmethod iterate-more :after ((a algo) int) 166 | (unless (log-to-replp a) 167 | (print-final-results (algo-best-sol a) a))) 168 | ;; --------------------- 169 | -------------------------------------------------------------------------------- /open-vrp-lib.asd: -------------------------------------------------------------------------------- 1 | (defsystem :open-vrp-lib 2 | :description "open-vrp-library" 3 | :version "0.6.3" 4 | :author "Marc Kuo" 5 | :licence "LLGPL" 6 | :depends-on (vecto alexandria fiveam cl-fad) 7 | :serial t 8 | :components ((:file "packages") 9 | (:module :lib 10 | :components 11 | ((:file "class-definitions") 12 | (:file "simple-utils") 13 | (:file "list") 14 | (:file "network") 15 | (:file "fleet") 16 | (:file "fitness") 17 | (:file "output") 18 | (:file "route") 19 | (:file "draw-solution") 20 | (:file "solver") 21 | (:file "constraints") 22 | (:file "conditions") 23 | (:file "init-macros") 24 | (:file "read-solomon") 25 | (:file "read-cvrp") 26 | (:file "config-functions") 27 | (:file "read-test-case") 28 | (:file "batch-run"))))) 29 | -------------------------------------------------------------------------------- /open-vrp.asd: -------------------------------------------------------------------------------- 1 | (defsystem :open-vrp 2 | :description "open-vrp" 3 | :version "0.6.3" 4 | :author "Marc Kuo" 5 | :licence "LLGPL" 6 | :depends-on (vecto alexandria fiveam open-vrp-lib) 7 | :serial t 8 | :components ((:module :algo 9 | :components 10 | ((:file "algo-conditions") 11 | (:file "tools") 12 | (:file "iterator") 13 | (:file "best-insertion") 14 | (:file "greedy-NN") 15 | (:file "greedy-append") 16 | (:file "greedy-best-insertion") 17 | (:file "TS-classdef") 18 | (:file "TS-utils") 19 | (:file "TS"))) 20 | (:module :test-cases 21 | :components 22 | ((:file "test-cases") 23 | (:file "test-suite"))))) 24 | -------------------------------------------------------------------------------- /packages.lisp: -------------------------------------------------------------------------------- 1 | ;;; CLOS package descriptions 2 | ;;; ----------------------------- 3 | 4 | (defpackage :open-vrp.classes 5 | (:use :common-lisp) 6 | (:export :node 7 | :vehicle 8 | :problem 9 | :VRP 10 | :CVRP 11 | :VRPTW 12 | :CVRPTW 13 | :drawer 14 | 15 | ;; algo 16 | :algo 17 | :name 18 | :desc 19 | :iterations 20 | 21 | ;; constructor functions 22 | :make-node 23 | :make-vehicle 24 | :make-drawer 25 | 26 | ;; accessor functions 27 | :node-id 28 | :node-xcor 29 | :node-ycor 30 | :node-demand 31 | :node-start 32 | :node-end 33 | :node-duration 34 | :vehicle-id 35 | :vehicle-route 36 | :vehicle-capacity 37 | :vehicle-speed 38 | :problem-name 39 | :problem-desc 40 | :problem-network 41 | :problem-dist-array 42 | :problem-fleet 43 | :problem-to-depot 44 | :problem-drawer 45 | :problem-log-file 46 | :problem-log-mode 47 | :algo-name 48 | :algo-desc 49 | :algo-best-sol 50 | :algo-best-fitness 51 | :algo-best-iteration 52 | :algo-current-sol 53 | :algo-iterations 54 | :algo-animatep 55 | :drawer-min-coord 56 | :drawer-max-coord 57 | :drawer-legendp 58 | :drawer-legend-x 59 | :drawer-legend-y 60 | :drawer-x-pos 61 | :drawer-y-pos 62 | :drawer-max-pix 63 | :drawer-filename 64 | :drawer-plotp)) 65 | 66 | (defpackage :open-vrp.util 67 | (:use :common-lisp 68 | :open-vrp.classes 69 | :vecto) 70 | (:import-from :alexandria :shuffle :flatten :with-gensyms :mean :standard-deviation) 71 | (:import-from :cl-fad :walk-directory) 72 | #+sbcl (:import-from :sb-mop :class-slots :slot-definition-name) 73 | #+(or allegro clisp lispworks) (:import-from :clos :class-slots :slot-definition-name) 74 | #+cmu (:import-from :mop :class-slots :slot-definition-name) 75 | (:export ;; simple utils 76 | :single 77 | :mac 78 | :mapa-b 79 | :map1-n 80 | :map0-n 81 | :while 82 | :aif 83 | :awhile 84 | :it 85 | :sum 86 | :max-car 87 | :max-cdr 88 | :copy-object 89 | 90 | ;; list utils 91 | :get-min 92 | :get-max 93 | :get-min-index 94 | :get-max-index 95 | :sort-ignore-nil 96 | :insert-before 97 | :insert-at-end 98 | :remove-index 99 | :apply-on-index 100 | :enumerate-interval 101 | :shuffle-pool 102 | :random-list-permutation 103 | :with-tabu-indices 104 | 105 | ;; route utils 106 | :empty-routep 107 | :get-busy-vehicles 108 | :one-destinationp 109 | :insert-node 110 | :append-node 111 | :remove-node-at 112 | :remove-node-ID 113 | :last-node 114 | 115 | ;; network utils 116 | :distance 117 | :node-distance 118 | :generate-dist-array 119 | :get-array-row 120 | :node 121 | :new-node 122 | 123 | ;; fleet utils 124 | :route-indices 125 | :vehicle-with-node-ID 126 | :node-on-routep 127 | :total-dist 128 | :vehicle 129 | :new-vehicle 130 | 131 | ;; constraint utils 132 | :constraints-check 133 | :constraintsp 134 | :in-capacityp 135 | :travel-time 136 | :time-after-serving-node 137 | :veh-in-timep 138 | :in-timep 139 | 140 | :fitness 141 | 142 | ;; solver 143 | :init-algo 144 | :run-algo 145 | :*algo-backup* 146 | :solve-prob 147 | :multi-run 148 | :get-best-solution-from-multi-run 149 | :multi-run-algo 150 | :iterate 151 | :iterate-more 152 | :*start-time* 153 | :*multi-run-start-time* 154 | :batch-run 155 | :print-run-results-table 156 | 157 | ;; output 158 | :print-routes 159 | :print-multi-run-stats 160 | :print-final-results 161 | :print-vrp-object 162 | :plot-solution 163 | :plot-nodes 164 | :print-timestamp 165 | :with-log-or-print 166 | :log-to-replp 167 | 168 | ;; conditions 169 | :same-origin-destination 170 | :list-of-nils 171 | 172 | ;; init macros 173 | :create-nodes 174 | :create-vehicles 175 | :define-problem 176 | 177 | ;; input 178 | :load-test-case-file 179 | :load-solomon-vrp-file 180 | :load-tsplib-vrp-file 181 | 182 | ;; config utils 183 | :toggle 184 | :toggle-legend 185 | :toggle-plot 186 | :toggle-animate 187 | :set-plot-file 188 | :set-log-mode 189 | :set-log-file 190 | :set-dist-array)) 191 | 192 | (defpackage :open-vrp.algo 193 | (:use :common-lisp 194 | :open-vrp.classes 195 | :open-vrp.util) 196 | (:import-from :alexandria :shuffle :flatten) 197 | (:export ;; tools 198 | :get-closest-vehicle 199 | :get-closest-feasible-vehicle 200 | :get-optimal-insertion 201 | :fitness-before-after 202 | :insertion-move 203 | :get-best-insertion-move 204 | :get-best-insertion-move-in-vehicle 205 | :get-closest-node 206 | :feasible-movep 207 | 208 | ;; iterator 209 | :initialize 210 | :generate-moves 211 | :perform-move 212 | :assess-move 213 | :assess-moves 214 | :sort-moves 215 | :select-move 216 | 217 | ;; move 218 | :move 219 | :move-node-ID 220 | :move-vehicle-ID 221 | :move-index 222 | :move-fitness 223 | :make-insertion-move 224 | :make-TS-best-insertion-move 225 | 226 | ;; algo-objects 227 | :greedy-NN 228 | :greedy-append 229 | :greedy-best-insertion 230 | :tabu-list 231 | :tabu-search 232 | 233 | ;; Tabu Search object 234 | :ts-move-type 235 | :ts-init-heur 236 | :ts-aspirationp 237 | :ts-elite-listp 238 | :ts-tabu-list 239 | :ts-tenure 240 | :ts-parameter-f 241 | :ts-candidate-list 242 | :ts-stopping-condition 243 | 244 | ;; Tabu Search utils 245 | :toggle-aspiration 246 | :toggle-elite-list 247 | :add-to-tabu 248 | :add-move-to-tabu 249 | :is-tabup 250 | :is-tabu-movep 251 | :TS-best-insertion-move 252 | :create-candidate-list)) 253 | 254 | (defpackage :open-vrp.test 255 | (:use :common-lisp 256 | :open-vrp.classes 257 | :open-vrp.util 258 | :open-vrp.algo 259 | :fiveam) 260 | (:export :run! 261 | :*node-coords* 262 | ;; demos 263 | :test-tsp 264 | :test-vrp 265 | :solomon25 266 | :solomon100 267 | :christofides-1 268 | :christofides-2)) 269 | 270 | (defpackage :open-vrp 271 | (:use :common-lisp 272 | :open-vrp.classes 273 | :open-vrp.util 274 | :open-vrp.algo 275 | :open-vrp.test) 276 | (:import-from :alexandria :shuffle :flatten :with-gensyms) 277 | (:export :define-problem 278 | :load-testcase-Solomon 279 | :load-tsplib-vrp-file 280 | :solve-prob 281 | :iterate-more 282 | :plot-solution 283 | :print-routes 284 | 285 | ;; algos 286 | :tabu-search 287 | :greedy-NN 288 | :greedy-append 289 | :greedy-best-insertion 290 | 291 | ;; demos 292 | :run! 293 | :test-tsp 294 | :test-vrp 295 | :solomon25 296 | :solomon100 297 | :christofides-1 298 | :christofides-2)) -------------------------------------------------------------------------------- /plots/.gitignore: -------------------------------------------------------------------------------- 1 | # For an empty directory, in which the .png files will be drawn 2 | # Ignore everything in this directory 3 | * 4 | # Except this file 5 | !.gitignore 6 | -------------------------------------------------------------------------------- /plots/solomon100-optimal.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mck-/Open-VRP/408cb67063474ab61ddfc1631b5ac39714f2535e/plots/solomon100-optimal.png -------------------------------------------------------------------------------- /plots/tsp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mck-/Open-VRP/408cb67063474ab61ddfc1631b5ac39714f2535e/plots/tsp.png -------------------------------------------------------------------------------- /run-frames/.gitignore: -------------------------------------------------------------------------------- 1 | # For an empty directory, in which the .png files will be drawn 2 | # Ignore everything in this directory 3 | * 4 | # Except this file 5 | !.gitignore 6 | -------------------------------------------------------------------------------- /run-logs/.gitignore: -------------------------------------------------------------------------------- 1 | # For an empty directory, in which the .png files will be drawn 2 | # Ignore everything in this directory 3 | * 4 | # Except this file 5 | !.gitignore 6 | -------------------------------------------------------------------------------- /test-cases/100-cust.txt: -------------------------------------------------------------------------------- 1 | C101 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 50 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 1236 0 11 | 1 45 68 10 912 967 90 12 | 2 45 70 30 825 870 90 13 | 3 42 66 10 65 146 90 14 | 4 42 68 10 727 782 90 15 | 5 42 65 10 15 67 90 16 | 6 40 69 20 621 702 90 17 | 7 40 66 20 170 225 90 18 | 8 38 68 20 255 324 90 19 | 9 38 70 10 534 605 90 20 | 10 35 66 10 357 410 90 21 | 11 35 69 10 448 505 90 22 | 12 25 85 20 652 721 90 23 | 13 22 75 30 30 92 90 24 | 14 22 85 10 567 620 90 25 | 15 20 80 40 384 429 90 26 | 16 20 85 40 475 528 90 27 | 17 18 75 20 99 148 90 28 | 18 15 75 20 179 254 90 29 | 19 15 80 10 278 345 90 30 | 20 30 50 10 10 73 90 31 | 21 30 52 20 914 965 90 32 | 22 28 52 20 812 883 90 33 | 23 28 55 10 732 777 90 34 | 24 25 50 10 65 144 90 35 | 25 25 52 40 169 224 90 36 | 26 25 55 10 622 701 90 37 | 27 23 52 10 261 316 90 38 | 28 23 55 20 546 593 90 39 | 29 20 50 10 358 405 90 40 | 30 20 55 10 449 504 90 41 | 31 10 35 20 200 237 90 42 | 32 10 40 30 31 100 90 43 | 33 8 40 40 87 158 90 44 | 34 8 45 20 751 816 90 45 | 35 5 35 10 283 344 90 46 | 36 5 45 10 665 716 90 47 | 37 2 40 20 383 434 90 48 | 38 0 40 30 479 522 90 49 | 39 0 45 20 567 624 90 50 | 40 35 30 10 264 321 90 51 | 41 35 32 10 166 235 90 52 | 42 33 32 20 68 149 90 53 | 43 33 35 10 16 80 90 54 | 44 32 30 10 359 412 90 55 | 45 30 30 10 541 600 90 56 | 46 30 32 30 448 509 90 57 | 47 30 35 10 1054 1127 90 58 | 48 28 30 10 632 693 90 59 | 49 28 35 10 1001 1066 90 60 | 50 26 32 10 815 880 90 61 | 51 25 30 10 725 786 90 62 | 52 25 35 10 912 969 90 63 | 53 44 5 20 286 347 90 64 | 54 42 10 40 186 257 90 65 | 55 42 15 10 95 158 90 66 | 56 40 5 30 385 436 90 67 | 57 40 15 40 35 87 90 68 | 58 38 5 30 471 534 90 69 | 59 38 15 10 651 740 90 70 | 60 35 5 20 562 629 90 71 | 61 50 30 10 531 610 90 72 | 62 50 35 20 262 317 90 73 | 63 50 40 50 171 218 90 74 | 64 48 30 10 632 693 90 75 | 65 48 40 10 76 129 90 76 | 66 47 35 10 826 875 90 77 | 67 47 40 10 12 77 90 78 | 68 45 30 10 734 777 90 79 | 69 45 35 10 916 969 90 80 | 70 95 30 30 387 456 90 81 | 71 95 35 20 293 360 90 82 | 72 53 30 10 450 505 90 83 | 73 92 30 10 478 551 90 84 | 74 53 35 50 353 412 90 85 | 75 45 65 20 997 1068 90 86 | 76 90 35 10 203 260 90 87 | 77 88 30 10 574 643 90 88 | 78 88 35 20 109 170 90 89 | 79 87 30 10 668 731 90 90 | 80 85 25 10 769 820 90 91 | 81 85 35 30 47 124 90 92 | 82 75 55 20 369 420 90 93 | 83 72 55 10 265 338 90 94 | 84 70 58 20 458 523 90 95 | 85 68 60 30 555 612 90 96 | 86 66 55 10 173 238 90 97 | 87 65 55 20 85 144 90 98 | 88 65 60 30 645 708 90 99 | 89 63 58 10 737 802 90 100 | 90 60 55 10 20 84 90 101 | 91 60 60 10 836 889 90 102 | 92 67 85 20 368 441 90 103 | 93 65 85 40 475 518 90 104 | 94 65 82 10 285 336 90 105 | 95 62 80 30 196 239 90 106 | 96 60 80 10 95 156 90 107 | 97 60 85 30 561 622 90 108 | 98 58 75 20 30 84 90 109 | 99 55 80 10 743 820 90 110 | 100 55 85 20 647 726 90 111 | -------------------------------------------------------------------------------- /test-cases/25-cust.txt: -------------------------------------------------------------------------------- 1 | C101 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 1236 0 11 | 1 45 68 10 912 967 90 12 | 2 45 70 30 825 870 90 13 | 3 42 66 10 65 146 90 14 | 4 42 68 10 727 782 90 15 | 5 42 65 10 15 67 90 16 | 6 40 69 20 621 702 90 17 | 7 40 66 20 170 225 90 18 | 8 38 68 20 255 324 90 19 | 9 38 70 10 534 605 90 20 | 10 35 66 10 357 410 90 21 | 11 35 69 10 448 505 90 22 | 12 25 85 20 652 721 90 23 | 13 22 75 30 30 92 90 24 | 14 22 85 10 567 620 90 25 | 15 20 80 40 384 429 90 26 | 16 20 85 40 475 528 90 27 | 17 18 75 20 99 148 90 28 | 18 15 75 20 179 254 90 29 | 19 15 80 10 278 345 90 30 | 20 30 50 10 10 73 90 31 | 21 30 52 20 914 965 90 32 | 22 28 52 20 812 883 90 33 | 23 28 55 10 732 777 90 34 | 24 25 50 10 65 144 90 35 | 25 25 52 40 169 224 90 36 | 37 | -------------------------------------------------------------------------------- /test-cases/C1_6_1.TXT: -------------------------------------------------------------------------------- 1 | c1_6_1 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 150 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 150 150 0 0 1496 0 11 | 1 17 205 20 306 355 90 12 | 2 153 254 20 562 629 90 13 | 3 229 219 10 253 319 90 14 | 4 214 156 20 672 732 90 15 | 5 121 260 10 358 414 90 16 | 6 29 277 10 233 297 90 17 | 7 47 277 20 163 210 90 18 | 8 85 224 10 913 974 90 19 | 9 105 230 10 91 155 90 20 | 10 160 111 30 106 155 90 21 | 11 65 69 10 1115 1184 90 22 | 12 63 233 20 629 696 90 23 | 13 143 111 20 39 100 90 24 | 14 173 233 30 626 680 90 25 | 15 85 24 20 470 537 90 26 | 16 277 100 10 286 353 90 27 | 17 166 105 20 551 633 90 28 | 18 141 137 30 163 233 90 29 | 19 100 73 20 245 299 90 30 | 20 61 70 30 119 180 90 31 | 21 161 210 10 306 370 90 32 | 22 30 280 20 412 485 90 33 | 23 129 98 20 582 655 90 34 | 24 62 65 20 939 988 90 35 | 25 256 239 10 575 629 90 36 | 26 9 144 40 569 626 90 37 | 27 174 228 20 722 775 90 38 | 28 203 156 20 53 107 90 39 | 29 251 241 10 197 265 90 40 | 30 109 110 20 390 457 90 41 | 31 106 233 10 159 211 90 42 | 32 22 102 10 837 921 90 43 | 33 145 184 10 464 527 90 44 | 34 121 170 30 569 624 90 45 | 35 25 141 20 471 519 90 46 | 36 167 176 20 369 422 90 47 | 37 126 229 10 701 769 90 48 | 38 122 172 10 468 542 90 49 | 39 119 267 10 635 698 90 50 | 40 68 113 20 698 776 90 51 | 41 257 243 10 661 731 90 52 | 42 157 266 20 116 156 90 53 | 43 157 31 20 1200 1260 90 54 | 44 73 226 20 174 222 90 55 | 45 74 109 40 238 294 90 56 | 46 12 198 10 874 927 90 57 | 47 199 126 10 118 175 90 58 | 48 31 55 20 669 755 90 59 | 49 10 147 20 386 442 90 60 | 50 168 176 20 274 335 90 61 | 51 277 104 20 135 186 90 62 | 52 55 232 10 176 255 90 63 | 53 119 262 20 452 505 90 64 | 54 220 74 20 835 878 90 65 | 55 122 175 30 381 442 90 66 | 56 144 182 30 649 707 90 67 | 57 149 285 10 201 249 90 68 | 58 61 157 40 428 494 90 69 | 59 140 143 20 12 81 90 70 | 60 203 125 30 307 366 90 71 | 61 114 164 20 104 153 90 72 | 62 108 80 20 803 863 90 73 | 63 103 232 20 252 305 90 74 | 64 71 154 40 901 949 90 75 | 65 87 27 20 383 438 90 76 | 66 67 154 20 797 864 90 77 | 67 255 132 10 530 604 90 78 | 68 108 113 10 214 262 90 79 | 69 86 230 20 155 231 90 80 | 70 226 221 10 996 1059 90 81 | 71 116 159 10 188 260 90 82 | 72 155 28 10 368 426 90 83 | 73 151 294 20 383 446 90 84 | 74 83 30 30 566 634 90 85 | 75 150 184 20 194 243 90 86 | 76 141 102 10 111 167 90 87 | 77 114 156 20 569 632 90 88 | 78 263 212 10 559 626 90 89 | 79 259 59 10 563 639 90 90 | 80 161 26 10 926 978 90 91 | 81 59 236 20 1026 1075 90 92 | 82 69 4 20 694 752 90 93 | 83 78 33 10 944 992 90 94 | 84 16 204 10 396 446 90 95 | 85 16 196 30 960 1031 90 96 | 86 113 114 20 51 120 90 97 | 87 153 28 10 276 334 90 98 | 88 67 161 10 83 151 90 99 | 89 211 61 20 629 697 90 100 | 90 125 103 20 53 131 90 101 | 91 269 29 20 520 579 90 102 | 92 146 61 20 623 687 90 103 | 93 33 142 20 746 806 90 104 | 94 26 282 20 507 580 90 105 | 95 29 285 20 601 674 90 106 | 96 130 230 20 519 577 90 107 | 97 260 58 20 743 823 90 108 | 98 173 72 10 326 377 90 109 | 99 162 206 30 403 461 90 110 | 100 148 60 10 811 863 90 111 | 101 272 38 30 330 383 90 112 | 102 160 27 30 1017 1070 90 113 | 103 231 218 10 350 405 90 114 | 104 173 76 20 237 278 90 115 | 105 66 7 10 786 849 90 116 | 106 114 49 10 627 690 90 117 | 107 213 68 10 103 177 90 118 | 108 59 280 20 882 951 90 119 | 109 175 101 20 55 95 90 120 | 110 96 237 20 725 777 90 121 | 111 115 196 10 57 120 90 122 | 112 153 265 30 464 525 90 123 | 113 110 79 20 898 953 90 124 | 114 227 222 20 903 971 90 125 | 115 275 97 10 470 539 90 126 | 116 216 6 20 230 269 90 127 | 117 29 148 20 277 336 90 128 | 118 137 104 30 840 909 90 129 | 119 253 57 10 138 186 90 130 | 120 136 140 10 261 327 90 131 | 121 209 127 10 771 829 90 132 | 122 59 64 10 658 703 90 133 | 123 283 229 20 870 914 90 134 | 124 141 286 10 947 1008 90 135 | 125 236 240 30 656 714 90 136 | 126 161 22 10 831 886 90 137 | 127 147 185 10 371 435 90 138 | 128 81 238 20 452 494 90 139 | 129 10 198 10 784 834 90 140 | 130 68 229 10 446 507 90 141 | 131 118 163 30 34 85 90 142 | 132 78 31 10 849 904 90 143 | 133 230 221 30 631 692 90 144 | 134 278 128 10 852 908 90 145 | 135 29 94 20 561 624 90 146 | 136 25 99 40 379 434 90 147 | 137 167 105 20 643 724 90 148 | 138 214 157 10 583 640 90 149 | 139 65 6 10 323 383 90 150 | 140 260 214 30 379 434 90 151 | 141 143 288 30 667 726 90 152 | 142 167 229 20 242 283 90 153 | 143 173 13 10 285 358 90 154 | 144 286 130 30 295 348 90 155 | 145 33 283 10 881 946 90 156 | 146 163 180 30 646 703 90 157 | 147 148 288 30 286 350 90 158 | 148 239 77 20 115 181 90 159 | 149 106 237 20 538 574 90 160 | 150 277 101 20 196 260 90 161 | 151 144 292 20 577 627 90 162 | 152 215 4 40 319 363 90 163 | 153 82 34 20 1030 1094 90 164 | 154 169 171 30 28 93 90 165 | 155 76 111 20 83 157 90 166 | 156 213 65 20 826 869 90 167 | 157 13 265 20 178 246 90 168 | 158 149 183 10 95 159 90 169 | 159 36 52 30 864 932 90 170 | 160 99 242 10 628 681 90 171 | 161 33 285 10 789 854 90 172 | 162 221 8 10 506 555 90 173 | 163 165 182 10 552 613 90 174 | 164 235 242 10 561 624 90 175 | 165 31 145 30 646 719 90 176 | 166 159 110 20 183 262 90 177 | 167 113 202 10 395 457 90 178 | 168 228 220 10 1088 1152 90 179 | 169 9 145 30 475 537 90 180 | 170 86 30 20 288 346 90 181 | 171 266 104 10 934 1000 90 182 | 172 217 21 30 494 546 90 183 | 173 161 112 10 39 88 90 184 | 174 255 240 20 476 545 90 185 | 175 203 128 20 498 546 90 186 | 176 77 233 20 629 690 90 187 | 177 168 108 10 744 809 90 188 | 178 133 99 20 692 733 90 189 | 179 202 133 20 1144 1197 90 190 | 180 211 150 20 1055 1104 90 191 | 181 141 100 10 381 450 90 192 | 182 54 285 10 706 752 90 193 | 183 220 66 20 363 401 90 194 | 184 285 225 30 154 220 90 195 | 185 174 79 20 688 760 90 196 | 186 147 67 30 1085 1143 90 197 | 187 70 57 20 837 902 90 198 | 188 159 177 30 736 803 90 199 | 189 160 107 30 380 431 90 200 | 190 70 227 10 354 413 90 201 | 191 136 233 10 148 203 90 202 | 192 256 54 30 292 355 90 203 | 193 107 71 20 427 492 90 204 | 194 202 131 10 1045 1113 90 205 | 195 181 8 20 852 911 90 206 | 196 257 137 20 356 405 90 207 | 197 134 146 10 454 508 90 208 | 198 53 237 20 825 901 90 209 | 199 274 97 10 568 622 90 210 | 200 285 230 10 763 837 90 211 | 201 55 62 20 549 624 90 212 | 202 160 108 10 294 336 90 213 | 203 242 73 20 273 330 90 214 | 204 248 245 10 136 193 90 215 | 205 154 266 40 172 247 90 216 | 206 113 50 20 452 501 90 217 | 207 25 50 10 496 551 90 218 | 208 143 61 10 531 593 90 219 | 209 222 73 20 642 703 90 220 | 210 60 15 10 162 211 90 221 | 211 224 79 30 248 326 90 222 | 212 86 31 20 200 253 90 223 | 213 67 230 10 536 600 90 224 | 214 147 60 20 709 784 90 225 | 215 65 156 10 611 682 90 226 | 216 262 241 20 940 1015 90 227 | 217 257 58 10 398 438 90 228 | 218 181 102 20 773 814 90 229 | 219 18 206 10 210 267 90 230 | 220 0 153 20 756 823 90 231 | 221 140 140 30 82 129 90 232 | 222 204 129 20 580 647 90 233 | 223 110 107 20 957 1017 90 234 | 224 128 172 20 31 80 90 235 | 225 23 107 10 1044 1086 90 236 | 226 170 237 10 422 479 90 237 | 227 174 74 30 609 649 90 238 | 228 164 103 10 489 558 90 239 | 229 206 129 10 868 919 90 240 | 230 65 56 10 184 253 90 241 | 231 262 211 10 660 707 90 242 | 232 236 248 10 290 338 90 243 | 233 161 94 20 57 119 90 244 | 234 136 220 10 1079 1142 90 245 | 235 166 113 10 846 898 90 246 | 236 176 71 20 513 557 90 247 | 237 64 55 20 282 338 90 248 | 238 118 156 40 668 721 90 249 | 239 142 57 10 338 410 90 250 | 240 66 8 20 872 945 90 251 | 241 174 71 20 420 466 90 252 | 242 131 226 20 886 960 90 253 | 243 280 175 30 483 534 90 254 | 244 136 144 10 358 418 90 255 | 245 178 10 20 563 636 90 256 | 246 230 248 20 189 248 90 257 | 247 201 121 10 207 278 90 258 | 248 257 59 20 484 535 90 259 | 249 65 4 30 594 665 90 260 | 250 165 204 20 209 272 90 261 | 251 134 148 20 731 781 90 262 | 252 164 202 30 677 737 90 263 | 253 218 20 20 405 452 90 264 | 254 287 224 10 216 277 90 265 | 255 63 59 20 839 897 90 266 | 256 121 181 20 280 350 90 267 | 257 257 133 20 448 501 90 268 | 258 112 201 20 306 363 90 269 | 259 272 41 20 230 297 90 270 | 260 110 74 30 528 578 90 271 | 261 137 229 10 227 311 90 272 | 262 70 225 30 254 329 90 273 | 263 53 234 20 555 611 90 274 | 264 233 216 10 439 502 90 275 | 265 100 231 20 915 969 90 276 | 266 140 290 20 860 906 90 277 | 267 111 52 20 174 229 90 278 | 268 249 133 10 166 218 90 279 | 269 8 155 10 858 919 90 280 | 270 126 256 20 921 983 90 281 | 271 212 26 30 766 830 90 282 | 272 156 26 10 545 617 90 283 | 273 238 69 20 549 605 90 284 | 274 280 125 10 757 816 90 285 | 275 65 5 20 405 484 90 286 | 276 176 14 10 138 174 90 287 | 277 59 223 20 914 977 90 288 | 278 43 286 10 231 296 90 289 | 279 262 62 10 937 1003 90 290 | 280 67 216 10 1011 1082 90 291 | 281 261 212 30 754 796 90 292 | 282 149 186 20 279 342 90 293 | 283 236 66 30 637 705 90 294 | 284 140 108 10 937 1002 90 295 | 285 60 156 20 342 397 90 296 | 286 114 50 10 535 600 90 297 | 287 28 103 10 130 206 90 298 | 288 27 100 10 190 258 90 299 | 289 163 200 10 772 827 90 300 | 290 63 229 20 724 789 90 301 | 291 150 56 20 156 212 90 302 | 292 254 240 20 383 457 90 303 | 293 63 155 10 518 591 90 304 | 294 106 77 10 707 772 90 305 | 295 246 133 30 1105 1162 90 306 | 296 227 217 10 1231 1304 90 307 | 297 278 43 20 166 221 90 308 | 298 182 238 10 526 580 90 309 | 299 65 49 20 559 619 90 310 | 300 60 160 20 150 211 90 311 | 301 175 12 20 476 536 90 312 | 302 223 74 10 734 794 90 313 | 303 128 176 20 100 151 90 314 | 304 235 241 30 748 804 90 315 | 305 280 172 10 563 639 90 316 | 306 11 265 10 243 299 90 317 | 307 79 30 30 756 813 90 318 | 308 144 100 20 296 348 90 319 | 309 222 83 20 98 158 90 320 | 310 261 215 10 283 347 90 321 | 311 264 61 20 837 920 90 322 | 312 183 99 20 671 728 90 323 | 313 109 105 10 862 927 90 324 | 314 258 212 10 843 894 90 325 | 315 150 272 10 261 352 90 326 | 316 147 178 10 836 890 90 327 | 317 93 235 20 819 869 90 328 | 318 125 228 30 803 851 90 329 | 319 109 42 10 723 792 90 330 | 320 162 203 30 492 558 90 331 | 321 179 97 10 218 264 90 332 | 322 105 55 20 105 177 90 333 | 323 29 55 20 594 647 90 334 | 324 216 62 20 447 508 90 335 | 325 51 238 20 741 802 90 336 | 326 281 129 20 664 720 90 337 | 327 8 263 30 342 387 90 338 | 328 259 58 30 663 721 90 339 | 329 136 104 20 759 808 90 340 | 330 199 130 20 52 113 90 341 | 331 108 109 20 483 548 90 342 | 332 106 108 20 586 630 90 343 | 333 110 76 30 611 679 90 344 | 334 144 173 20 929 988 90 345 | 335 282 227 20 939 1030 90 346 | 336 64 59 30 125 197 90 347 | 337 131 228 20 425 487 90 348 | 338 143 101 10 208 254 90 349 | 339 278 176 20 767 810 90 350 | 340 134 147 20 631 699 90 351 | 341 4 149 20 660 729 90 352 | 342 70 109 20 521 583 90 353 | 343 52 233 10 460 523 90 354 | 344 165 228 20 145 194 90 355 | 345 137 150 30 818 882 90 356 | 346 57 155 20 246 307 90 357 | 347 231 70 10 439 519 90 358 | 348 111 153 10 472 539 90 359 | 349 229 217 10 159 228 90 360 | 350 184 97 10 402 451 90 361 | 351 10 150 10 296 346 90 362 | 352 149 282 10 132 191 90 363 | 353 282 137 10 132 203 90 364 | 354 130 96 20 495 557 90 365 | 355 113 52 10 364 405 90 366 | 356 147 285 10 1046 1102 90 367 | 357 53 232 20 276 339 90 368 | 358 170 174 20 180 244 90 369 | 359 78 232 20 719 784 90 370 | 360 127 101 20 119 174 90 371 | 361 289 225 10 308 369 90 372 | 362 127 232 10 612 672 90 373 | 363 223 23 10 297 368 90 374 | 364 179 9 30 661 720 90 375 | 365 177 225 10 902 963 90 376 | 366 277 172 10 667 722 90 377 | 367 166 203 30 130 168 90 378 | 368 218 153 10 862 915 90 379 | 369 35 282 30 981 1031 90 380 | 370 151 30 20 185 240 90 381 | 371 284 176 30 288 353 90 382 | 372 252 128 10 742 781 90 383 | 373 28 144 20 563 616 90 384 | 374 83 236 10 349 412 90 385 | 375 223 11 20 587 660 90 386 | 376 164 95 20 129 172 90 387 | 377 216 25 30 689 720 90 388 | 378 275 32 20 429 477 90 389 | 379 35 56 10 206 273 90 390 | 380 135 227 10 327 396 90 391 | 381 183 97 40 312 359 90 392 | 382 60 64 10 746 797 90 393 | 383 104 235 10 429 497 90 394 | 384 128 94 30 314 369 90 395 | 385 30 279 20 328 387 90 396 | 386 31 275 20 172 225 90 397 | 387 233 242 30 841 896 90 398 | 388 64 53 30 465 525 90 399 | 389 148 62 20 994 1044 90 400 | 390 130 102 20 764 848 90 401 | 391 105 81 20 82 154 90 402 | 392 184 98 10 575 642 90 403 | 393 140 100 20 472 541 90 404 | 394 160 24 10 735 797 90 405 | 395 13 202 20 484 547 90 406 | 396 247 132 10 1012 1072 90 407 | 397 227 218 20 1180 1245 90 408 | 398 133 225 30 983 1048 90 409 | 399 129 177 20 190 244 90 410 | 400 14 149 10 193 260 90 411 | 401 31 284 10 700 759 90 412 | 402 287 226 10 391 472 90 413 | 403 55 285 30 793 847 90 414 | 404 216 148 10 951 1018 90 415 | 405 255 57 10 204 257 90 416 | 406 66 54 20 658 710 90 417 | 407 81 223 40 1009 1065 90 418 | 408 225 22 40 217 263 90 419 | 409 85 228 10 822 877 90 420 | 410 232 240 20 922 999 90 421 | 411 272 97 40 662 712 90 422 | 412 70 102 30 422 488 90 423 | 413 122 259 20 261 329 90 424 | 414 154 31 20 119 182 90 425 | 415 69 109 20 611 675 90 426 | 416 168 97 10 393 459 90 427 | 417 201 127 10 394 466 90 428 | 418 139 58 20 434 500 90 429 | 419 119 104 10 1059 1115 90 430 | 420 211 159 10 307 361 90 431 | 421 168 96 10 300 370 90 432 | 422 181 11 20 938 1011 90 433 | 423 158 27 10 1108 1163 90 434 | 424 115 42 30 822 884 90 435 | 425 162 107 10 464 532 90 436 | 426 17 209 10 145 218 90 437 | 427 50 285 10 339 381 90 438 | 428 19 102 30 756 816 90 439 | 429 174 13 20 210 252 90 440 | 430 184 12 20 1042 1094 90 441 | 431 217 69 10 260 316 90 442 | 432 58 235 10 932 985 90 443 | 433 258 247 40 851 910 90 444 | 434 250 134 30 250 317 90 445 | 435 268 38 30 803 858 90 446 | 436 66 157 10 706 769 90 447 | 437 270 37 40 705 771 90 448 | 438 12 270 20 624 692 90 449 | 439 11 207 40 579 642 90 450 | 440 121 255 30 169 231 90 451 | 441 233 245 10 376 441 90 452 | 442 215 160 10 488 548 90 453 | 443 269 103 20 846 902 90 454 | 444 280 180 20 187 261 90 455 | 445 177 82 30 789 847 90 456 | 446 78 236 10 535 597 90 457 | 447 66 56 30 746 806 90 458 | 448 116 265 20 549 598 90 459 | 449 287 128 30 384 444 90 460 | 450 228 223 10 819 871 90 461 | 451 173 224 10 1002 1051 90 462 | 452 138 101 20 659 720 90 463 | 453 275 100 30 375 447 90 464 | 454 3 205 10 680 738 90 465 | 455 280 225 20 1050 1105 90 466 | 456 8 265 20 426 486 90 467 | 457 169 235 10 333 384 90 468 | 458 37 62 10 143 195 90 469 | 459 29 57 30 301 370 90 470 | 460 259 126 20 633 695 90 471 | 461 227 214 20 100 144 90 472 | 462 1 272 10 523 589 90 473 | 463 74 106 20 323 395 90 474 | 464 132 146 20 554 593 90 475 | 465 58 231 10 122 197 90 476 | 466 157 25 20 640 705 90 477 | 467 258 232 20 1148 1191 90 478 | 468 109 157 20 387 436 90 479 | 469 282 134 30 192 259 90 480 | 470 288 227 40 486 560 90 481 | 471 52 63 10 473 513 90 482 | 472 65 68 20 1030 1087 90 483 | 473 212 62 20 726 782 90 484 | 474 167 179 20 461 517 90 485 | 475 169 173 10 91 150 90 486 | 476 204 131 20 959 1014 90 487 | 477 52 288 20 433 475 90 488 | 478 149 294 10 481 532 90 489 | 479 73 225 20 107 167 90 490 | 480 241 71 20 359 427 90 491 | 481 154 26 20 452 527 90 492 | 482 255 220 20 126 171 90 493 | 483 53 285 10 604 673 90 494 | 484 211 66 10 911 968 90 495 | 485 22 97 20 649 731 90 496 | 486 259 240 10 1038 1104 90 497 | 487 88 31 10 134 202 90 498 | 488 66 10 20 977 1024 90 499 | 489 26 99 10 293 338 90 500 | 490 111 112 20 118 170 90 501 | 491 250 126 20 827 882 90 502 | 492 123 92 20 219 272 90 503 | 493 227 26 20 145 205 90 504 | 494 63 3 10 508 566 90 505 | 495 230 223 10 722 784 90 506 | 496 216 157 20 761 827 90 507 | 497 63 7 20 231 290 90 508 | 498 280 130 10 568 633 90 509 | 499 116 49 30 1003 1078 90 510 | 500 166 94 30 211 274 90 511 | 501 211 157 20 201 282 90 512 | 502 148 61 10 900 957 90 513 | 503 37 53 10 956 1023 90 514 | 504 177 4 10 762 811 90 515 | 505 269 35 20 611 681 90 516 | 506 101 110 10 674 731 90 517 | 507 236 72 20 735 799 90 518 | 508 185 98 20 487 547 90 519 | 509 62 53 10 368 437 90 520 | 510 112 199 20 218 267 90 521 | 511 165 113 20 941 985 90 522 | 512 218 3 30 405 464 90 523 | 513 281 130 30 473 547 90 524 | 514 271 101 10 750 812 90 525 | 515 288 231 20 679 734 90 526 | 516 204 127 10 676 735 90 527 | 517 131 95 20 403 466 90 528 | 518 171 79 20 74 141 90 529 | 519 151 269 40 374 426 90 530 | 520 67 10 30 1061 1122 90 531 | 521 29 152 30 121 200 90 532 | 522 240 71 30 458 510 90 533 | 523 210 156 20 125 176 90 534 | 524 240 73 20 178 240 90 535 | 525 74 113 20 806 860 90 536 | 526 263 215 20 471 528 90 537 | 527 25 145 30 374 429 90 538 | 528 23 103 20 930 1011 90 539 | 529 145 182 10 726 812 90 540 | 530 124 264 30 731 794 90 541 | 531 88 225 20 97 146 90 542 | 532 246 137 10 96 150 90 543 | 533 84 236 10 258 321 90 544 | 534 235 243 20 477 526 90 545 | 535 236 218 10 542 587 90 546 | 536 275 182 10 129 188 90 547 | 537 102 235 30 340 403 90 548 | 538 212 9 30 154 222 90 549 | 539 26 97 10 471 527 90 550 | 540 59 67 10 184 243 90 551 | 541 49 234 20 640 713 90 552 | 542 57 68 10 267 344 90 553 | 543 217 11 30 699 741 90 554 | 544 277 177 20 946 994 90 555 | 545 28 56 30 396 459 90 556 | 546 140 228 20 78 148 90 557 | 547 227 80 30 165 223 90 558 | 548 115 48 30 910 989 90 559 | 549 217 73 20 918 981 90 560 | 550 216 23 10 575 649 90 561 | 551 112 51 10 264 322 90 562 | 552 64 226 30 817 883 90 563 | 553 278 177 20 854 904 90 564 | 554 52 231 10 372 427 90 565 | 555 140 292 10 760 823 90 566 | 556 224 77 20 345 413 90 567 | 557 114 204 20 493 543 90 568 | 558 288 228 10 577 651 90 569 | 559 173 11 20 385 442 90 570 | 560 114 198 20 127 173 90 571 | 561 34 54 30 781 830 90 572 | 562 145 183 10 558 615 90 573 | 563 213 61 20 538 604 90 574 | 564 179 98 20 113 188 90 575 | 565 261 217 10 189 257 90 576 | 566 115 197 10 590 640 90 577 | 567 123 260 10 826 888 90 578 | 568 138 100 30 565 631 90 579 | 569 231 243 10 123 188 90 580 | 570 257 210 10 925 997 90 581 | 571 212 159 20 397 453 90 582 | 572 103 78 10 149 202 90 583 | 573 286 175 10 384 441 90 584 | 574 82 31 10 662 722 90 585 | 575 144 59 10 255 306 90 586 | 576 119 157 10 762 810 90 587 | 577 166 226 30 77 123 90 588 | 578 258 244 10 749 827 90 589 | 579 163 202 20 601 632 90 590 | 580 75 110 10 150 201 90 591 | 581 175 227 30 815 864 90 592 | 582 114 158 30 283 349 90 593 | 583 147 281 20 1146 1190 90 594 | 584 250 130 10 917 979 90 595 | 585 37 280 20 1064 1133 90 596 | 586 215 68 10 167 223 90 597 | 587 119 253 20 107 169 90 598 | 588 16 151 20 134 192 90 599 | 589 251 237 10 301 350 90 600 | 590 30 148 20 181 250 90 601 | 591 221 70 10 547 612 90 602 | 592 106 71 20 335 402 90 603 | 593 111 110 10 298 366 90 604 | 594 150 64 10 86 143 90 605 | 595 172 78 20 131 200 90 606 | 596 55 68 30 361 435 90 607 | 597 107 103 20 768 836 90 608 | 598 155 180 30 30 90 90 609 | 599 53 288 20 512 579 90 610 | 600 168 204 20 56 115 90 611 | -------------------------------------------------------------------------------- /test-cases/Christofides_01.vrp: -------------------------------------------------------------------------------- 1 | NAME: Christofides-1 2 | BEST_KNOWN: 524.61 3 | COMMENT: 524.610000 4 | DIMENSION: 51 5 | CAPACITY: 160 6 | EDGE_WEIGHT_FORMAT: FUNCTION 7 | EDGE_WEIGHT_TYPE: EXACT_2D 8 | NODE_COORD_SECTION 9 | 1 0.00000 0.00000 10 | 2 7.00000 12.00000 11 | 3 19.00000 9.00000 12 | 4 22.00000 24.00000 13 | 5 -10.00000 -14.00000 14 | 6 10.00000 -10.00000 15 | 7 -9.00000 7.00000 16 | 8 -13.00000 23.00000 17 | 9 1.00000 22.00000 18 | 10 22.00000 -7.00000 19 | 11 21.00000 -19.00000 20 | 12 12.00000 1.00000 21 | 13 1.00000 -8.00000 22 | 14 -25.00000 -15.00000 23 | 15 -18.00000 2.00000 24 | 16 6.00000 -24.00000 25 | 17 22.00000 1.00000 26 | 18 -3.00000 -17.00000 27 | 19 -13.00000 -7.00000 28 | 20 -17.00000 -27.00000 29 | 21 27.00000 18.00000 30 | 22 32.00000 2.00000 31 | 23 12.00000 17.00000 32 | 24 -14.00000 17.00000 33 | 25 -22.00000 12.00000 34 | 26 -23.00000 -2.00000 35 | 27 -3.00000 28.00000 36 | 28 0.00000 8.00000 37 | 29 13.00000 27.00000 38 | 30 28.00000 8.00000 39 | 31 28.00000 -13.00000 40 | 32 7.00000 29.00000 41 | 33 8.00000 6.00000 42 | 34 16.00000 -30.00000 43 | 35 31.00000 -7.00000 44 | 36 32.00000 23.00000 45 | 37 33.00000 29.00000 46 | 38 2.00000 -18.00000 47 | 39 15.00000 -5.00000 48 | 40 29.00000 -25.00000 49 | 41 -25.00000 -34.00000 50 | 42 -20.00000 -23.00000 51 | 43 -9.00000 -30.00000 52 | 44 -25.00000 24.00000 53 | 45 0.00000 -25.00000 54 | 46 9.00000 -30.00000 55 | 47 2.00000 -1.00000 56 | 48 -5.00000 -8.00000 57 | 49 -5.00000 15.00000 58 | 50 18.00000 -12.00000 59 | 51 26.00000 -3.00000 60 | DEMAND_SECTION 61 | 1 0 62 | 2 7 63 | 3 30 64 | 4 16 65 | 5 9 66 | 6 21 67 | 7 15 68 | 8 19 69 | 9 23 70 | 10 11 71 | 11 5 72 | 12 19 73 | 13 29 74 | 14 23 75 | 15 21 76 | 16 10 77 | 17 15 78 | 18 3 79 | 19 41 80 | 20 9 81 | 21 28 82 | 22 8 83 | 23 8 84 | 24 16 85 | 25 10 86 | 26 28 87 | 27 7 88 | 28 15 89 | 29 14 90 | 30 6 91 | 31 19 92 | 32 11 93 | 33 12 94 | 34 23 95 | 35 26 96 | 36 17 97 | 37 6 98 | 38 9 99 | 39 15 100 | 40 14 101 | 41 7 102 | 42 27 103 | 43 13 104 | 44 11 105 | 45 16 106 | 46 10 107 | 47 5 108 | 48 25 109 | 49 17 110 | 50 18 111 | 51 10 112 | DEPOT_SECTION 113 | 1 114 | -1 115 | EOF 116 | -------------------------------------------------------------------------------- /test-cases/Christofides_02.vrp: -------------------------------------------------------------------------------- 1 | NAME: Christofides-2 2 | BEST_KNOWN: 835.26 3 | COMMENT: 835.260000 4 | DIMENSION: 76 5 | CAPACITY: 140 6 | EDGE_WEIGHT_FORMAT: FUNCTION 7 | EDGE_WEIGHT_TYPE: EXACT_2D 8 | NODE_COORD_SECTION 9 | 1 0.00000 0.00000 10 | 2 -18.00000 -18.00000 11 | 3 -4.00000 -14.00000 12 | 4 -19.00000 5.00000 13 | 5 5.00000 -5.00000 14 | 6 15.00000 -20.00000 15 | 7 -7.00000 -6.00000 16 | 8 10.00000 10.00000 17 | 9 15.00000 5.00000 18 | 10 -14.00000 19.00000 19 | 11 0.00000 26.00000 20 | 12 15.00000 25.00000 21 | 13 -5.00000 11.00000 22 | 14 22.00000 -5.00000 23 | 15 22.00000 17.00000 24 | 16 22.00000 -16.00000 25 | 17 -19.00000 -4.00000 26 | 18 -7.00000 4.00000 27 | 19 -31.00000 16.00000 28 | 20 22.00000 8.00000 29 | 21 26.00000 -26.00000 30 | 22 4.00000 -27.00000 31 | 23 -14.00000 -27.00000 32 | 24 -29.00000 -12.00000 33 | 25 -33.00000 3.00000 34 | 26 -23.00000 24.00000 35 | 27 1.00000 6.00000 36 | 28 15.00000 -6.00000 37 | 29 -5.00000 -24.00000 38 | 30 12.00000 -14.00000 39 | 31 3.00000 -14.00000 40 | 32 -9.00000 36.00000 41 | 33 -18.00000 13.00000 42 | 34 -14.00000 -11.00000 43 | 35 10.00000 0.00000 44 | 36 15.00000 10.00000 45 | 37 14.00000 -30.00000 46 | 38 20.00000 -25.00000 47 | 39 7.00000 26.00000 48 | 40 -10.00000 20.00000 49 | 41 -10.00000 10.00000 50 | 42 -28.00000 -23.00000 51 | 43 -25.00000 -26.00000 52 | 44 -24.00000 -21.00000 53 | 45 -19.00000 8.00000 54 | 46 10.00000 -10.00000 55 | 47 11.00000 2.00000 56 | 48 10.00000 -25.00000 57 | 49 8.00000 -19.00000 58 | 50 -28.00000 -2.00000 59 | 51 -25.00000 16.00000 60 | 52 -11.00000 -1.00000 61 | 53 14.00000 -2.00000 62 | 54 15.00000 17.00000 63 | 55 27.00000 1.00000 64 | 56 -30.00000 30.00000 65 | 57 -34.00000 -15.00000 66 | 58 25.00000 -13.00000 67 | 59 0.00000 20.00000 68 | 60 30.00000 24.00000 69 | 61 24.00000 -36.00000 70 | 62 -4.00000 -34.00000 71 | 63 -10.00000 -20.00000 72 | 64 -20.00000 -10.00000 73 | 65 -25.00000 -35.00000 74 | 66 10.00000 30.00000 75 | 67 17.00000 32.00000 76 | 68 5.00000 2.00000 77 | 69 -2.00000 -7.00000 78 | 70 10.00000 -36.00000 79 | 71 26.00000 -32.00000 80 | 72 19.00000 -35.00000 81 | 73 -5.00000 20.00000 82 | 74 -13.00000 -16.00000 83 | 75 0.00000 -20.00000 84 | 76 0.00000 -3.00000 85 | DEMAND_SECTION 86 | 1 0 87 | 2 18 88 | 3 26 89 | 4 11 90 | 5 30 91 | 6 21 92 | 7 19 93 | 8 15 94 | 9 16 95 | 10 29 96 | 11 26 97 | 12 37 98 | 13 16 99 | 14 12 100 | 15 31 101 | 16 8 102 | 17 19 103 | 18 20 104 | 19 13 105 | 20 15 106 | 21 22 107 | 22 28 108 | 23 12 109 | 24 6 110 | 25 27 111 | 26 14 112 | 27 18 113 | 28 17 114 | 29 29 115 | 30 13 116 | 31 22 117 | 32 25 118 | 33 28 119 | 34 27 120 | 35 19 121 | 36 10 122 | 37 12 123 | 38 14 124 | 39 24 125 | 40 16 126 | 41 33 127 | 42 15 128 | 43 11 129 | 44 18 130 | 45 17 131 | 46 21 132 | 47 27 133 | 48 19 134 | 49 20 135 | 50 5 136 | 51 22 137 | 52 12 138 | 53 19 139 | 54 22 140 | 55 16 141 | 56 7 142 | 57 26 143 | 58 14 144 | 59 21 145 | 60 24 146 | 61 13 147 | 62 15 148 | 63 18 149 | 64 11 150 | 65 28 151 | 66 9 152 | 67 37 153 | 68 30 154 | 69 10 155 | 70 8 156 | 71 11 157 | 72 3 158 | 73 1 159 | 74 6 160 | 75 10 161 | 76 20 162 | DEPOT_SECTION 163 | 1 164 | -1 165 | EOF 166 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/C101.txt: -------------------------------------------------------------------------------- 1 | C101 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 1236 0 11 | 1 45 68 10 912 967 90 12 | 2 45 70 30 825 870 90 13 | 3 42 66 10 65 146 90 14 | 4 42 68 10 727 782 90 15 | 5 42 65 10 15 67 90 16 | 6 40 69 20 621 702 90 17 | 7 40 66 20 170 225 90 18 | 8 38 68 20 255 324 90 19 | 9 38 70 10 534 605 90 20 | 10 35 66 10 357 410 90 21 | 11 35 69 10 448 505 90 22 | 12 25 85 20 652 721 90 23 | 13 22 75 30 30 92 90 24 | 14 22 85 10 567 620 90 25 | 15 20 80 40 384 429 90 26 | 16 20 85 40 475 528 90 27 | 17 18 75 20 99 148 90 28 | 18 15 75 20 179 254 90 29 | 19 15 80 10 278 345 90 30 | 20 30 50 10 10 73 90 31 | 21 30 52 20 914 965 90 32 | 22 28 52 20 812 883 90 33 | 23 28 55 10 732 777 90 34 | 24 25 50 10 65 144 90 35 | 25 25 52 40 169 224 90 36 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/C201.txt: -------------------------------------------------------------------------------- 1 | C201 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 700 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 3390 0 11 | 1 52 75 10 311 471 90 12 | 2 45 70 30 213 373 90 13 | 3 62 69 10 1167 1327 90 14 | 4 60 66 10 1261 1421 90 15 | 5 42 65 10 25 185 90 16 | 6 16 42 20 497 657 90 17 | 7 58 70 20 1073 1233 90 18 | 8 34 60 20 2887 3047 90 19 | 9 28 70 10 2601 2761 90 20 | 10 35 66 10 2791 2951 90 21 | 11 35 69 10 2698 2858 90 22 | 12 25 85 20 2119 2279 90 23 | 13 22 75 30 2405 2565 90 24 | 14 22 85 10 2026 2186 90 25 | 15 20 80 40 2216 2376 90 26 | 16 20 85 40 1934 2094 90 27 | 17 18 75 20 2311 2471 90 28 | 18 15 75 20 1742 1902 90 29 | 19 15 80 10 1837 1997 90 30 | 20 30 50 10 10 170 90 31 | 21 30 56 20 2983 3143 90 32 | 22 28 52 20 22 182 90 33 | 23 14 66 10 1643 1803 90 34 | 24 25 50 10 116 276 90 35 | 25 22 66 40 2504 2664 90 36 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/R101.txt: -------------------------------------------------------------------------------- 1 | R101 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 35 35 0 0 230 0 11 | 1 41 49 10 161 171 10 12 | 2 35 17 7 50 60 10 13 | 3 55 45 13 116 126 10 14 | 4 55 20 19 149 159 10 15 | 5 15 30 26 34 44 10 16 | 6 25 30 3 99 109 10 17 | 7 20 50 5 81 91 10 18 | 8 10 43 9 95 105 10 19 | 9 55 60 16 97 107 10 20 | 10 30 60 16 124 134 10 21 | 11 20 65 12 67 77 10 22 | 12 50 35 19 63 73 10 23 | 13 30 25 23 159 169 10 24 | 14 15 10 20 32 42 10 25 | 15 30 5 8 61 71 10 26 | 16 10 20 19 75 85 10 27 | 17 5 30 2 157 167 10 28 | 18 20 40 12 87 97 10 29 | 19 15 60 17 76 86 10 30 | 20 45 65 9 126 136 10 31 | 21 45 20 11 62 72 10 32 | 22 45 10 18 97 107 10 33 | 23 55 5 29 68 78 10 34 | 24 65 35 3 153 163 10 35 | 25 65 20 6 172 182 10 36 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/R201.txt: -------------------------------------------------------------------------------- 1 | R201 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 1000 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 35 35 0 0 1000 0 11 | 1 41 49 10 707 848 10 12 | 2 35 17 7 143 282 10 13 | 3 55 45 13 527 584 10 14 | 4 55 20 19 678 801 10 15 | 5 15 30 26 34 209 10 16 | 6 25 30 3 415 514 10 17 | 7 20 50 5 331 410 10 18 | 8 10 43 9 404 481 10 19 | 9 55 60 16 400 497 10 20 | 10 30 60 16 577 632 10 21 | 11 20 65 12 206 325 10 22 | 12 50 35 19 228 345 10 23 | 13 30 25 23 690 827 10 24 | 14 15 10 20 32 243 10 25 | 15 30 5 8 175 300 10 26 | 16 10 20 19 272 373 10 27 | 17 5 30 2 733 870 10 28 | 18 20 40 12 377 434 10 29 | 19 15 60 17 269 378 10 30 | 20 45 65 9 581 666 10 31 | 21 45 20 11 214 331 10 32 | 22 45 10 18 409 494 10 33 | 23 55 5 29 206 325 10 34 | 24 65 35 3 704 847 10 35 | 25 65 20 6 817 956 10 36 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/RC101.txt: -------------------------------------------------------------------------------- 1 | RC101 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 200 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 240 0 11 | 1 25 85 20 145 175 10 12 | 2 22 75 30 50 80 10 13 | 3 22 85 10 109 139 10 14 | 4 20 80 40 141 171 10 15 | 5 20 85 20 41 71 10 16 | 6 18 75 20 95 125 10 17 | 7 15 75 20 79 109 10 18 | 8 15 80 10 91 121 10 19 | 9 10 35 20 91 121 10 20 | 10 10 40 30 119 149 10 21 | 11 8 40 40 59 89 10 22 | 12 8 45 20 64 94 10 23 | 13 5 35 10 142 172 10 24 | 14 5 45 10 35 65 10 25 | 15 2 40 20 58 88 10 26 | 16 0 40 20 72 102 10 27 | 17 0 45 20 149 179 10 28 | 18 44 5 20 87 117 10 29 | 19 42 10 40 72 102 10 30 | 20 42 15 10 122 152 10 31 | 21 40 5 10 67 97 10 32 | 22 40 15 40 92 122 10 33 | 23 38 5 30 65 95 10 34 | 24 38 15 10 148 178 10 35 | 25 35 5 20 154 184 10 36 | -------------------------------------------------------------------------------- /test-cases/Solomon-25/RC201.txt: -------------------------------------------------------------------------------- 1 | RC201 2 | 3 | VEHICLE 4 | NUMBER CAPACITY 5 | 25 1000 6 | 7 | CUSTOMER 8 | CUST NO. XCOORD. YCOORD. DEMAND READY TIME DUE DATE SERVICE TIME 9 | 10 | 0 40 50 0 0 960 0 11 | 1 25 85 20 673 793 10 12 | 2 22 75 30 152 272 10 13 | 3 22 85 10 471 591 10 14 | 4 20 80 40 644 764 10 15 | 5 20 85 20 73 193 10 16 | 6 18 75 20 388 508 10 17 | 7 15 75 20 300 420 10 18 | 8 15 80 10 367 487 10 19 | 9 10 35 20 371 491 10 20 | 10 10 40 30 519 639 10 21 | 11 8 40 40 195 315 10 22 | 12 8 45 20 223 343 10 23 | 13 5 35 10 653 773 10 24 | 14 5 45 10 35 155 10 25 | 15 2 40 20 174 294 10 26 | 16 0 40 20 255 375 10 27 | 17 0 45 20 703 823 10 28 | 18 44 5 20 335 455 10 29 | 19 42 10 40 254 374 10 30 | 20 42 15 10 537 657 10 31 | 21 40 5 10 215 335 10 32 | 22 40 15 40 375 495 10 33 | 23 38 5 30 201 321 10 34 | 24 38 15 10 681 801 10 35 | 25 35 5 20 784 904 10 36 | -------------------------------------------------------------------------------- /test-cases/test-cases.lisp: -------------------------------------------------------------------------------- 1 | ;; Some test instances 2 | ;; ----------------------- 3 | (in-package :open-vrp.test) 4 | 5 | (defparameter *node-coords* 6 | (list (cons 0 0) 7 | (cons 1 2) 8 | (cons 1 3) 9 | (cons 2 4) 10 | (cons 3 5) 11 | (cons 4 4) 12 | (cons 4 -2) 13 | (cons 3 -5) 14 | (cons 2 -3) 15 | (cons -2 -2))) 16 | 17 | ;; Initialization of objects 18 | (defvar test-tsp (define-problem "test-case-TSP" 1 :node-coords-list *node-coords* :to-depot nil :plotp nil)) 19 | (defvar test-vrp (define-problem "test-case-VRP" 2 :node-coords-list *node-coords*)) 20 | (defvar solomon25 21 | (load-test-case-file (merge-pathnames "test-cases/25-cust.txt" 22 | (asdf:system-source-directory 'open-vrp)))) 23 | (defvar solomon100 24 | (load-test-case-file (merge-pathnames "test-cases/100-cust.txt" 25 | (asdf:system-source-directory 'open-vrp)))) 26 | (defvar christofides-1 27 | (load-test-case-file (merge-pathnames "test-cases/Christofides_01.vrp" 28 | (asdf:system-source-directory 'open-vrp)))) 29 | (defvar christofides-2 30 | (load-test-case-file (merge-pathnames "test-cases/Christofides_02.vrp" 31 | (asdf:system-source-directory 'open-vrp)))) 32 | 33 | 34 | -------------------------------------------------------------------------------- /test-cases/test-suite.lisp: -------------------------------------------------------------------------------- 1 | ;;; A test suite for Open-VRP using FiveAM 2 | (in-package :open-vrp.test) 3 | 4 | (def-suite :suite-open-vrp) 5 | (in-suite :suite-open-vrp) 6 | 7 | ;; Generic algo runs 8 | ;; -------------------------------------- 9 | (defmacro on-all-testcases (algo-symbol) 10 | (labels ((mkstr (&rest args) 11 | (with-output-to-string (s) 12 | (dolist (a args) (princ a s)))) 13 | (symb (&rest args) 14 | (values (intern (apply #'mkstr args))))) 15 | `(progn 16 | (test ,(symb algo-symbol '-tsp) (is (solve-prob test-tsp (make-instance ,algo-symbol)))) 17 | (test ,(symb algo-symbol '-vrp) (is (solve-prob test-vrp (make-instance ,algo-symbol)))) 18 | (test ,(symb algo-symbol '-25) (is (solve-prob solomon25 (make-instance ,algo-symbol)))) 19 | (test ,(symb algo-symbol '-100) (is (solve-prob solomon100 (make-instance ,algo-symbol)))) 20 | (test ,(symb algo-symbol '-chr1) (is (solve-prob christofides-1 (make-instance ,algo-symbol)))) 21 | (test ,(symb algo-symbol '-chr2) (is (solve-prob christofides-2 (make-instance ,algo-symbol))))))) 22 | 23 | ;; routine tests 24 | (on-all-testcases 'greedy-nn) 25 | (on-all-testcases 'greedy-append) 26 | (on-all-testcases 'greedy-best-insertion) 27 | (on-all-testcases 'tabu-search) 28 | 29 | 30 | ;; special tabu-search tests 31 | 32 | (test tabu-100 (is (solve-prob solomon100 (make-instance 'tabu-search :iterations 100)))) 33 | 34 | ;; -------------------------------- 35 | 36 | ;; Constraints checking tests 37 | ;; -------------------------------- 38 | ;; Capacity 39 | (defun space-v () 40 | (make-vehicle 41 | :capacity 3 42 | :route (list (new-node 8 0 0 :demand 1) 43 | (new-node 9 1 1 :demand 1)))) 44 | 45 | (defun overfull-v () 46 | (make-vehicle 47 | :capacity 2 48 | :route (list (new-node 0 0 0 :demand 1) 49 | (new-node 1 1 1 :demand 2)))) 50 | 51 | (test capacity-veh-in 52 | (is (in-capacityp (space-v)))) 53 | 54 | (test capacity-veh-out 55 | (is-false (in-capacityp (overfull-v)))) 56 | 57 | (test capacity-fleet-in 58 | (is (in-capacityp (make-instance 'cvrp :fleet (list (space-v) (space-v) (space-v)))))) 59 | 60 | (test capacity-fleet-out 61 | (is-false (in-capacityp (make-instance 'cvrp :fleet (list (overfull-v) (space-v)))))) 62 | 63 | ;; Time Windows 64 | (defun on-time-v () 65 | (make-vehicle 66 | :speed 1 67 | :route (list 68 | (new-node 1 1 0 :start 0 :end 2 :duration 1) 69 | (new-node 2 2 0 :start 0 :end 2 :duration 1) 70 | (new-node 3 3 0 :start 5 :end 8 :duration 2) 71 | (new-node 4 4 0 :start 0 :end 10 :duration 1)))) 72 | 73 | (defun late-v-duration () 74 | (make-vehicle 75 | :speed 1 76 | :route (list 77 | (new-node 1 1 0 :start 0 :end 2 :duration 0) 78 | (new-node 2 2 0 :start 0 :end 2 :duration 10) 79 | (new-node 3 3 0 :start 5 :end 8 :duration 2) 80 | (new-node 4 4 0 :start 0 :end 10 :duration 1)))) 81 | 82 | (defun late-v-speed () 83 | (make-vehicle 84 | :speed 0.5 85 | :route (list 86 | (new-node 1 1 0 :start 0 :end 2 :duration 1) 87 | (new-node 2 2 0 :start 0 :end 2 :duration 1) 88 | (new-node 3 3 0 :start 5 :end 8 :duration 2) 89 | (new-node 4 4 0 :start 0 :end 8 :duration 1)))) 90 | 91 | (test time-window-test-on-time 92 | (is (veh-in-timep (on-time-v)))) 93 | 94 | (test time-window-test-too-late-duration 95 | (is-false (veh-in-timep (late-v-duration)))) 96 | 97 | (test time-window-test-too-late-speed 98 | (is-false (veh-in-timep (late-v-speed)))) 99 | 100 | (test time-window-test-fleet-on-time 101 | (is (in-timep (make-instance 'vrptw :fleet (list (on-time-v) (on-time-v) (on-time-v)))))) 102 | 103 | (test time-window-test-fleet-late 104 | (is-false (in-timep (make-instance 'vrptw :fleet (list (on-time-v) (late-v-speed) (on-time-v)))))) 105 | 106 | ;; Capacity AND Time Windows 107 | (defun on-time-and-in-cap-v () 108 | (make-vehicle 109 | :speed 1 110 | :capacity 10 111 | :route (list 112 | (new-node 1 1 0 :start 0 :end 2 :duration 1 :demand 3) 113 | (new-node 2 2 0 :start 0 :end 2 :duration 1 :demand 1) 114 | (new-node 3 3 0 :start 5 :end 8 :duration 2 :demand 1) 115 | (new-node 4 4 0 :start 0 :end 10 :duration 1 :demand 1)))) 116 | 117 | (defun on-time-but-overfull-v () 118 | (make-vehicle 119 | :speed 1 120 | :capacity 2 121 | :route (list 122 | (new-node 1 1 0 :start 0 :end 2 :duration 1 :demand 3) 123 | (new-node 2 2 0 :start 0 :end 2 :duration 1 :demand 1) 124 | (new-node 3 3 0 :start 5 :end 8 :duration 2 :demand 1) 125 | (new-node 4 4 0 :start 0 :end 10 :duration 1 :demand 1)))) 126 | 127 | 128 | (test tw-and-cap-test-ok 129 | (is (constraintsp (make-instance 'cvrptw :fleet (list (on-time-and-in-cap-v) (on-time-and-in-cap-v)))))) 130 | 131 | (test tw-and-cap-test-fail 132 | (is-false (constraintsp (make-instance 'cvrptw :fleet (list (on-time-and-in-cap-v) (on-time-but-overfull-v)))))) 133 | ;; ----------------------- 134 | 135 | ;; Move feasibility checks 136 | ;; ----------------------- 137 | 138 | (test cap-move-feasible 139 | (is (feasible-movep (make-instance 'cvrp :fleet (list (space-v) (space-v)) :network (vector (new-node 1 1 1 :demand 1))) 140 | (make-insertion-move :node-id 0 :vehicle-id 0)))) 141 | 142 | (test cap-move-infeasible 143 | (is-false (feasible-movep (make-instance 'cvrp :fleet (list (space-v) (space-v)) :network (vector (new-node 1 1 1 :demand 5))) 144 | (make-insertion-move :node-id 0 :vehicle-id 0)))) 145 | 146 | (test tw-move-feasible 147 | (is (feasible-movep (make-instance 'vrptw :fleet (list (on-time-v) (on-time-v)) :network (vector (new-node 5 2 1 :start 3 :end 5 :duration 1))) 148 | (make-insertion-move :node-id 0 :vehicle-id 0 :index 2)))) 149 | 150 | (test tw-move-infeasible 151 | (is-false (feasible-movep (make-instance 'vrptw :fleet (list (on-time-v) (on-time-v)) :network (vector (new-node 5 2 1 :start 3 :end 5 :duration 1))) 152 | (make-insertion-move :node-id 0 :vehicle-id 0 :index 3)))) 153 | 154 | ;; ----------------------- 155 | 156 | ;; Asymmetric network 157 | ;; ----------------------- 158 | 159 | (defvar asym-net (define-problem "asym" 1 :demands '(0 1 1) :capacities 2 :to-depot nil :dist-matrix #2A((nil 1 5)(5 nil 1) (1 5 nil)))) 160 | 161 | (test asym-greedy-nn (is (solve-prob asym-net (make-instance 'greedy-nn)))) 162 | (test asym-greedy-append (is (solve-prob asym-net (make-instance 'greedy-append)))) 163 | (test asym-greedy-best-insertion (is (solve-prob asym-net (make-instance 'greedy-best-insertion)))) 164 | (test asym-tabu-search (is (solve-prob asym-net (make-instance 'tabu-search)))) 165 | 166 | 167 | (defvar asym-tsp (define-problem "asym" 1 :dist-matrix #2A((nil 1 5)(5 nil 1) (1 5 nil)))) 168 | 169 | (test asym-greedy-nn (is (solve-prob asym-tsp (make-instance 'greedy-nn)))) 170 | (test asym-greedy-append (is (solve-prob asym-tsp (make-instance 'greedy-append)))) 171 | (test asym-greedy-best-insertion (is (solve-prob asym-tsp (make-instance 'greedy-best-insertion)))) 172 | (test asym-tabu-search (is (solve-prob asym-tsp (make-instance 'tabu-search)))) 173 | 174 | (defvar asym-vrp (define-problem "asym-vrp" 1 :dist-matrix #2A((nil 1 2)(1 nil 3)(2 3 nil)) :time-windows-list '((0 . 10)(2 . 5)(5 . 10)) :log-mode 0)) 175 | 176 | (test asym-vrp-perform-move 177 | (is (perform-move asym-vrp 178 | (make-insertion-move :node-id 1 :vehicle-id 0 :index 1)))) 179 | 180 | (test tw-move-infeasible 181 | (is-false (feasible-movep asym-vrp 182 | (make-insertion-move :node-id 2 :vehicle-id 0 :index 1)))) 183 | 184 | (test tw-move-feasible 185 | (is (feasible-movep asym-vrp 186 | (make-insertion-move :node-id 2 :vehicle-id 0 :index 2)))) 187 | --------------------------------------------------------------------------------