Bulls and Cows + Solver

Random Guesses

(defparameter *max-guesses* 100000)

(defun run-random-solver ()
  (let ((count 0)
        (code (generate-secret *code-digits* *code-length*))
        (solution-found nil))
    (loop
     (cond ((>= count *max-guesses*) (return))
           ((win-p (guess-code code))
            (setf solution-found t)
            (return))
           (t  (setf count (1+ count))
               (setf code (generate-secret *code-digits* *code-length*)))))
    (when solution-found
      (list code count)))))

Brute Force

• Next Permutation
  
  • In order to achieve this we need a function to calculate the next permutation from a given one
  • The first permutation should be 1234 the last permutation should be 9876
  • The key to this algorithm is a predicate that verifies if a number is a valid permutation
  • If that predicate fails just increment the number and try again
  • This removes one instance of the value being checked and then ensures that there is not another instance of it in the list

  (defun valid-code-p (num)
    (let* ((code (map 'list #'digit-char-p
                      (write-to-string num)))
           (no-repeats (every #'identity
                              (mapcar #'(lambda (m)
                                          (not (member m
                                                       (remove-if #'(lambda (n) (= n m))
                                                                  code :count 1))))
                                      code)))
  
           (no-illegal-chars (every #'(lambda (n)
                                        (member n *code-digits*))
                                    code)))
      (and no-repeats no-illegal-chars)))
  

  • This function finds the next lexical code from a given input
  • It continuously increments the number until a valid code is found

  (defun next-code (num)
    (cond ((valid-code-p (1+ num)) (1+ num))
          (t (next-code (1+ num)))))
  
  

• Solver
  

  (defun run-brute-force-solver ()
    (let ((code *code-min*)
          (count 0))
      (loop
        (cond ((win-p (guess code)) (return))
              ((= code *code-max*) (return))
              (t (setf code (next-code code))
                 (setf count (1+ count)))))
      (list code count)))
  
  

Cows Score Solver

• Sub List
  
  • In order to rule out digits we need a way to get a consecutive sublist of digits
  • This function will get a consecutive list of count number items from a list
  • If the start index + count is greater than the length of the list it will wrap around to the beginning

  (defun sublist (start count list)
    (let ((i 1)
          (s (list (nth start list))))
      (loop
        (when (>= i count)
          (return))
        (push (nth (mod (+ start i) (length list)) list)
              (cdr (last s)))
        (setf i (1+ i)))
      s))
  

• Shuffle List
  
  • In order to shuffle a list we rotate it n times, where n is the length of the list
  • Each shuffle will randomly select two digits and swap them

  (defun shuffle-list (list)
    (let ((i 0))
      (loop
        (when (>= i (length list))
          (return))
        (rotatef (nth (random (length list)) list)
                 (nth (random (length list)) list))
        (setf i (1+ i)))
      list))
  

• Score Total
  
  • This function sums the numerical portion of the bulls and cows score
  • For example (1 B 2 C) would total to 3
  • This is useful for determining if none of the digits tested are in the solution

  (defun score-total (score)
    (+ (car score) (caddr score)))
  

• Find sublist with score total
  
  • This function will use consecutive sublists looking for a set that has a given score total
  • It will generate a sublist starting at each index in the list
  • If no item is found it will shuffle the list and try again
  • This function tracks how many times it calls guess-code
  • Once the set is found it returns a list of both the set and the guess count

  (defun find-set-with-score (search-set wanted-score)
    (let* ((list (copy-list search-set))
           (count 1)
           (g (sublist 0 *code-length* list))
           (score (score-total (guess-code g))))
      (loop
        (when (= score wanted-score)
          (return))
        (let ((i 0))
          (loop
            (when (= score wanted-score)
              (return))
            (setf i (1+ i))
            (when (>= i (length list))
              (return))
            (setf g (sublist i *code-length* list))
            (setf count (1+ count))
            (setf score (score-total (guess-code g)))))
        (shuffle-list list))
      (list g count)))
  

• Solver
  

  (defun run-cows-solver ()
    (let ((digits (copy-list *code-digits*))
          (count 0)
          (not-code-set nil)
          (code-set nil)
          (results nil)
          (score nil))
      (setf results (find-set-with-score digits 0))
      (setf not-code-set (car results))
      (setf count (+ count (cadr results)))
      (remove-if #'(lambda (n)
                     (member n not-code-set))
                 digits)
      (setf results (find-set-with-score digits *code-length*))
      (setf code-set (car results))
      (setf count (+ count (cadr results)))
      (loop
        (setf score (guess-code code-set))
        (setf count (1+ count))
        (when (win-p score)
          (return))
        (shuffle-list code-set))
      (list code-set count)))