Evolution-of-Movement_5


Information

Created with NetLogo version NetLogo 4.0.4
Running with NetLogoLite.jar version 404.


WHAT IS IT?


Model to allow user to explore "natural selection" and "selective breeding" as a method of progressive change in organisms.
* this model is incomplete *

HOW TO USE IT


Select a creature, then click ACTION:MUTATE-SELECTED to kill all other creatures and mutate more versions of this one (the original version is also included). You can use this to encourage development of creatures that move the way you want them to.
To start a fitness footrace, click ACTION:FootRace.
In a footrace, the first creature to touch either vertical edge is mutated. It and it's "offspring" continue the race.
To start a "mana" race, click ACTION:ManaRace
A MANA-RACE causes food to float across the world. Creatures gain points (eat?) by touching the food with the tips of their feet. The creature with the highest score when all the food is gone is mutated.
FOOT RACE and MANA-RACE can be active at the same time...

INTERESTING FEATURES


Demo of Skeletal scruture framework for walking models
this demo began as a framework for generating random n-legged m-jointed creatures.
The demo applies a very minimal and rather incorrect physics engine ("friction" "gravity", but no inertia, or angular momentum, no acceleration) to allow movement along a virtual "floor" due to friction with the limbs and the floor.
NOTES / TODO
DONE * fix evolution code
DONE * fix minimal physics

  • virtualize as much of the location and heading changes to that intermediate positions are not shown (ie, don't look like they "bounce" or "fall through floor"

  • more commenting!

  • seperate bits of demo code from framework guts

  • seperate structural and visual code

  • implement full-blown skeleton api, i.e. feed the "new-body" reporter a list that defines the structure of the desired skeleton:
  • |;; skeleton data structure
    [ ;; limbs list

    [ ;; limb1

    x-offset y-offset center-angle

    ;; bone data (last record of limb data)

    [ ;; bone 1

    [ length-1 center-1 sweep-1 phase-1 freq-1 ]

    ;; bone 2

    [ length-2 ... ]

    ]

    ]

    [ ;; limb 2 ...

    ]

    ]
    FEATURE TO DO:
    DONE * mode where user selects walker to "keep", kept walkers are "evolved"

  • mode where walkers that make best horizontal progress are selected to evolve / replace least mobile walkers?
  • DONE * need select code
    DONE * need evolve code
    DONE * user interface design?
    DONE * optimum number of walkers?
    DONE * what parameters to evolve?
    * angle of limb on body
    * center-angle
    * sweep
    * phase
    * length
    * stickyness of joint
    * number of bones/joints
    * number of limbs (tripods, quadripeds, etc))
    * location of limbs (eg thing like horse, thing like person, thing like octopus)

    FITNESS


    * what denotes FITNESS?

    * speed of travel

    * efficiency ( max distance for min total angle changes )

    * gracefullness ( ?? )

    DESIGN AND PROGRAMMING


    James P. Steiner

    Procedures

    NetLogo Version: NetLogo 4.0.4

    globals
    [ highlighted ;; the body highlighted by the mouse
      selected ;; the body selected by the mouse
      friction ;; stickyness of the ground with the part of the limb touching it
      click!
      population
      greeting?
      selected-halo
      old-shape
      frame-slice
      t
      
      full-time-mouse?
      foot-race?
      mana-race?
      generations
      consecutive-wins
      move?
      ;freq
    ]
    
    patches-own [ tcolor mana?]
    
    breed [ empty-set empty-turtle ] ;; a breed used only to create an empty agent set when needed (like nobody, which is a single turtle, but a set)
    breed [ halos halo ] ;; turtle used to hightlight the selected turtle
    breed [ limbs limb ] ;; a limb is made of bones
    breed [ bones bone ] ;; bones (and implied muscles) move to create locomotion
    breed [ bodies body ] ;; a body hsa limbs
    breed [ mana manum ] ;; food that falls across the world
    
         ;;;;; PRE 3.1BETA1 VERSION
         ;;;;;  breed [ empty-set ]
         ;;;;;  breed [ bones ]
         ;;;;;  breed [ limbs ]
         ;;;;;  breed [ bodies ]
    
    
    turtles-own
    [
      ox oy ;; old x and y (ie the prior position)
      xx yy ;; shadow x and y
      nx ny ;; new x and y
      cx cy ;; change-in x and y (ie delta x, y) (ie, change from previous position)
      vx vy ;; velocity x and y (ie the intertia)
      oh hh nh ch vh ;; old and new headings
    ]
     
    bodies-own 
    [ ;; everything that turtles-own, plu...
      my-body ;; = this body  
      my-limbs ;; agentset of the limbs that belong to this body
      my-bones ;; agentset of all bones that belong to this body
    
      my-sorted-limbs ;; list of the limbs, sorted by who number
      my-sorted-bones ;; list of the bones. sorted by who nunber
    
      phase
      
      floor-y
      base-color
      
      score
    ]
    
    limbs-own
    [ ;; limbs define the attachment point of a limb to a body
      ;; limbs group bones
      my-body  ;; body this limb belongs to
      my-limb  ;; this limb (self-referential property, inherited by bones )
      my-bones ;; agentset
      my-sorted-bones ;; list
      parent ;; my-body
      child ;; fist bone of this limb 
      
      phase ;; phase of the limb relative to the body phase (ie 0)
            ;; some gaits are in-phase (hopping) some are slightly out of phase (canter) some are opposite phase (walking)
      
    ]
    
    
    bones-own 
    [ my-body
      my-limb ;; limb that this bone is a part of 
      my-bones ;; all bones below this bone
      parent ;; bone that this bone connect to that is closer to the body (for first bone, parent = my-limb)
      child ;; bone that this bone connects to that is farther from the body (closer to the free end)
    
      center ;; center of the range of motion of this bone
      sweep ;; range of motion of this bone +/- from center
      phase ;; the relationship to the angle of the higher-up bone, in degrees
            ;; (if all bones phase = 0, bones are in synch
            ;; (if all bones are phase = 180, bones swing in opposite directions)
      
    ]
    
    ;;   ##### ###### ###### ##  ## #####     ####       #####  ####                          
    ;;  ##     ##       ##   ##  ## ##  ##   ##  ##     ##     ##  ##                                
    ;;   ####  ###      ##   ##  ## #####     #### ##   ## ### ##  ##                                        
    ;;      ## ##       ##   ##  ## ##       ##  ##     ##  ## ##  ##                          
    ;;  #####  ######   ##    ####  ##        #### ##    ####   ####                                
    
    to startup
       setup
       ;loop [  set full-time-mouse? true monitor-environment wait frame-slice set full-time-mouse? false ]
    end
       
    to setup 
       ca
       ;; environment
       
       set friction 1
       set frame-slice 1 / 60
       set generations 0
       set foot-race? false
       set mana-race? false
       set old-shape leg-shape
       
       ;; halo (hidden until used)
       create-halos 1
       [ set shape "halo"
         set color white
         set size max-pxcor * .3
         set hidden? true
         set selected-halo self
       ]
       ask selected-halo [ hide-turtle ]
       
       ;; setup initial population
       set population 10
       let index 2
       repeat population
       [ set index index + 1
         let limb-count 4
         let body-set make-body-set
         let new new-body body-set
         ask new 
         [ let gap (world-height / (population + 3))
           set floor-y int (max-pycor - (gap * index))
           setxy 0 max-pycor - gap 
           set heading 0
           ask my-limbs [ setxy [ xcor + (sin [phase] of myself) * dx  * size ] of parent
                                [ ycor + (cos [phase] of myself) * dy  * size ] of parent
                         ]
             without-interruption
           [ foreach my-sorted-bones [ ask ?
             [ set xcor [ xcor - dx * size ] of parent
               set ycor [ ycor - dy * size ] of parent
             ] ]
           ]
         ] 
       ]
       
    
       ask bodies
       [   random-body-color
    
       ]
       draw-floors
       ask bones [ set color [color] of [my-body] of my-limb - 2 + random 5 ]
       ask bodies [ virtualize show-turtle ask my-bones [ virtualize show-turtle ] ]
       snap-bones-to-body 0
       show-greeting 0
    end
    
    to random-body-color
           set base-color red + random 13 * 10 
           set color base-color 
    end
    
    to draw-floors
       cp
       let patch-list  [ (list floor-y base-color) ] of bodies
       let color-list map [ last ? ] patch-list
       set patch-list map [ first ? ] patch-list
       ask patches with [ member? pycor patch-list ]
       [ set pcolor item (position pycor patch-list) color-list
       ]
       show-greeting 1
       set greeting? 0
    end
       
    to go
       every ( 1 / desired-framerate )
       [ no-display
         
         
         ifelse is-turtle? selected 
         [ if greeting? != 2 [ show-greeting 2 ] ]
         [ if greeting? != 1 [ show-greeting 1 ] ]
         
         
         if not is-turtle? highlighted
         [ if mana-race? = true
           [ mana-falls
           ]
         
           if move? != false [ set t t + movement-coarseness ] 
           snap-bones-to-body 1 
           walkers-fall-over
           
         ; move-all 0
           walkers-react-to-floor
           walkers-stay-away-from-edges
           if mana-race? = true
           [ walkers-eat-mana ]
         ]
    
         if full-time-mouse? != true [ monitor-environment ]
         display
       ]
    end
    
    to-report make-body-set
    ;;|;; skeleton data structure
    ;;|[ ;; limbs list
    ;;|  [ ;; limb1
    ;;|    phase
    ;;|    ;; bone data (last record of limb data)
    ;;|    [ ;; bone 1
    ;;|      [ length-1 center-1 sweep-1 phase-1 freq-1 ]
    ;;|      ;; bone 2
    ;;|      [ length-2 ... ]
    ;;|    ]
    ;;|  ]
    ;;|  [ ;; limb 2 ...
    ;;|  ]
    ;;|]   
    
       let body-set []
       let arc 360 / limbs*
       let phase-index 180 - arc * .5 
       repeat limbs*
       [ let limb-set []
         
         
         let bone-inc (-5 / joints*  ) * .1 * max-pxcor * .06
         let bone-size  ((15 / joints*) + joints* * .5 ) * .1 * max-pxcor * .08
         if equal-size-parts? [ set bone-inc 0 set bone-size 10 - joints* * .8 + 10 / joints* ]
         let first-joint? true
         repeat joints* ;;    size      center          sweep           phase                       freq
         [ let new-sweep 5 + 5 * random 18 ;; 0 to 85
           let new-center  random (180 - (new-sweep * 2)) - (90 - (new-sweep))
           if first-joint? [ set new-center new-center + 180 ]
           let bone-set (list bone-size new-center new-sweep (-180 + (22.5 * random 16)) 1)
           set limb-set lput bone-set limb-set
           set bone-size bone-size + bone-inc
           set first-joint? false 
         ]
         ;; set limb-set reverse limb-set
         set limb-set fput phase-index limb-set
         set body-set lput  limb-set body-set
         set phase-index phase-index + arc
       ]
       ;;print "-----BODY SET-----"
       ;;print-list body-set 0
       report body-set
    end
       
    to print-list [ lists depth ]
       type substring  "                    "  0 (2 * (depth + 1))
       type "[ "
       foreach lists
       [ ifelse is-list? ?
         [ print ""
           print-list ? (depth + 1)
           ;; set depth depth - 1
           type substring  "                    "  0 (2 * (depth + 1))
       
         ]
         [ type (word ? " " ) ]
       ]
       print "] "
    end   
    
    ;;;;;;;;;;;;;;;
    ;;
    ;;  N E W - B O D Y
    ;;
    ;;;;;;;;;;;;;;;
    
    to-report new-body 
              [ body-set
              ]
       ;; repoter creates a body turtle, and adds the required number of identical limbs, with the defined set of bones
       ;; reporter reports the identiy of the body turtle
       
       let this-body nobody
       
       create-bodies 1 
       [ set hidden? true ;; stay hidden until rendered
         set shape "_body" ;; default shape is a circle
         set this-body self ;; may be unneeded... 
         set my-body self
         set my-limbs empty-set
         set my-bones empty-set
         
         foreach body-set ;; for each limb in the body set, make a limb
         [ let limb-set ?
           let null new-limb limb-set
         ] 
         set size max-pxcor * .06
       ]
       report this-body
    end
    
    ;;;;;;;;;;;;;;;
    ;;
    ;;  N E W - L I M B
    ;;
    ;;;;;;;;;;;;;;;
    
    to-report new-limb 
              [ limb-set  ;; list of lengths of bones in this limb  
              ]
       ;; creates a limb with the specified number of bones, reports the identity of the limb
       let this-limb nobody
       
       hatch-limbs 1 ;; the body makes a limb
       [ ;; INHERITED ;; code needed if not inherited:
         ;; set hidden? true
         ;; set shape "_circle"
         ;; set my-body myself ;; identity of the creating body 
         ;; set xcor...
         set shape "limb-marker"
         set my-limb self  ;; this limb (self-referential property, inherited by bones )
         set my-bones empty-set ;; agentset
         set my-sorted-bones [] ;; list
         set parent my-body ;; = my-body = myself 
         set child nobody ;; fist bone of this limb, leave open for attachment
         set phase first limb-set ;; the angle of this limb relative to the body (ie 0)
         set size 0
         ;; now, use add-bones recursive reporter to add required number of bones to this limb
         ;; (add bones updates the my-bones variable)
         set child new-bones but-first limb-set 
         set this-limb self ;; this is the new limb
       ]
       ;; update the "my-limbs" variables of the body
       set my-limbs limbs with [ my-body = myself ]
       set my-sorted-limbs sort my-limbs 
       ;; update the "my-bones" variable of the body
       set my-bones turtle-set [ my-bones ] of my-limbs
       set my-sorted-bones sort my-bones
       
       report this-limb ;; send back the identity of this limb
    end
    
    ;;;;;;;;;;;;;;;
    ;;
    ;;  N E W - B O N E S
    ;;
    ;;;;;;;;;;;;;;;
    
    to-report new-bones 
              [ limb-set ;; list of lengths of bones to add (this bone is the fisrt bone)
              ]
       let this-bone nobody
       
       hatch-bones 1
       [ ;; INHERITED ;; code required to set inherited values if not inherited
         ;; set hidden? true (only if during body creation!)
         ;; set shape "_circle"
         ;; set my-body my-body-of myself
         ;; set parent myself
         ;; set child nobody
         ;; set freq 50
         
         set hidden? true
         
         ifelse limb-set = [] ;; this is not a bone, per se, but a "zero-length" bone that marks the end of the last bone.
                              ;; this simplifies the task of knowing the location of end of the limb.
         [ set size 0
           set child self
           set parent myself
           set center 0
           set sweep 0
           set phase 0
           set shape "_foot-pad"
         ]
         [ ;; use the first entry in the bone-set to define this bone
           set shape leg-shape
           let bone-set first limb-set
           ;; show bone-set
           set parent myself ;; parent is the bone or limb that made this bone
           
           set size   item 0 bone-set
           set center item 1 bone-set 
           set sweep  item 2 bone-set
           set phase  item 3 bone-set
           set shape  leg-shape
           
           set child new-bones but-first limb-set ;; make the child bone (or end bone)
         ]
         set this-bone self
       ]
       ;; if this is the limb, update set of bones for this limb
       ;; note: find more efficient method! this method can get very slow
       ;; when there are a lot of bones!
       if breed = limbs
       [ set my-bones bones with [ my-limb = myself ] 
       ]
       report this-bone
    end   
    
    to virtualize
       set xx xcor
       set yy ycor
       set ox xx
       set oy yy
       set nx xx
       set ny yy
       set hh heading
       set oh hh
       set cx 0
       set cy 0
       set vx 0
       set vy 0
    end   
    
    to snap-bones-to-body [ mode ]
       ask bodies
       [ ;; set xcor nx
         ;; set ycor ny
         ;; set heading nh
         
         ask my-limbs
         [ set ox xcor
           set oy ycor
           set oh heading
           set xx  [ xcor + size * .5 * sin (heading + [phase] of myself ) ] of parent
           set yy [ ycor + size * .5 * cos( heading +  [phase] of myself ) ] of parent
           set hh [heading] of parent + phase
           set cx xx - ox
           set cy yy - oy
    
           setxy xx yy
           set heading hh
           ask child 
           [ ;; cancel out movement of the body from the movement of the limb's bones
             set ox xcor set oy ycor
             ;; move the bones
             move-bone mode
           ]
           
         ]
         
       ]
     end
       
    to move-bone [ mode ]
      
         set xx [ xcor - size * dx ] of parent
         set yy [ ycor - size * dy ] of parent
         set cx xx - ox
         set cy yy - oy
         setxy xx yy
         set hh heading
         if child != self
         [ ask child [ set ox xcor set oy ycor set oh heading ]
           set heading [heading] of parent + center + sweep * sin ( t + phase)
           ask child [ move-bone 1 ]
         ] 
    end          
    
    
         ;;;;; PRE V. 3.1beta1 helpers
         ;;;;;
         ;;;;;  to-report random-pxcor
         ;;;;;     report random world-width + min-pxcor
         ;;;;;  end
         ;;;;;  
         ;;;;;  to-report random-pycor
         ;;;;;     report random world-height + min-pycor
         ;;;;;  end
          
    to monitor-environment
         ;; monitors the mouse
         ;; monitors changes in slider values that
         ;; require an update to the walkers or other running
         ;; objects
         
         if frame-slice = 0 [ setup ]
         ifelse mouse-inside?
         [ let mx mouse-xcor
           let my mouse-ycor
           ifelse any? bodies with [ distancexy-nowrap mx my < world-width * .1 ]
           [ let nearest min-one-of bodies [ distancexy-nowrap mx my ]
             if nearest != highlighted
             [ if is-turtle? highlighted
               [ ask highlighted [ set color base-color set label "" ]  ]
               set highlighted nearest
             
               ask highlighted
               [ set color white
                 set label one-of [ "Pick me!   " "Me! Me! Me!   " "Ooo! Me!   " ]
               ]
           
          
             ]
     
           ]
           [ if is-turtle? highlighted
             [ set [color] of highlighted [base-color] of highlighted
               set [label] of highlighted ""
               set highlighted nobody 
             ]
           ]
           
           ifelse mouse-down? 
               [ ifelse click! != true
                 [ set click! true ]
                 [ set click! false
                   set selected highlighted
                   ;; ifelse is-turtle? selected 
                   ;; [ watch selected ]
                   ;; [ reset-perspective ]
                 ]
               ]
               [ if click! != false
                 [ set click! false ]
               ]
            ]
            [ if is-turtle? highlighted
             [ set [color] of highlighted [base-color] of highlighted
               set [label] of highlighted ""
               set highlighted nobody 
             ]
            ]
            
        ;; show or hide halo
        ifelse is-turtle? selected
        [ ask selected-halo
          [ if hidden? = true
            [ set hidden? false ]
            setxy [xcor] of selected [ycor] of selected
            rt 3
          ]
          set greeting? 2
        ]
        [ if [hidden?] of selected-halo = false
          [ set [hidden?] of selected-halo true
          ]
          set greeting? 1
        ]
        if leg-shape != old-shape
        [ ask bones [ set shape leg-shape ]
          set old-shape leg-shape 
        ]
    end
    
    to-report monitor-environment-as-reporter
       monitor-environment
       report "active"
    end   
    
    to action:mutate         
         ;; if any walker selected, delete all others, make mutated copies of the selected
         if not is-turtle? selected
         [ stop ]
         set generations generations + 1
          ;; first kill all the other walkers
          ;; that are not being replicated
           ;; bones die first, then limbs, then bodies
           ask bodies with [ self != selected ]
           [ ask my-limbs [ ask my-bones [ die ] die ] die ]
           
           ;; make population - 1 copies of selected
           repeat population - 1
           [ ;;show;; "STArTING COPY"
             ;; place to store id of copy-to-be
             let body-copy nobody
             ask selected
             [ ;; copy the selected body
               ;;show;; "making copy of body"
               hatch 1
               [ ;;show;; "copy of body"
                 ;; store id of the new copy
                 set body-copy self
                 ;; copy includes pointers to limbs
                 set base-color red + random 13 * 10 
                 set color base-color
                 
               ]
               ;; get the limbs to make copies, point new body to the new copies
               ;; copy the limbs, point the copies back to the body copy
               ask my-limbs
               [ ;;show;; "making limb copy"
                 ;; copy the limb 
                   hatch 1
                   [ ;;show;; "copy of limb"
                     let limb-copy self
                     ;; point the copy back to the body copy
                     set parent body-copy
                     set my-body body-copy
                     ;;show;; "copying children (bones)"
                     ask child ;; copy, body-link, limb-link, parent-link
                     [ copy-child body-copy limb-copy limb-copy ]
    
                     ;; rebuild my-bones set with copies
                     set my-bones bones with [ my-limb = myself ]
                     ;; create sorted bones set for the body
                     set my-sorted-bones sort my-bones
                     ;;show;; "FINISHED WITH THIS LIMB"
                   ]
               ]
             ]
           ]
           ask bodies
           [ update-my-limbs-my-bones ]
    
           ;; modify the copies slightly
           ask selected
           [ ask bodies with [ self != myself ]
           [ ask my-limbs 
             [ set phase phase - 45 + random 4 * 22.5
               if phase < -180 [ set phase phase + 360 ]
               if phase > 180 [ set phase phase - 360 ]
             ]
              
             ask my-bones with [ child != self ]
             [ set center center + mutation-severity * (-1 + random-float 2)
              if center < 0 [ set center center + 360 ]
              if center > 360 [ set center center - 360 ]
              
               set sweep abs ( sweep + mutation-severity * (-1 + random-float 2) )
               if sweep > 180 [ set sweep sweep - 360 ]
               
               set phase phase - 22.5 * mutation-severity + 22.5 * random (mutation-severity * 2)
               if phase < -180 [ set phase phase + 360 ]
               if phase > 180 [ set phase phase - 360 ]
               
               set size size * ((1 - mutation-severity * .05) + random-float ( mutation-severity * .1))
               if size < 1
               [ ;; too small! evolves away!
                 ;; if end-bone (child-of child = child is a foot pad
                 ;; drop child, become footpad
                 ifelse [child] of child = child 
                 [ ask child [ die ]
                   set size 1
                   set child self
                 ]
                 ;; if mid-bone, connect child to parent
                 ;; then die
                 [ set [parent] of child parent
                   set [child] of parent child
                   die
                 ]
               ]
               if size > 20
               [ ;; too big! split into two bones!
                 ;; with opposite phase
                 set size 10
                 hatch 1
                 [ set parent myself
                   set [child] of parent self
                   set child child ;; child doesn't change
                   set [parent] of child self
                   set phase phase + 180
                   if phase > 180 [ set phase phase - 360 ]
                 ]
                 ask my-body [ update-my-limbs-my-bones ]
                 
               ]
             ]
           ]]
           ;;position all the bodies on the floors
           let index 2
           ask bodies
           [ set index index + 1
             let gap (world-height / (population + 3))
             set floor-y int (max-pycor - (gap * index))
             let new-y floor-y + gap * .75
             setxy 0 new-y
             ask my-limbs [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
             ask my-bones [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
           ]
           ;; move selected to bottom row
           ask selected
           [ let min-y min-one-of bodies [ floor-y ]
             if selected != min-y
             [ let min-y-value [floor-y] of min-y
               let temp floor-y
               set floor-y min-y-value
               set [floor-y] of min-y temp
               let gap (world-height / (population + 3))
               let new-y floor-y + gap * .75
               setxy 0 new-y
               ask my-limbs [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
               ask my-bones [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
               ask min-y
               [ set new-y floor-y + gap * .75
                 setxy 0 new-y
                 ask my-limbs [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
                 ask my-bones [ set xcor 0 set ycor new-y set ox xcor set oy ycor ]
               ]
             ]
           ]
           
           
           draw-floors
           ;; set selected nobody
       end
       
    to  copy-child [ body-copy limb-copy parent-copy ]
       let child-copy nobody
       ;;show;; "making copy of bone"
       hatch 1
       [ ;;show;; "copy of bone"
         ;; store id of copied child
         set child-copy self
         ;; store the id of the copy of the limb
         set my-body body-copy
         set my-limb limb-copy
         set parent parent-copy
         set [child] of parent self
         if child = myself [ set child self ]
         
         if is-turtle? child and child != self
         [ ;;show;; "starting copy of child bone"
           ask child [ copy-child body-copy limb-copy child-copy ]
         ]
         ;;show;; "FINISHED WITH THIS BONE"
       ]
    end
    
    to action:mutate-random
       set selected one-of bodies 
       action:mutate
    end
    
    to action:mutate-many [ mutations ]
       repeat mutations [ action:mutate-random ]
    end   
    
    to update-my-limbs-my-bones
       ;; body procedure
             set my-limbs limbs with [ my-body = myself ]
             set my-sorted-limbs sort my-limbs 
             
             ask my-limbs [ set my-bones bones with [ my-limb = myself ] ]
             set my-bones turtle-set [ my-bones ] of my-limbs
             set my-sorted-bones sort my-bones 
             ask my-bones [ set color [base-color] of myself - 2 + random 5 ]
    
             
    end
    
    
    
    to action:toggle-foot-race
       set foot-race? foot-race? = false
       show-greeting greeting?
    end
    
    to action:toggle-mana-race
       set mana-race? ( mana-race? = false )
       ifelse mana-race?
       [ start-mana-race ]
       [ stop-mana-race ]
    end
    
                 
     to show-greeting [ mode]
        let messages []
        
        ifelse mode = 0
        [ set messages
          [  "Welcome to Wobbly Farms!"
             "Click GO to begin..."    
             "" "" "" ""
          ]
        ][
        ifelse mode = 1
        [ set messages (list
            "Pick a Wobble whose gait you like" 
            "Or click 'Replace All' for all new Wobbles"
            ifelse-value (foot-race? = true) [ "A foot race is on!" ] [ "" ] 
            ifelse-value (mana-race? = true) [ "A mana race is on!" ] [ "" ]
            "" ""
          )
        ][
        ifelse mode = 3
        [ set messages (list
            "Click an 'Action' button to use the selected Wobbly," 
            "or click 'Replace All' for all new Wobbles!" 
            ifelse-value (foot-race? = true) [ "A foot race is on!" ] [ "" ] 
            ifelse-value (mana-race? = true) [ "A mana race is on!" ] [ "" ]
            "" ""
          )
        ][
        ]]]
         
        (foreach messages n-values length messages [ ? ]
        [ ask patch max-pxcor (max-pycor - (4 + 8 * ?2 )) [ set plabel ?1 ] 
        ])
        set greeting? mode
        
    
    
    end
    
    
    to-report centroid-x 
       report mean [ xcor ] of my-bones
    end
       
    to-report centroid-y
       report mean [ ycor ] of my-bones 
    end
        
    to walkers-fall-over
           
           ask bodies
           [ ;; walker falls over
             ;; find xy of point-of-support (pos) (min-y and the center of all x's on min-y)
             ;; find center of mass (com)
             ;; if com-x is not equal to pos-x, then not balanced
             ;; find angle from point of support to center of mass (posh)
             ;; ideal com is directly above pos
             ;; so if diff 'tween posh and ideal is >0, fall right, if < 0, fall left
             ;; fall is rotation (and movement) of body about center that is posx and posy 
             let min-y-bone min-one-of my-bones [ ycor ]
             let pos-y [ycor] of min-y-bone
             let pos-x [xcor] of min-y-bone
             ;; make sure walker head isn't poking through the floor
             if ycor - size * .5 < pos-y
             [ set pos-y ycor - size * .5 
               set min-y-bone self
               set pos-x xcor
             ]
             
             
             
             let ctx centroid-x
             let cty centroid-y
             ;; if centroid not balanced over the point of support
             ;; fall away from POS
             let balance (ctx - pos-x)
             if abs balance > 1
             [ let correction movement-coarseness * .5
               if balance < 0 [ set correction -1 * correction ]
               let posh 180 + towardsxy pos-x pos-y
               while [ posh > 180 ] [ set posh posh - 360 ]
               while [ posh < -180 ] [ set posh posh + 360 ]
               
               let posd distancexy pos-x pos-y
               ;; if abs posh < 90
               ;; [ 
                setxy pos-x + posd * sin ( posh + correction )
                       pos-y + posd * cos ( posh + correction )
                 set heading heading + correction
               ;; ] 
             ]
           ]
    end          
    
    to walkers-react-to-floor
           ask bodies
           [  
             
             let min-y-bone min-one-of my-bones [ ycor ]
             let new-floor-y [ycor] of min-y-bone
             ;; make sure walker head isn't poking through the floor
             if ycor - size * .5 < new-floor-y
             [ set new-floor-y ycor - size * .5 
               set min-y-bone self
             ]
             let diff-y 0
             ifelse abs (new-floor-y - floor-y) < .5 
             [ set vy floor-y - new-floor-y set diff-y vy ]
             [ ifelse new-floor-y < floor-y
               [ set diff-y floor-y - new-floor-y set vy 0
               ] 
               [ set vy vy - 1 set diff-y vy ] ;; fall
             ]
             let diff-x friction * [cx] of min-y-bone * -1
             set ycor ycor + diff-y  set xcor xcor + diff-x
             set ox xcor set oy ycor
             ask my-limbs [ set ycor ycor + diff-y   set xcor xcor + diff-x set ox xcor set oy ycor ]
             ask my-bones [ set ycor ycor + diff-y   set xcor xcor + diff-x set ox xcor set oy ycor ]
             
          ]
          
    end
    
    to walkers-stay-away-from-edges
           let winner? false
           ask bodies
           [   
             let min-x-bone min-one-of my-bones [ xcor ]
             let min-x [xcor] of min-x-bone
             
             if min-x < min-pxcor + 5
             [  let diff-x min-x - min-pxcor  
                               set xcor xcor + diff-x + 100 set ox xcor set oy ycor
                ask my-limbs [ set xcor xcor + diff-x + 100  set ox xcor set oy ycor]
                ask my-bones [ set xcor xcor + diff-x + 100  set ox xcor set oy ycor]
                if foot-race? = true
                [ set winner? true 
                  ifelse self = selected 
                  [ set consecutive-wins consecutive-wins + 1 ]
                  [ set consecutive-wins 1 
                    set selected self
                  ]
                ]
             ]
             let max-x-bone max-one-of my-bones [ xcor ]
             let max-x [xcor] of max-x-bone
             if max-x > max-pxcor - 5
             [  let diff-x max-x - max-pxcor 
                               set xcor xcor + diff-x - 100  set ox xcor set oy ycor
                ask my-limbs [ set xcor xcor + diff-x - 100  set ox xcor set oy ycor ]
                ask my-bones [ set xcor xcor + diff-x - 100  set ox xcor set oy ycor]
                if foot-race? = true 
                [ set winner? true 
                  ifelse self = selected 
                  [ set consecutive-wins consecutive-wins + 1 ]
                  [ set consecutive-wins 1 
                    set selected self
                  ]
                ]
             ]
         ]
         if foot-race? = true and winner?
         [ 
           action:mutate
         ]  
    end      
    
    to start-mana-race 
       if mana-race? != true
       [  ask patches with [ pxcor = min-pxcor ]
          [ sprout-mana 1
            [ set shape "mana"
              set pcolor white
              set heading 90
            ]
          ]
          set mana-race? true
          ask bodies [ set score 0 ]
       ]
       show-greeting greeting?
    end
    
    to stop-mana-race
       set mana-race? false
       ask mana [ die ]
       show-greeting greeting?
    end      
    
    to walkers-eat-mana
       ask bones with [ self = child ]
       [ let food (mana in-radius (.5 * [size] of parent)) 
         ask my-body[ set score score + count food set label (word score "   ") ]
         ask food
         [ die
         ]
       ]
    end
       
    to mana-falls
       ask mana
       [ ifelse pxcor >= max-pxcor
         [ die ]
         [ if random 10 < 9 [ jump 1 ] ]
       ]
       if not any? mana
       [ let max-score max [ score ] of bodies
          set selected one-of bodies with [ score = max-score ]
          action:mutate
          set mana-race? false
          start-mana-race
       ]
    end            
    
    
    to action:save-selected
       if selected = nobody [ stop ]
       ;;|;; skeleton data structure
    ;;|[ ;; limbs list
    ;;|  [ ;; limb1
    ;;|    phase
    ;;|    ;; bone data (last record of limb data)
    ;;|    [ ;; bone 1
    ;;|      [ length-1 center-1 sweep-1 phase-1 freq-1 ]
    ;;|      ;; bone 2
    ;;|      [ length-2 ... ]
    ;;|    ]
    ;;|  ]
    ;;|  [ ;; limb 2 ...
    ;;|  ]
    ;;|]  
       let body-list []
       ask selected
       [ ask my-limbs
         [ let limb-list (list phase )
           let my-child child
           let me self
           while [ my-child != me ]
           [ ask my-child
             [ let bone-list (list size center sweep phase 1 )
               set limb-list lput bone-list limb-list
               set my-child child
               set me self
             ]
           ]
           set body-list lput limb-list body-list
         ]
       ]
       if file-exists? "body.ndat"
       [ file-delete "body.ndat" ]
       file-open "body.ndat"
       file-write body-list
       file-close
    end
    
    to action:load
       ask bones [ die ]
       ask limbs [ die ]
       ask bodies [ die ]
       file-open "body.ndat"
       let new-body-list file-read 
       file-close 
      
       let new-creature new-body new-body-list
       ask new-creature
       [ set base-color red  + 10 * random 12 
         set color base-color
       ]
       set selected new-creature
       action:mutate
       ask turtles [ show-turtle ]
    end 
         
        
    
                        


    Download Link

    View or download the complete model file (to download: right-click, save-link-as):
    -- Download Evolution-of-Movement_5 --