mastermind-solver.scm

#lang scheme
(define (sum l) (foldl + 0 l))

(define max 5)

(define sol (solution 4 5))

(define (solution num max)
  (define (sol num max l)
    (cond ((zero? num) l)
          (else (sol (- num 1) max (cons (random max) l)))))  
  (sol num max '()))

;; returns how many blacks
(define (blacks l1 l2)
  (define (my-blacks l1 l2 res)
    (cond ((null? l1) res)
          ((= (car l1) (car l2)) (my-blacks (cdr l1) 
                                            (cdr l2)
                                            (+ res 1)))
          (else (my-blacks (cdr l1) (cdr l2) res))))
    (my-blacks l1 l2 0))

;; counts how many whites should go, 
;; without looking @ positions, so 
;; counting blacks as whites too
(define (whites l1 l2)
  (define (minim x l1 l2)
    (min (length (filter (lambda (y) (= y x)) l1))
         (length (filter (lambda (y) (= y x)) l2))))
  (define (my-whites l1 l2 res)
    (sum (map (lambda (x) (minim x l1 l2))
              (build-list max values))))
  (my-whites l1 l2 0))


(define (check-sols my-sol l2)
  (let* ((black (blacks my-sol l2))
        (white (- (whites my-sol l2) black)))
    (string-append
     (make-string black #\B)
     (make-string white #\W))))

(define (check-real l)
  (check-sols l sol))