5.2.4 Repair

The sample gcd program is failing one of the test cases in test.sh, so we know it contains at least one bug. We can use evolutionary search to look for a “repair” for this buggy implementation: a mutant that passes every test case in the script.

As before, we use the test function defined in the Evaluation example to measure the fitness of each program variant. This time, test is used as the fitness test in applying sel:evolve to a sel:*population* initialized with 100 copies of the original program. Variable sel:*target-fitness-p* is set up so that the search will terminate when a member of the population has a fitness value that indicates it is passing all of the tests; sel:evolve’s keyword argument :max-evals ensures that execution will always terminate after at most 100 fitness evaluations.

(defpackage :example
  (:use :gt/full
        :software-evolution-library
        :software-evolution-library/software/asm))
(in-package :example)

(defparameter *orig*
  (from-file (make-instance 'asm)
             (make-pathname :name "gcd"
                            :type "s"
                            :directory (append +software-evolution-library-dir+
                                               (list "test" "etc" "gcd")))))

;;; Run the GCD unit tests on ASM. Return the number of passing tests.
(defun test (asm)
  (ignore-errors
    (with-temporary-file (:pathname bin)
      ;; Build executable
      (phenome asm :bin bin)
      (count-if #'identity
                (loop :for i :below 12 :collect
                   (multiple-value-bind (stdout stderr errno)
                       (shell "~atest/etc/gcd/test.sh ~a ~d"
                              (namestring
                               (make-pathname
                                :directory +software-evolution-library-dir+))
                              bin i)
                     (declare (ignorable stdout stderr))
                     ;; Collect list of T/NIL indicating if the exit code was 0.
                     ;; Tests whose exit code is 0 are considered successful.
                     (zerop errno)))))))

;;; Set the fitness of `*orig*' before creating the *population*.
;;; `evolve' assumes that all variants have an initialized, non-NIL fitness
(setf (fitness *orig*) (test *orig*))

;;; Initialize the population with 100 copies of `*orig*'
(setf *population*
      (loop :for i :below 100 :collect (copy *orig*)))

;;; Ensure the population doesn't grow above 100
(setf *max-population-size* 100)

;;; The target fitness is for a variant to pass all 12 unit tests.
;;; When *target-fitness-p* evaluates to T, evolution will stop.
(let ((*target-fitness-p*
       (lambda (obj)
         (or (= 12 (fitness obj))
             (funcall *fitness-predicate* (fitness obj) 12)))))
  (handler-bind
      ((no-mutation-targets
        (lambda (e)
          (declare (ignorable e))
          (invoke-restart 'try-another-mutation)))
       (mutate
        (lambda (e)
          (declare (ignorable e))
          (invoke-restart 'try-another-mutation))))
    ;; Limit the evolution to stop after 100 fitness evaluations, even if
    ;; `*target-fitness-p*' is not yet satisfied
    (evolve #'test :max-evals 100)))

API components in this example

• Class sel/sw/asm:asm
• Macro sel:evolve
• Methods
  • sel:copy
  • sel:from-file
• Variables
  • sel:*population*
  • sel:*target-fitness-p*
  • sel:*fitness-predicate*

5.2.5 Parallel Repair

Evolution may be parallelized by calling sel:evolve in multiple threads.

For example a parallel version of the previous example would replace,

(let ((*target-fitness-p* [{= 11} #'fitness]))
  (evolve #'test :max-evals 100))
  

with the following.

(require 'bordeaux-threads)
(defvar *num-threads* 64 "Number of available cores.")

;; launch *num-threads* evolution threads
(let ((*target-fitness-p* [{= 11} #'fitness]))
  (let (threads)
      (loop :for n :below *num-threads* :do
             (push (bordeaux-threads:make-thread
                           (lambda () (evolve #'test :max-evals 100))
                                         :name (format nil "opt-~d" n))
                                                      threads))))

;; wait for all threads to return
(mapc #'bordeaux-threads:join-thread threads)