3 Commits 0b5b817177 ... 5b88100bc8

Author SHA1 Message Date
  Peter Lane 5b88100bc8 fixed error in read-trace function 9 months ago
  Peter Lane 63a51018d6 added header option for :log loggers 9 months ago
  Peter Lane d9b321fda5 added set-initial-population function 9 months ago

+ 2 - 2
README.md

@@ -14,7 +14,7 @@ The project code is organised into two packages:
   support for constructing graphical interfaces. It requires `ltk` and
   support for constructing graphical interfaces. It requires `ltk` and
   `ltk-plotchart`.
   `ltk-plotchart`.
 
 
-The project website is https://gems-science.netlify.app 
+The project website is https://gems.codeberg.page 
 
 
 ## Install and Test
 ## Install and Test
 
 
@@ -39,7 +39,7 @@ To test the system in a REPL:
 
 
 ## MIT Licence
 ## MIT Licence
 
 
-Copyright (c) 2019-2023, Peter Lane and Fernand Gobet.
+Copyright (c) 2019-2024, Peter Lane and Fernand Gobet.
 
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
 of this software and associated documentation files (the "Software"), to deal

+ 4 - 0
src/gems-logger/gems-logger.lisp

@@ -37,6 +37,7 @@
 (defun make-logger (filename &key 
 (defun make-logger (filename &key 
                              (name "experiment name")
                              (name "experiment name")
                              (kind :log)
                              (kind :log)
+                             (header '())
                              (filter #'(lambda (generation-number) 
                              (filter #'(lambda (generation-number) 
                                          (declare (ignore generation-number))
                                          (declare (ignore generation-number))
                                          t))
                                          t))
@@ -51,6 +52,7 @@
   *** `str` - stream to write report to
   *** `str` - stream to write report to
   *** `generation-number` - the current generation number
   *** `generation-number` - the current generation number
   *** `population` - an array of individuals in current population
   *** `population` - an array of individuals in current population
+  * `header` - a list of column headings for a :log style of output
   * `filter` - function returns t/nil for a generation number, used to 
   * `filter` - function returns t/nil for a generation number, used to 
   select which generations the report is generated for.
   select which generations the report is generated for.
   * `if-exists` - parameter passed to `with-open-file` - use `:supersede` to replace
   * `if-exists` - parameter passed to `with-open-file` - use `:supersede` to replace
@@ -61,6 +63,8 @@
                        :direction :output 
                        :direction :output 
                        :if-exists if-exists
                        :if-exists if-exists
                        :if-does-not-exist :create)
                        :if-does-not-exist :create)
+    (when (and (eq kind :log) (not (null header))) ; put header on log file
+      (format str "~{~a~^, ~}~&" header))
     (when (eq kind :trace) ; put header on yml trace
     (when (eq kind :trace) ; put header on yml trace
       (format str "---~&name: ~a~&" name)))
       (format str "---~&name: ~a~&" name)))
   ;; return a log-function
   ;; return a log-function

+ 6 - 5
src/gpstats/gpstats.lisp

@@ -168,17 +168,18 @@
              (setf fitness (object-from-line line)))
              (setf fitness (object-from-line line)))
            (when (search "extras" line)   ; and then extras
            (when (search "extras" line)   ; and then extras
              (setf extras-line line
              (setf extras-line line
-                   state :collect-fitness)))
-          (:collect-fitness
+                   state :collect-extras)))
+          (:collect-extras
             (if (search "program:" line)
             (if (search "program:" line)
               (setf extras (object-from-line extras-line)
               (setf extras (object-from-line extras-line)
                     program ""
                     program ""
-                    state :program)
+                    state :collect-program)
               (setf extras-line (uiop:strcat extras-line line))))
               (setf extras-line (uiop:strcat extras-line line))))
           (:program
           (:program
            ; search for start of program
            ; search for start of program
            (when (search "program:" line)
            (when (search "program:" line)
-             (setf state :collect-program)))
+             (setf program ""
+                   state :collect-program)))
           (:collect-program
           (:collect-program
            (cond ((search "fitness" line)
            (cond ((search "fitness" line)
                   (push (gp:make-individual :fitness fitness 
                   (push (gp:make-individual :fitness fitness 
@@ -187,7 +188,7 @@
                         generation)
                         generation)
                   (setf fitness (object-from-line line)
                   (setf fitness (object-from-line line)
                         program ""
                         program ""
-                        state :program))
+                        state :individual))
                  ((search "---" line)
                  ((search "---" line)
                   (push (gp:make-individual :fitness fitness 
                   (push (gp:make-individual :fitness fitness 
                                             :extras extras
                                             :extras extras

+ 18 - 5
src/mini-gp/src/engine.lisp

@@ -42,12 +42,25 @@
   "Return a random generate tree without being evaluated."
   "Return a random generate tree without being evaluated."
   (make-individual :tree (ramped-half-and-half tree-limit fset tset)))
   (make-individual :tree (ramped-half-and-half tree-limit fset tset)))
 
 
-(defun make-population (size tree-limit fset tset)
-  "Return an array filled with random gp individuals."
-  (make-array size 
-	      :initial-contents (loop repeat size 
-				      collect (make-random-individual tree-limit fset tset))))
+(defparameter *initial-population* '())
+
+(defun set-initial-population (individuals)
+  "Sets the initial gp population to given list of individuals."
+  (when (listp individuals)
+    (setf *initial-population*
+          (remove-if-not #'individual-p individuals))))
 
 
+(defun make-population (size tree-limit fset tset)
+  "Return an array filled with gp individuals - using *initial-population* and 
+  filling remaining positions with random gp individuals."
+  (make-array 
+    size 
+    :initial-contents 
+    (if (< (length *initial-population*) size)
+      (append *initial-population*
+              (loop repeat (- size (length *initial-population*))
+                    collect (make-random-individual tree-limit fset tset)))
+      (subseq *initial-population* 0 size))))
 
 
 ;;;
 ;;;
 ;;; evaluation
 ;;; evaluation

+ 1 - 0
src/mini-gp/src/packages.lisp

@@ -28,6 +28,7 @@
            individual-tree
            individual-tree
            individual-fitness
            individual-fitness
            individual-extras
            individual-extras
+           set-initial-population
            ))
            ))
 
 
 ;; PCL commented out all remaining exports 
 ;; PCL commented out all remaining exports 

+ 3 - 2
src/packages.lisp

@@ -34,6 +34,7 @@
     individual-tree
     individual-tree
     individual-fitness
     individual-fitness
     individual-extras
     individual-extras
+    set-initial-population
     ; from SYNTAX-TREE
     ; from SYNTAX-TREE
     :node 
     :node 
     :node-p 
     :node-p 
@@ -55,7 +56,7 @@
     consisting of functions to help construct task and model definitions, create 
     consisting of functions to help construct task and model definitions, create 
     models using genetic programming, and analyse the resulting models.
     models using genetic programming, and analyse the resulting models.
 
 
-    documentation:: https://gems-science.netlify.app/software"))
+    documentation:: https://gems.codeberg.page/software"))
 
 
 (defpackage :gems/tk
 (defpackage :gems/tk
   (:use :cl)
   (:use :cl)
@@ -67,5 +68,5 @@
 
 
     Includes `GEMS` and support for gui programming through Tk.
     Includes `GEMS` and support for gui programming through Tk.
 
 
-    documentation:: https://gems-science.netlify.app/software"))
+    documentation:: https://gems.codeberg.page/software"))