#lang racket

(require (only-in "parametros-Red_8.rkt" length-poblacion %mejores-repr))

;;Módulo SELECCION PROGENITORES
;;el método de la ruleta de Goldberg
;;genera una tira de números dado el primero y la cantidad de números
(define tira-numeros
  (lambda (prim cant)
    (let go ((i 0)
             (j cant)
             )
      (if (= i j)
          '()
          (cons
           (+ prim i)
           (go (add1 i) j))
          ))
    ))

;;como distintos individuos pueden tener igual fit, a cada uno le corresponderá
;;una tira de igual longitud pero con números distintos.
;;formamos grupos con los individuos de igual fit
(define da-tiras-cada-individuo
  (lambda (reverse-poblacion fit-primero base cant)
    (if (null? reverse-poblacion)
        '()
        (if (equal? (car (car reverse-poblacion)) fit-primero)
            (cons
             (cons (tira-numeros base cant) (car reverse-poblacion))
             (da-tiras-cada-individuo 
              (cdr reverse-poblacion) fit-primero (+ base cant) cant))
            (da-tiras-cada-individuo 
             reverse-poblacion (car(car reverse-poblacion)) base (add1 cant))
            )) ))

(define metodo-goldberg-ruleta
  (lambda (pob)
    (let* ((pobl (da-tiras-cada-individuo (reverse pob) (car(last pob)) 0 1))
           (nmax (last(car(last pobl))))
           )
      (let go
        ((i 0)
         (j (length pob))
         (num (random nmax))
         )
        (if (= i j)
            '()
            (append
             (remove 
              (void)
              (remove-duplicates
               (map
                (lambda (x)
                  (if (member num (car x))
                      (cdr x)
                      (void)))
                pobl)))
             (go (add1 i) j (random nmax)))
            ))
      ) ))

;; método de torneo
;;define z-torneo 2)
(define num-z
  (lambda (length-subp)
    (if (even? length-subp)
        2
        (cond
          ((zero? (remainder length-subp 3)) 3)
          ((zero? (remainder length-subp 5)) 5)
          (else 1))) ))
(define los-z
  (lambda (z pob)
    (if (zero? z)
        '()
        (let ((item (list-ref pob (random (length pob)))))
          (cons
           item
           (los-z (sub1 z) (remove item pob)))
          )) ))

(define el-mejor-de-los-z
  (lambda (sal-los-z)
    (car (sort sal-los-z #:key car >)) ));puede ser > ó <, según el problema

(define metodo-torneo
  (lambda (subpobl)
    (let go ((i 0)
             (j (length subpobl))
             (z (num-z (length subpobl)))
             )
      (if (= i j)
          '()
          (cons
           (el-mejor-de-los-z
            (los-z z subpobl))
           (go (add1 i) j z))
          )
      ) ))

;; metodo-sorteo
;;el número de orden en la lista es el identificador
(define num-premiados
  (lambda (bombo);(build-list (length subpobl) values)
    (if (= (length bombo) 0)
        '()
        (let ((num (random (length bombo))) )
          (cons
           (list-ref bombo num)
           (num-premiados (remove (list-ref bombo num) bombo))
           ))
        ) ))
(define acertantes
  (lambda (subpob lst-premios)
    (if (null? lst-premios)
        '()
        (cons
         (list-ref subpob (car lst-premios))
         (acertantes subpob (cdr lst-premios)))
        ) ))
;;
(define metodo-sorteo
  (lambda (subpobl); (fit (cromosoma))
    (let ((premios (num-premiados (build-list (length subpobl) values)))
          )
      (acertantes subpobl premios)
      ) ))

(provide
 metodo-sorteo
 metodo-torneo
 metodo-goldberg-ruleta
 )

