---dyn1.6.nlogo

来自「NETLOGO」· NLOGO 代码 · 共 891 行 · 第 1/2 页

;;globalvars: no-things, replace-rate-regular, replace-rate-special, different?
;;            no-turtles        ;; number of turtles
;;            p-communicators   ;; the chance that a turtle will be a comunicator
;;            p-knowhow         ;; the chance that a turtle will have know-how
;;NB the domain of the credits depends on the number of special-credit-items. 
;;if there are 6 things than the value for each thing could be between 10 and 60 

globals [ extra-list regular no p-mu max-fit lifespan p-fill-reg p-fill-spec]

patches-own [ here-list ]

turtles-own [ age
              fitness  
              knowhow ]
             
breeds [ talker silent ]

to setup
  ca
  setup-globals 
  setup-patches
  setup-agents
  setup-plot
end

to setup-globals
set p-mu 0.05                      ;;;the chances of offspring being different from parent
set max-fit 300                    ;;;turtles can't keep gathering fitness
set lifespan 30                    ;;;maximum age, in steps
set no (no-things - 1)             ;;;this is more intuitive 
set regular 30                     ;;;default credit, this could also be user defined.
;;; sets the credit a turtle gets for each unit, if different? is off, everything has same credit
ifelse different? [set extra-list n-values no [ (((random no) + 1 ) * 10) ] ]  [ set extra-list n-values no [regular] ] 
set extra-list (fput regular extra-list)
set p-fill-reg 0
set p-fill-spec 0
end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;patches
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to setup-patches
;;all patches are empty 
ask patches [set here-list (n-values no-things [ 0 ])]
fill-patches1 ((replace-rate-regular / 1000) * field) ((replace-rate-special / 1000) * field)
set p-fill-reg (sum values-from patches [ (first here-list) * (first extra-list) ])
if no != 0 [set p-fill-spec (sum values-from patches [ reduce [?1 + ?2] (map [?1 * ?2] (but-first here-list) (butfirst extra-list)) ])]
end

to fill-patches [regular-num special-num]
locals [ i ]
if p-fill-reg < replace-rate-regular * 100  ;;only if the credit hasnt reached a treshold
  [ repeat regular-num [ ask patch-at ((random screen-size-x) - screen-edge-x ) ((random screen-size-y) - screen-edge-y )
                                  [ set here-list (replace-item 0 here-list ((item 0 here-list) + 1) ) ] ]
                                  ]
if p-fill-spec < replace-rate-special * 100  ;;only if the credit hasnt reached a treshold                                  
  [ if (no != 0 ) [ repeat special-num [ set i ((random no) + 1)
                                     ask patch-at ((random screen-size-x) - screen-edge-x ) ((random screen-size-y) - screen-edge-y )
                                         [ set here-list (replace-item i here-list ((item i here-list) + 1)) ]]]
                                         ]
;; set the color of the patch proportional to the max obtainable credit  
ask patches [set pcolor (5 + reduce [ ?1 + ?2 ] (map [?1 * ?2] here-list extra-list)) ]
end

to fill-patches1 [regular-num special-num]
locals [ i ]
repeat regular-num [ ask random-one-of patches [ set here-list (replace-item 0 here-list ((item 0 here-list) + 1)) ]]
if (no != 0 ) [ repeat special-num [ set i ((random no) + 1)
                                     ask random-one-of patches
                                         [ set here-list (replace-item i here-list ((item i here-list) + 1)) ]]]
;; set the color of the patch proportional to the max obtainable credit  
ask patches [set pcolor (5 + reduce [ ?1 + ?2 ] (map [?1 * ?2] here-list extra-list)) ]
end

to-report field 
report (screen-size-x  * screen-size-y)
end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;turtles
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to setup-agents
  set-default-shape talker "loud"
  set-default-shape silent "silent"
  crt no-turtles                                    ;; create given number of turtles
  ask turtles [set age random lifespan                    ;; set age to random number < lifespan
               setxy (random-int-or-float screen-size-x)  ;; randomize the turtle locations
                        (random-int-or-float screen-size-y)
               set fitness ((random (max-fit - 5 )) + 5)  ;; all turtles have a chance
               init-vars]   
end

to init-vars
  ;; roll dice for breed
  ifelse ((random 100) < (p-communicators * 100))  [ set breed talker ] [ set breed silent ]
  ;; roll dice for every knowledge-slot
  set knowhow n-values no [round (((random 100) / 100) - (0.50 - p-knowhow))]
  update-looks
