3 次代碼提交 0b5b817177 ... 5b88100bc8

作者 SHA1 備註 提交日期
  Peter Lane 5b88100bc8 fixed error in read-trace function 8 月之前
  Peter Lane 63a51018d6 added header option for :log loggers 8 月之前
  Peter Lane d9b321fda5 added set-initial-population function 8 月之前
共有 6 個文件被更改,包括 34 次插入14 次删除
  1. 2 2
      README.md
  2. 4 0
      src/gems-logger/gems-logger.lisp
  3. 6 5
      src/gpstats/gpstats.lisp
  4. 18 5
      src/mini-gp/src/engine.lisp
  5. 1 0
      src/mini-gp/src/packages.lisp
  6. 3 2
      src/packages.lisp

+ 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
   `ltk-plotchart`.
 
-The project website is https://gems-science.netlify.app 
+The project website is https://gems.codeberg.page 
 
 ## Install and Test
 
@@ -39,7 +39,7 @@ To test the system in a REPL:
 
 ## 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
 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 
                              (name "experiment name")
                              (kind :log)
+                             (header '())
                              (filter #'(lambda (generation-number) 
                                          (declare (ignore generation-number))
                                          t))
@@ -51,6 +52,7 @@
   *** `str` - stream to write report to
   *** `generation-number` - the current generation number
   *** `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 
   select which generations the report is generated for.
   * `if-exists` - parameter passed to `with-open-file` - use `:supersede` to replace
@@ -61,6 +63,8 @@
                        :direction :output 
                        :if-exists if-exists
                        :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
       (format str "---~&name: ~a~&" name)))
   ;; return a log-function

+ 6 - 5
src/gpstats/gpstats.lisp

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

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

@@ -42,12 +42,25 @@
   "Return a random generate tree without being evaluated."
   (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

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

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

+ 3 - 2
src/packages.lisp

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