#lang scheme

;;El problema: El viajante vive en la ciudad "A". Hay que organizarle un recorrido
;;con las dos siguientes restricciones:
;; 1ª ninguna ciudad puede estar repetida
;; 2ª la distancia es la menor posible.

;;Parámetros y funciones específicas del viajante de comercio (tsp)

(provide 
 ;parámetros que son variables
 length-cromosoma 
 length-poblacion
 %pot-repr 
 %mejores-repr
 punto-de-cruce
 prob-mutacion
 solucion1
 solucion2
 ;parámetros que son procedimientos         
 criterio-fitness
 criterio-parada
 haz-gen!
 muta-gen
 
 poblacion-fitness
 )

;;PARAMETROS QUE SON VARIABLES
;;del cromosoma
(define length-cromosoma 5)
;;de la población
(define length-poblacion 120);120 es el número de soluciones
;;porcentaje de la población que se reproduce
(define %pot-repr (/ 2 3))
;;los mejores son un % de %a-cruzar
(define %mejores-repr (/ 3 4));(/ 8 10)
;;punto del cruce de cromosomas
(define punto-de-cruce #f);3;(round (/ length-cromosoma 2)));si #f, al azar.
;;probabilidad de la mutación: 1 por 1000
(define prob-mutacion (cons 50 1000));167 170
;;cuando se conoce la solución, ésta es un cromosoma
(define solucion1 '(206 (3 2 1 4 0)));(cromosoma fitness)
(define solucion2 '(206 (0 4 1 2 3)));(cromosoma fitness)



 ;;dos soluciones óptimas
 ; hay 120 soluciones = factorial 5 (ciudades excepto A)
 ;(#(struct:nodo 293 B (B F C D E A) 5 #t) 206)
 ;(#(struct:nodo 224 E (E D C F B A) 5 #t) 206)
 ;;
 (define matriz-ciudades
   (list
    (list 0 13 33 69 44 68)
    (list 13 0 85 22 60 52)
    (list 33 85 0 9 26 43)
    (list 69 22 9 0 45 82)
    (list 44 60 26 45 0 83)
    (list 68 52 43 82 83 0)))
 

;;procedimiento específico del problema del viajante. Genera al azar un gen
(define haz-gen!
  (lambda ()
    (random length-cromosoma) ))

;;procedimiento de uso general
(define remove-ref
  (lambda (lst x)
    (let go ((i 0)
             (j (length lst))
             )
      (if (= i j)
          '()
          (if (= i x)
              (go (add1 i) j)
              (cons
               (list-ref lst i)
               (go (add1 i) j))))
      ) ))
;;función fitness. Siempre depende del problema a tratar
;; 1ª ninguna ciudad puede estar repetida: devuelve 0 o -N
;; 2ª la distancia: devuelve la distancia
;;idea para calculo de fitness:
;; si 1ª devuelve un número > 0 (no es un recorrido), se apunta dicho valor
;; si 1ª devuelve un número <= 0 (es un recorrido), se apunta la -distancia

(define ciudades-repetidas;subcriterio-1
  (lambda (cromosoma)
    (letrec
        ((subcriterio-1-aux
          (lambda (gen resto-cromosoma)
            (if (member gen resto-cromosoma)
                1
                0)));en lugar de 1
         )
      (/ 
      (apply
       +
       (let go ((i 0)
                (j length-cromosoma)
                )
         (if (= i j)
             '()
             (cons
              (subcriterio-1-aux
               (list-ref cromosoma i)
               (remove-ref cromosoma i))
              (go (add1 i) j))
             ))
       ) length-cromosoma)
      )
    ))


(define distancia-recorrida
  (lambda (cromosoma)
    (let ((distancia-entre-dos
           (lambda (una dos)
             (let* ((fila (list-ref matriz-ciudades (add1 una)))
                    (col (list-ref fila (add1 dos)))
                    )
               col) ))
          )
      (let go ((i 0)
               (j (sub1 (length cromosoma)))
               )
        (if (= i j)
            (+
             (distancia-entre-dos -1 
                                  (list-ref cromosoma 0))
             (distancia-entre-dos
              (list-ref cromosoma i) -1))
            (+
             (distancia-entre-dos 
              (list-ref cromosoma i) (list-ref cromosoma (add1 i)))
             (go (add1 i) j)
             )
            )
        )
      ) ))

(define calculo-fitness
  (lambda (cromosoma)
    (let* ((cities-rep (ciudades-repetidas cromosoma))
           (dist (distancia-recorrida cromosoma))
           (fit (+ dist (* cities-rep dist 85)));(- dist (/ cities-rep 10)))
           )
      fit) ))


;;criterio de parada
(define es-una-solucion?
  (lambda (crom+fit)
    (let ((rept (ciudades-repetidas (second crom+fit))) )
      (if (= rept 0)
          #t
          #f) )))
(define solucion-optima?
  (lambda (crom+fit)
    (or (equal? crom+fit solucion1) (equal? crom+fit solucion2)) ))

(define hay-una-solucion?
  (lambda (pobl)
    (ormap
     (lambda (crom+fit)
       (solucion-optima? crom+fit);(es-una-solucion? crom+fit) 
       )
     pobl) ))

(define criterio-parada hay-una-solucion?)

(define criterio-fitness calculo-fitness)

(define muta-gen haz-gen!)

;;fitness de una poblacion
(define poblacion-fitness
  (lambda (poblacion)
    (exact->inexact
     (/
      (apply +
             (map
              (lambda (cromosoma)
                (if (es-una-solucion? cromosoma)
                    1
                    0))
              poblacion))
      (length poblacion)))
    ))