end

to update-looks
  Ifelse (no = 0) [set color 13] [set color (13 + ((reduce [?1 + ?2] knowhow) * 10))]
  ;; '(reduce [?1 + ?2] knowhow)' will output the number of nonzero items in knowhow
  ;; this sets the color proportional to the knowledge
  set color scale-color color age 0 lifespan
end

to go
  ;; here all the steps are synchronised, i'm not shure that is neccesary
  ask turtles [take-credit]
  ask turtles [offspring] 
  if (no != 0) [ask talker [communicate]]
  ask turtles [update-looks]
  ask turtles [set fitness (fitness - 10) 
               levi-flight]
  ask turtles [set age (age + 1)] 
  ask turtles [live-or-die]
  fill-patches1 ((replace-rate-regular / 1000) * field) ((replace-rate-special / 1000) * field)
  update-plot
end

to take-credit
locals [k]
set k knowhow
;;this implementation: collect all the stuff from patch-here
if fitness < max-fit [
  set fitness ( fitness + ((first (value-from patch-here [here-list])) * first extra-list) + 
              ( add-up (map [?1 * ?2] k ( butfirst ( map [?1 * ?2] (value-from patch-here [here-list]) extra-list ) ) )))
  ask patch-here [ set here-list fput 0 (adjust-here-list (butfirst here-list) k)
                   set pcolor (5 + reduce [ ?1 + ?2 ] (map [?1 * ?2] here-list extra-list)) ]
                      ]
end

to-report add-up [lijst]
ifelse (lijst = []) [report 0 ][ report reduce [ ?1 + ?2 ] lijst ]
end

to-report adjust-here-list [hrlst knwhw]
if hrlst = [] [report []]
ifelse (first knwhw = 1) [ report (fput 0 (adjust-here-list (butfirst hrlst) (butfirst knwhw))) ]
                         [ report (fput (first hrlst) (adjust-here-list (butfirst hrlst) (butfirst knwhw))) ]
end

to communicate
  ;;communicators choose what thing to tell all their neighbours,
  ;;it could be they tell every neighbour something else
  ;;or they could just pick 1 item-slot and tell that to their neighbours, (using max)
  ;;or, have them always tell the first item that is 1
  ;;or tell them the stuff they dont know
  locals [n]
  ;;pick an item that is 1: first make a list of all the items that are 1
  ;;then randomly pick 1 to tell neighbours
  if (sum knowhow > 0)
    [set n (random-one-of (non-zero knowhow 0))
     ask turtles in-radius 1
       [ set knowhow (replace-item n knowhow 1) 
         show knowhow ]]
  ;;and i know there must be an easier way.....
end

to-report non-zero [l n]
if l = [] [report []]
ifelse (first l = 1) [report fput n (non-zero butfirst l (n + 1))] [report non-zero butfirst l (n + 1)]
end

to live-or-die
  if age > lifespan [ die]
  if fitness < 0 [die]
end

to offspring
;;if the turtle is fretile (not implemented) and other (ie luck, fitness) vars are ok
  if (random fitness) > 100
            [hatch 1  [set age 0
                       ;set fitness (fitness * 0.6)
                       set knowhow ( map [ tweak ? ] knowhow ) 
                       if ((random 100) < (p-mu * 100)) 
                             [ ifelse breed = talker [ set breed silent ] [set breed talker] ] ]
	           set fitness (fitness - 100)]
;the knowledge and breed of the ofspring are tweaked a little to make it more realistic.
;NB maybe the knowledge should not be heridatory. The communicators should maybe just tell one thing at the 
;;time. And instead of being born with it the agents coud stumble on knowledge.
end

to-report tweak [l] ;;changes a value of 1 or 0 if (random number < P-mutation )
  ifelse ((random 100) < (p-mu * 100)) [ ifelse l = 1 [ report 0] [report 1]] [ report l]           
end

;;;;;;;;;;HOW TO MOVE;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


to move-random
rt random-int-or-float 360
fd random 10
end

