Racket/Genetic

#lang racket

;;;;;
;; Genetisk algoritm implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;


;; ================================================================
;; Genetisk algoritm – Hitta kromosom med:
;;   1. De första 10 bitarna = 1
;;   2. Totalt antal 1:or så nära 50 som möjligt
;; ================================================================

;; --------------------- Parametrar ---------------------
(define population-size 100)
(define chromosome-length 200)
(define generations 5000)
(define mutation-rate 0.01)

;; --------------------- Hjälpfunktioner ---------------------

;; Skapar en slumpmässig kromosom (lista med 0 och 1)
(define (random-chromosome)
  (for/list ([_ (in-range chromosome-length)])
    (random 2)))

;; Fitness-funktion
;;   - 1000 poäng om de första 6 bitarna är alla 1:or
;;   - upp till 1000 poäng om antalet 1:or är exakt 50
(define (fitness chrom)
  (define prefix-5 (take chrom 5))
  (define num-ones  (apply + chrom))

  (define prefix-bonus (if (andmap (λ (x) (= x 1)) prefix-5) 1000 0))
  (define distance     (abs (- num-ones 50)))

  (+ prefix-bonus (- 1000 distance)))

;; Tournament selection (storlek 5)
(define (select-parent population)
  (define tournament-size 5)
  (argmax fitness
          (for/list ([_ (in-range tournament-size)])
            (list-ref population (random (length population))))))

;; Single-point crossover
(define (crossover parent1 parent2)
  (define point (add1 (random (sub1 chromosome-length))))
  (append (take parent1 point)
          (drop parent2 point)))

;; Mutation
(define (mutate chrom)
  (for/list ([gene chrom])
    (if (< (random) mutation-rate)
        (- 1 gene)
        gene)))

;; Skapar nästa generation (utan elitism ännu)
(define (next-generation population)
  (for/list ([_ (in-range population-size)])
    (define p1 (select-parent population))
    (define p2 (select-parent population))
    (mutate (crossover p1 p2))))

;; --------------------- Huvudalgoritm ---------------------

(define (genetic-algorithm)
  (printf "Startar genetisk algoritm...\n")
  (printf "Mål: Första 5 bitar = 1 och totalt ~a ettor\n\n" 50)

  (define initial-population
    (for/list ([_ (in-range population-size)])
      (random-chromosome)))

  (define (evolve population generation)
    (define best (argmax fitness population))
    (define best-fitness (fitness best))
    (define num-ones     (apply + best))
    (define prefix-ok?   (andmap (λ (x) (= x 1)) (take best 5)))

    (printf "Gen ~a | Fitness: ~a | Ettor: ~a | Prefix OK: ~a\n"
            (~a generation #:width 4 #:align 'right)
            best-fitness
            num-ones
            (if prefix-ok? "Ja" "Nej"))

    (cond
      [(= best-fitness 2000)
       (printf "\n=== PERFEKT LÖSNING HITTAD! ===\n")
       (printf "Generation: ~a\n" generation)
       (printf "Kromosom:   ~a\n" best)
       (printf "Antal ettor: ~a\n" num-ones)]

      [(>= generation generations)
       (printf "\n=== Max generationer nådda ===\n")
       (printf "Bästa lösning:\n")
       (printf "  Fitness:     ~a\n" best-fitness)
       (printf "  Antal ettor: ~a\n" num-ones)
       (printf "  Första 10:   ~a\n" (take best 10))]

      [else
       (evolve (next-generation population) (add1 generation))]))

  (evolve initial-population 0))

;; --------------------- Kör programmet ---------------------
(genetic-algorithm)