;;;; Spring 2001: CS580-002 Assignment #4
;;;; 
;;;; The colored parts represent minimal patches on the original source
;;;; that solve the required parts:
;;;; 1) MAGENTA (initialize *node_cnt*, increment *node_cnt*, print *node_cnt*)
;;;; 2) RED (additional optional argument to permute, incremental update of optimal cost,
;;;;         closing link cost update, modified recursive call to permute, prunning)
;;;; SILVER is used for denoting code that was commented out
;;;; NAVY is used for comments

;;;;  Helpful extensions for creating the contingency tables. 
;;;; [DHTML works with the recent Internet Explorer versions.].

;;;; GREEN is used for helpful extensions for creating the contingency table but not asked 
;;;;       for in the homework (define *MODE-LIST*, additional optional argument to skel1, 
;;;;       initialize *mode*, use prunning method corresponding to *mode*, print *mode*, run in all modes)


; function to provide inut-output - reads the file
; data from the fine cities.dat
; global variables are start with *
; function tsp takes as an argument the list and solves the TSP problem


;; initialize *mode*
(setq *MODE-LIST* '(heuristical-prunning non-heuristical-prunning no-prunning))

;; run in all modes
(defun run-all ()
  (dolist (mode *MODE-LIST*)
    (skel1 mode)
    )
  )


(defun skel1 (&optional mode) ; additional optional argument to skel1
  
  (setq *mode* (if (member mode *MODE-LIST*) mode    ; initialize *mode*
                   'heuristical-prunning
                   )
        )
  (let (data_file sym_list)
    (setq data_file  (open "cities.dat" :direction :input))
    (setq *print_max* 30)
    
    (loop  
       (if (null (setq sym_list  (read data_file nil nil ))) (return))
       (solve_tsp sym_list)
    )
    (close data_file)
    '****Finished****
  )
)


; Here is a dummy version of tsp fuction which you will be required 
; to modify

(defun solve_tsp (sym_list)
  (setq *city_max* (length sym_list))

  (format t "~%Generating tours for following ~D cities:  ~%"  *city_max*)

  (dolist (item sym_list)
    (format t " ~A~%" item)
    )

  (setq *tour_cnt* 0)
  (setq *node_cnt* 0) ; initialize *node_cnt*

  (let ((min (permute (rest sym_list) (list (first sym_list))))
     )
     (format t "~%Optimal cost: ~A~%Optimal tour~p:" (first min) (length (rest min)))

     (dolist (tour (rest min))
        (format t "~%~A" (embellish-tour tour))
        )
     )

  (format t "~%~% Mode: ~A" *mode*) ; print *mode*
  (format t "~% Node count: ~D" *node_cnt*) ; print *node_cnt*
  (format t "~% Tour count: ~D~%~%" *tour_cnt*)
)

; Function permute is invoked with two arguments 
; unused symbols and partial permutation (which is at the beginning null)
; the unused symbols are added to the front of the partial permutation list
; creating a child node, and permute is called recursively do generate 
; the grand children etc.

(defun embellish-tour (tour)
   (reverse (mapcar #'first tour))
   )

(defun distance (place1 place2)
   (let  ((x1 (second place1))
            (y1 (third place1))
            (x2 (second place2))
            (y2 (third place2))
            )
       (let ((dx (- x1 x2))
               (dy (- y1 y2))
               )
            (sqrt (+ (* dx dx) (* dy dy)))
            )
        )
   )

;;; (defun tour-cost (tour)
;;;   (apply #'+ (mapcar #'distance tour (append (last tour) tour)))
;;;   )


                                                ; add optional argument to permute
(defun permute (unused perm &optional (min (cons 0 '())) (cost 0))
 (let ()
   (incf *node_cnt*) ; increment *node_cnt*
   (cond 
         ((null unused)
              (let ((cost (+ cost (distance (first perm) (first (last perm)))))
                  ; (cost (tour-cost perm)) ; closing link cost update
                    )
                 (cond ((or (null (rest min))     ; no tour yet
                            (< cost (first min))) ; better tour
                          (setf (first min) cost)
                          (setf (rest min) (list perm))
                          )
                       ((< cost (+ (first min) 0.000001)) ; equally good tour
                          (setf (rest min) (cons perm (rest min)))
                          )
                       )
                 )
              (cond 
                   ((< *tour_cnt*  *print_max*) 
                     (print (embellish-tour perm) )
                     )
                   ((= *tour_cnt*  *print_max*) 
                     (format t "~%      supressing printing ...")
                     )
                   )
          (setq *tour_cnt*  (+ *tour_cnt* 1))
          )
       (t (dolist (item unused)
             (let* ((newCost (+ cost (distance item (first perm)))) ; incremental update of optimal cost
                    )
               
               (when (or (null (rest min))
                         (<= (case *mode* ; use prunning method corresponding to *mode*
                                                                   ; prunning w/ an admissible heuristic
                                 (heuristical-prunning (+ newCost (distance item (first (last perm)))))
                                 (non-heuristical-prunning newCost) ; prunning w/o heuristic
                                 (no-prunning 0)                    ; no prunning at all
                                 )
                                 (first min))) ; prunning

                 (permute (remove item unused) (cons item perm) min newCost)
                                                ; modified recursive call to permute
                 )
               )
             ))
   )
  )
 min
)