convenience-functions.lisp

(ql:quickload "iterate")
(use-package :iterate)

(defmacro defparameters (exprs)
  `(progn ,@(iter (for (name exp) in exprs)
		  (collect `(defparameter ,name ,exp)))))

wumpus.lisp

(load "convenience-macros")		; also loads :iterate

;; define all the parameters
(defparameters ((*congestion-city-nodes* nil)
		(*congestion-city-edges* nil)
		(*visited-nodes* nil)
		(*node-num* 30)
		(*edge-num* 45)
		(*worm-num* 3)
		(*cop-odds* 15)))

(defun random-node ()
  "returns a random natural number between 1 and *node-num*"
  (1+ (random *node-num*)))

(defun edge-pair (a b)
  "returns a list of edge-pairs, (edge-pair 1 2) becomes ((1 . 2) (2 . 1))"
  (unless (eql a b)
    (list (cons a b) (cons b a))))

(defun make-edge-list ()
  "makes *edge-num* random edge pairs, and puts them into a list"
  (apply #'append (iter (repeat *edge-num*)
			(collect (edge-pair (random-node) (random-node))))))

(defun direct-edges (node edge-list)
  (remove-if-not (lambda (x)
		   (eql (car x) node))
		 edge-list))

(defun get-connected (node edge-list)
  "returns a list of nodes that are all interconnected"
  (let ((visited nil))
    (labels ((traverse (node)
	       (unless (member node visited)
		 (push node visited)
		 (mapc (lambda (edge)
			 (traverse (cdr edge)))
		       (direct-edges node edge-list)))))
      (traverse node))
    visited))

(defun find-islands (nodes edge-list)
  "returns a list of nodes that aren't interconnected"
  (let ((islands nil))
    (labels ((find-island (nodes)
	       (let* ((connected (get-connected (car nodes) edge-list))
		      (unconnected (set-difference nodes connected)))
		 (push connected islands)
		 (when connected
		   (find-island unconnected)))))
      (find-island nodes))
    islands))

(defun connect-with-bridges (islands)
  "conntects all unconnected nodes (islands) with edges (bridges)"
  (when (cdr islands)
    (append (edge-pair (caar islands) (caadr islands))
	    (connect-with-bridges (cdr islands)))))

(defun connect-all-islands (nodes edge-list)
  "connects all the islands to the mainland nodes"
  (append (connect-with-bridges (find-islands nodes edge-list)) edge-list))

(defun edges-to-alist (edge-list)
  "turns a list of edges into an association list"
  (mapcar (lambda (node1)
	    (cons node1
		  (mapcar (lambda (edge)
			    (list (cdr edge)))
			  (remove-duplicates (direct-edges node1 edge-list)
					     :test #'equal))))
	  (remove-duplicates (mapcar #'car edge-list))))

(defun add-cops (edge-alist edges-with-cops)
  (mapcar (lambda (x)
	    (let ((node1 (car x))
		  (node1-edges (cdr x)))
	      (cons node1
		    (mapcar (lambda (edge)
			      (let ((node2 (car edge)))
				(if (intersection (edge-pair node1 node2)
						  edges-with-cops
						  :test #'equal)
				    (list node2 'cops)
				    edge)))
			    node1-edges))))
	  edge-alist))

(defun make-city-edges ()
  "creates a fully graph of nodes and edges to represent the city
Then creates cops to fill the city"
  (let* ((nodes (iter (for i from 1 to *node-num*)
		      (collect i)))
	 (edge-list (connect-all-islands nodes (make-edge-list)))
	 (cops (remove-if-not (lambda (x)
				(zerop (random *cop-odds*)))
			      edge-list)))
    (add-cops (edges-to-alist edge-list) cops)))