to levi-flight
 locals [ nummer ]
 rt random-int-or-float 360
 set nummer random 344
 if nummer = 0 
    [fd 15]
 if nummer = 1
    [fd 14]
 if nummer = 2
    [fd 13]
 if nummer = 3
    [fd 12]
 if nummer >= 4 and nummer < 6
    [fd 11]
 if nummer >= 6 and nummer < 8
    [fd 10]
 if nummer >= 8 and nummer < 11
    [fd 9]
 if nummer >= 11 and nummer < 15
    [fd 8]
 if nummer >= 15 and nummer < 19
    [fd 7]
 if nummer >= 19 and nummer < 25
    [fd 6]
 if nummer >= 25 and nummer < 33
    [fd 5] 
 if nummer >= 33 and nummer < 46
    [fd 4] 
 if nummer >= 46 and nummer < 69
    [fd 3]
 if nummer >= 69 and nummer < 122 
    [fd 2]
 if nummer >= 122 and nummer < 332
    [fd 1]
end


;;;;;;;;;;;;;;;THE PLOTTING PART;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


to setup-plot
  set-current-plot "agegroups"
  set-plot-x-range 0 (lifespan + 1)
  set-plot-y-range 0 round (no-turtles / lifespan) + 20
  set-histogram-num-bars lifespan
  set-current-plot "knowledge"
  set-plot-x-range 0 no-things
  set-histogram-num-bars no-things
  ;;shows for every turtle how much they know
  show (values-from turtles [sum knowhow]) 
end

to clearup
clear-plot 
set-plot-x-range 0 no-things
set-histogram-num-bars no-things
end

to update-plot
update-agegroups
update-plot-all
update-knowledge
end

to update-agegroups
set-current-plot "agegroups"
histogram-from turtles [ age ]          ; using the default plot pen
end

to update-plot-all
set-current-plot "plot-all"
set-current-plot-pen "turtles"
plot count turtles
set-current-plot-pen "credit"
plot (0.1 * (sum values-from patches [ reduce [?1 + ?2] (map [?1 * ?2] here-list extra-list) ]))
set-current-plot-pen "fit"
if (count turtles != 0) [ plot mean values-from turtles [fitness] ]
set-current-plot-pen "talker"
plot count talker
set-current-plot-pen "silent"
plot count silent
end


; update the barchart
to update-knowledge
locals [l]
set l (sum-list (values-from turtles [knowhow])) 
set l (map [ ( ? / (count turtles)) * 100] l)
; choose the plot
set-current-plot "knowledge"
; set the height of the plot
;set-plot-y-range 0 (max l)
; set the width of the plot (will change)
set-plot-x-range 0 no
; make sure the "default" pen is selected
set-current-plot-pen "default"
; reset the plot pen (so plotting starts from the left)
plot-pen-reset
; make sure it's a bar plot
set-plot-pen-mode 1
; add bars to the plot
foreach (n-values (length l) [ ? ] )
[ ; ?1 is index
plot ( item ?1 l )
]
end 


;;sum over lots of lists
to-report sum-list [lijst-van-lijsten]
if (lijst-van-lijsten = []) [report []]
report sum2 (first lijst-van-lijsten) (sum-list (but-first lijst-van-lijsten))
end
 
;;sum over 2 lists
to-report sum2 [list1 list2]
if (list2 = []) [report list1]
report (map [?1 + ?2] list1 list2)
end 

;;suggestion from netlogo users group:
;;set things-sum
;;map
;;[ sum values-from turtles [ item ? things ] ]
;;( n-values things-length [ ? ] )


;;give me the number of turtles that know x things:
;;or should there be an initial know-list? as extra turtle-own var?
;;or should every turtle that knows something from birth just know one thing?
;;so the chance is 1/6th * chance per item. First roll dice for slot, then for item
;;

;;plots the no of turtles that know 1 thing
;;to know-hist
;;set-current-plot "know" 
;;set-plot-y-range 0 count turtles
;;histogram-list (values-from turtles [sum knowhow]) 
;;end







@#$#@#$#@
GRAPHICS-WINDOW
321
10
520
230
10
10
9.0
1
10
1
1
1

CC-WINDOW
-2
407
218
526
Command Center

BUTTON
214
168
304
225
setup
setup
NIL
1
T
OBSERVER
T

SLIDER
9
10
228
43
replace-rate-regular
replace-rate-regular
0
100
4
1
1
NIL

SLIDER
10
61
219
94
replace-rate-special
replace-rate-special
0
100
4
1
1
NIL

SLIDER
11
124
206
157
no-things
no-things
1
10
5
1
1
NIL

SWITCH
12
172
116
205
different?
different?
1
1
-1000

MONITOR
13
233
309
282
value per stuff
extra-list
0
1

TEXTBOX
222