Courses/CS 461/Winter 2006/Rick Strom/Week Four/HW4 - Homosexuality
From CSWiki
< Courses | CS 461 | Winter 2006 | Rick Strom | Week Four
globals [days]
breeds [males females]
turtles-own [is-homosexual? is-heterosexual? age days-until-ready]
males-own []
females-own [days-to-birth]
to setup
ca
repeat start-population [
if-else (random 2) = 1
[
create-custom-males 1 [
set shape "person farmer"
set color blue
setxy (random screen-size-x - random screen-size-x) (random screen-size-y + random screen-size-y)
set days-until-ready 0
set age random life-span
if-else (random-float 100 < start-heterosexual-odds)
[ set is-heterosexual? true ]
[ set is-heterosexual? false ]
if-else (random-float 100 < start-homosexual-odds)
[ set is-homosexual? true ]
[ set is-homosexual? false ]
if is-homosexual? [ set color green ]
if (not is-homosexual? and not is-heterosexual?) [ set color yellow ]
]
]
[
create-custom-females 1 [
set shape "person farmer"
set color red
setxy (random screen-size-x - random screen-size-x) (random screen-size-y + random screen-size-y)
set days-to-birth 0
set days-until-ready 0
set age random life-span
if-else (random-float 100 < start-heterosexual-odds)
[ set is-heterosexual? true ]
[ set is-heterosexual? false ]
if-else (random-float 100 < start-homosexual-odds)
[ set is-homosexual? true ]
[ set is-homosexual? false ]
if is-homosexual? [ set color green ]
if (not is-homosexual? and not is-heterosexual?) [ set color yellow ]
]
]
]
set days 0
end
to go
;; move the turtles around
ask turtles [
set xcor (xcor + random 2 - random 2)
set ycor (ycor + random 2 - random 2)
]
;; mate
;; this is the meat of the model
;; each turtle looks for a mate on his patch.
;; If he has satisfactorily recovered from his last mating,
;; then he attempts to mate with a compatible partner
;; success is determined by his orientation, his mate's orientation, some probability, and his advantage (if homosexual)
ask turtles [
if (days-until-ready = 0) ;; we can search for a mate
[
;; case: strictly heterosexual male
if (is-heterosexual? and not is-homosexual? and breed = males)
[
ask other-turtles-here with [breed = females and days-until-ready = 0 and is-heterosexual?]
[
if (random-float 100.0 < scoring-odds) [
set days-until-ready-of self refractory-period
set days-until-ready-of myself refractory-period
set days-to-birth gestation-period
stop
]
]
]
;; case: strictly homosexual male
if (not is-heterosexual? and is-homosexual? and breed = males)
[
ask other-turtles-here with [breed = males and days-until-ready = 0 and is-homosexual?]
[
if (random-float 100.0 < scoring-odds + homosexual-advantage) [
set days-until-ready-of self refractory-period
set days-until-ready-of myself refractory-period
stop
]
]
]
;; case: bisexual male
if (is-heterosexual? and is-homosexual? and breed = males)
[
ask other-turtles-here with [days-until-ready = 0 and ((breed = males and is-homosexual?) or (breed = females and is-heterosexual? and days-to-birth = 0))]
[
if (random-float 100.0 < scoring-odds + homosexual-advantage) [
set days-until-ready-of self refractory-period
set days-until-ready-of myself refractory-period
stop
]
]
]
;; case: lesbian female
if (is-homosexual? and not is-heterosexual? and breed = females)
[
ask other-turtles-here with [days-until-ready = 0 and breed = females and is-homosexual? and days-to-birth = 0]
[
if (random-float 100.0 < scoring-odds + homosexual-advantage) [
set days-until-ready-of self refractory-period
set days-until-ready-of myself refractory-period
stop
]
]
]
]
]
;; do the births when days-to-birth = 1
ask turtles with [ breed = females and days-to-birth = 1 ] [
if (count turtles < max-population) [
if-else (random 2 = 1)
[
hatch-males 1 [
set shape "person farmer"
set color blue
set age 0
set days-until-ready 0
if-else (is-homosexual?-of myself and random-float 100.0 < homosexuality-propogation-likelihood) [
set is-homosexual? true
]
[
set is-homosexual? false
]
if-else (is-heterosexual?-of myself and random-float 100.0 < heterosexuality-propogation-likelihood) [
set is-heterosexual? true
]
[
set is-heterosexual? false
]
if (is-homosexual?) [ set color green ]
if (not is-homosexual? and not is-heterosexual?) [ set color yellow ]
]
]
[
hatch-females 1 [
set shape "person farmer"
set color red
set age 0
set days-until-ready 0
set days-to-birth 0
if-else (is-homosexual?-of myself and random-float 100.0 < homosexuality-propogation-likelihood) [
set is-homosexual? true
]
[
set is-homosexual? false
]
if-else (is-heterosexual?-of myself and random-float 100.0 < heterosexuality-propogation-likelihood) [
set is-heterosexual? true
]
[
set is-heterosexual? false
]
if (is-homosexual?) [ set color green ]
if (not is-homosexual? and not is-heterosexual?) [ set color yellow ]
]
]
]
]
;; decrement the days-to-birth
ask turtles with [breed = females and days-to-birth > 0] [ set days-to-birth days-to-birth - 1 ]
;; age all the turtles
ask turtles [ set age age + 1 ]
;; kill off old turtles
ask turtles with [age > life-span] [ die ]
;; decrement the days-until-ready
ask turtles with [days-until-ready > 0] [ set days-until-ready days-until-ready - 1 ]
;; increment the day
set days days + 1
;; plot
do-plots
end
to do-plots
set-current-plot "Population"
set-current-plot-pen "homosexual"
plot count turtles with [is-homosexual? and not is-heterosexual?]
set-current-plot-pen "heterosexual"
plot count turtles with [not is-homosexual? and is-heterosexual?]
set-current-plot-pen "bisexual"
plot count turtles with [is-homosexual? and is-heterosexual?]
set-current-plot-pen "asexual"
plot count turtles with [not is-homosexual? and not is-heterosexual?]
end
