#lang scheme

;  ;se repiten ciudades en un individuo?
; 
; (define repetidos?
;   (lambda (x)
;     (if (or
;          (list? (member (car x) (cdr x)))
;          (list? (member (car (cdr x)) (cddr x)))
;          (list? (member (car (cddr x)) (cdddr x)))
;          (list? (member (car (cdddr x)) (cddddr x))))
;          #t
;          #f)))
; 
; 
; ;Funci?n de parada: cuando se han generado las poblaciones deseadas:
; 
; (define acabar?
;   (lambda (generacion)
;     (cond
;       ((= contador generaciones) (newline)
;                    (display (append 
;                               (list mejorind)
;                               (list "A") 
;                               (gen->fen mejorind)
;                               (list ': mejorindkm 'km.))))
;       ((null? generacion)    (begin0
;                                 #f
;                                 (set! contador (+ contador 1)) ) )       
;       ((< (kilometros (individuos->distancias (car generacion))) mejorindkm) 
;                             (set! mejorind (car generacion))
;                             (set! mejorindkm (kilometros (individuos->distancias (car generacion))))
;                             (acabar? (cdr generacion)) )
;       (else (acabar? (cdr generacion)))) ))
; 
; 
; ; El grado de adaptaci?n de un individuo es:
; 
; (define fitness
;   (lambda (cromosoma1 cromosoma2)
;        (<= (kilometros (individuos->distancias cromosoma1))
;            (kilometros (individuos->distancias cromosoma2)) ) ))
; 
; 

(define length-cromosoma 5)
(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)))

(define remove-ref;;general
  (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))))
      ) ))
(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))
             ))
       )
      )
    ))


(define distancia-recorrida
  (lambda (cromosoma)
    (let ((distancia-entre-dos
           (lambda (una dos)
             (let* ((fila (list-ref matriz-ciudades una))
                    (col (list-ref fila dos))
                    )
               col) ))
          )
      (let go ((i 0)
               (j (sub1 (length cromosoma)))
               )
        (if (= i j)
            (distancia-entre-dos
             (list-ref cromosoma i) 0)
            (+
             (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))
          )
      (cond
        ((< cities-rep 0) cities-rep)
        ((>= cities-rep 0) dist)
        (else "error en calculo fitness")) )))

(define es-una-solucion?
  (lambda (crom+fit)
    (let ((cromo (first crom+fit))
          (fitness (second crom+fit)) )
      (if (> fitness 0)
          #t
          #f) )))

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