Inheritance of features is now working

This commit is contained in:
Simon Brooke 2024-05-02 16:58:51 +01:00
parent 41bfb23a2d
commit ba9ecd91a2
6 changed files with 149 additions and 33 deletions

2
.gitignore vendored
View file

@ -15,3 +15,5 @@ pom.xml.asc
/.calva/
.hgignore
.hg/
*.so

View file

@ -5,10 +5,12 @@
:url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
:dependencies [[cnuernber/libpython-clj "1.33"]
[com.taoensso/telemere "1.0.0-beta3"] ;; Peter Taoussanis' new replacement for Timbre
[jme-clj "0.1.13"]
[org.clojure/clojure "1.11.1"]
[org.clojure/tools.cli "1.1.230"]
[org.jmonkeyengine/jme3-core "3.6.1-stable"]
[cnuernber/libpython-clj "1.36"]]
:main ^:skip-aot cc.journeyman.simulated-genetics.core
:main ^:skip-aot cc.journeyman.simulated-genetics.launcher
:target-path "target/%s"
:profiles {:uberjar {:aot :all
:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}})

View file

@ -1,7 +0,0 @@
(ns cc.journeyman.simulated-genetics.core
(:gen-class))
(defn -main
"I don't do a whole lot ... yet."
[& args]
(println "Hello, World!"))

View file

@ -27,11 +27,18 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def genome-mask
"A mask which selects just the bits we're interested in from a long."
(long (dec (pow 2 bits-in-genome))))
(def gender-bit
"The bit that encodes for gender"
25)
(defmacro rand-genome
"Create a random genome."
[]
`(long (rand (dec (pow 2 bits-in-genome))))) ;;Long/MAX_VALUE))) ;;
`(long (rand (dec (pow 2 bits-in-genome)))))
(defn create-genome
"Create a new genome; if `father` and `mother` are passed, the result will
@ -44,35 +51,47 @@
(Long/toBinaryString father)
(Long/toBinaryString mother)
(Long/toBinaryString mask)))
(bit-or (bit-and father mask) (bit-and (bit-not mother) mask)))))
;; TODO: cycling through a string is inefficient
(long-from-binary-string
(apply str
(map #(if (bit-test (if (bit-test mask %) mother father) %) "1" "0")
(reverse (range bits-in-genome))))))))
(defn extract-bits
"Extract, as an integer left-shifted by `start`, those bits from `g` indexed
from `start` (inclusive) to `end` (exclusive)."
[^Long g ^Long start ^Long end]
(let [mask (trace! (create-mask start end))]
(bit-shift-right (bit-and g mask) (- bits-in-genome end))))
(long (bit-shift-right (bit-and g mask) (- bits-in-genome end)))))
(defmacro ethnically-biased-feature-index
"Some feature values are associated with particular ethnicities."
[genome start end]
`(+ (extract-bits ~genome ~start ~end)
(if (bit-test ~genome 3)
(int (pow (- ~end ~start) 2))
0)))
(defn male?
"`true` if this genome is male."
[genome]
(bit-test genome gender-bit))
(defn expand-genome
[^Long genome]
{:ethnic-type (extract-bits genome 0 4)
:skin-tone (+ (extract-bits genome 4 7) (if (bit-test genome 3) 4 0) 2)
:freckles? (= (extract-bits genome 8 10) 3)
:hair-colour (nth [:blonde :red :russet :cognac :chestnut :coffee :dark-brown :black]
(ethnically-biased-feature-index genome 11 13))
:eye-colour (nth [:blue :hazel :russet :cognac :chestnut :coffee :dark-brown :black]
(ethnically-biased-feature-index genome 14 16))
:height (+ 150 (* (extract-bits genome 17 20) 6))
:robustness (extract-bits genome 21 23)
:aging (extract-bits genome 24 27)
:gender (if (bit-test genome 27) :male :female)
;; face stuff
})
[^Long genome]
(let [skin-tone (ethnically-biased-feature-index genome 4 8)]
{:ethnic-type (extract-bits genome 0 4)
:skin-tone (ethnically-biased-feature-index genome 4 8)
:freckles? (= skin-tone 1)
:hair-colour (nth [:blonde :red :russet :cognac :chestnut
:coffee :dark-brown :black]
(ethnically-biased-feature-index genome 9 11))
:eye-colour (nth [:blue :hazel :russet :cognac :chestnut
:coffee :dark-brown :black]
(ethnically-biased-feature-index genome 12 14))
:height (+ 150 (* (extract-bits genome 15 18) (if (male? genome) 6 4))) ;; men are taller
:robustness (extract-bits genome 19 21)
:aging (extract-bits genome 22 25)
:gender (if (male? genome) :male :female)
;; TODO: face stuff
}))

View file

@ -0,0 +1,90 @@
(ns cc.journeyman.simulated-genetics.launcher
(:require [clojure.tools.cli :refer [parse-opts]]
[jme-clj.core :refer [add-control add-to-root app-settings cam
defsimpleapp fly-cam get-height-map image
image-based-height-map load-height-map
load-texture material set* start
terrain-lod-control terrain-quad]]
[taoensso.telemere :refer [set-min-level! trace!]])
(:import (com.jme3.texture Texture$WrapMode))
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Launcher: parses any command line options, and launches the test app.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2024 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare app)
(def cli-options
"I haven't yet thought out what command line arguments (if any) I need.
This is a placeholder."
[["-v" nil "Verbosity level"
:id :verbosity
:default 0
:update-fn inc]
["-h" "--help"]])
(defn init
"Again, placeholder. This initialises a bit of standard jMonkeyEngine
terrain, just to check I have things wired up correctly."
[]
(set* (fly-cam) :move-speed 50)
(let [grass (set* (load-texture "jme3/textures/terrain/splat/grass.jpg")
:wrap Texture$WrapMode/Repeat)
dirt (set* (load-texture "jme3/textures/terrain/splat/dirt.jpg")
:wrap Texture$WrapMode/Repeat)
rock (set* (load-texture "jme3/textures/terrain/splat/road.jpg")
:wrap Texture$WrapMode/Repeat)
mat (material "Common/MatDefs/Terrain/Terrain.j3md")
height-map-tex (load-texture
"jme3/textures/terrain/splat/mountains512.png")
height-map (->> height-map-tex image image-based-height-map
load-height-map)
patch-size 65
terrain (terrain-quad "my terrain" patch-size 513
(get-height-map height-map))]
(-> mat
(set* :texture "Alpha"
(load-texture "jme3/textures/terrain/splat/alphamap.png"))
(set* :texture "Tex1" grass)
(set* :float "Tex1Scale" (float 64))
(set* :texture "Tex2" dirt)
(set* :float "Tex2Scale" (float 32))
(set* :texture "Tex3" rock)
(set* :float "Tex3Scale" (float 128)))
(-> terrain
(set* :material mat)
(set* :local-translation 0 -100 0)
(set* :local-scale 2 1 2)
(add-to-root)
(add-control (terrain-lod-control terrain (cam))))))
(defsimpleapp app :init init)
(defn -main
"Start an app into which generated characters can ultimately be rendered."
[& args]
(let [options (parse-opts args cli-options)]
(set-min-level!
(nth [:error :warn :debug :trace] (:verbosity (:options options)))))
(trace! (start app)))

View file

@ -0,0 +1,10 @@
(ns simulated-genetics.core-test
(:require [clojure.test :refer :all]
[cc.journeyman.simulated-genetics.genome :refer :all]))
(deftest clone-test
(testing "All bits should come from one or other parent. If parent genomes
are identical, the offspring is a clone."
(let [g (rand-genome)
c (create-genome g g)]
(is (= c g)))))