-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathysa functions.R
166 lines (135 loc) · 5.56 KB
/
ysa functions.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
#Yellow-shouldered amazon functions
library(popbio)
library(tidyverse)
# Here is the function
# pi, piSD etc are inside the data frame. This needs to be specified this
# for example: dataSource$pi[1] is where pi[1] is located
#--------------------------------------------------------------------------------------------------------------------------------
# ysaFunc creates a matrix from randomly drawn data, with p values taken from a beta distribution and f values
# drawn from a lognormal distribution
ysaFunc <- function (dataSource)
{
#ps
p <- purrr::map2(dataSource$pi, dataSource$piSD, function(mu, sdev) {
## check if variance < (1-p) * p
if (sdev^2 < (1 - mu)*mu) {
## OK to use sdev in betaval function
betaval(mu, sdev, fx=runif(1))
} else {
## Replace sdev with allowable value
betaval(mu, sqrt((1 - mu)*mu) - 0.01, fx=runif(1))
}
})
names(p) <- c("p1a", "p1b", "p1c", "p2", "p3")
## this adds elements of the list to the current environment
list2env(p, envir = environment())
#f
f3 <- rnorm(1, mean = (dataSource$f[5]), sd = (dataSource$fSD[5]))
# Pi <- ((1 - (pi^(di - 1)))/(1 - (pi^di)))*pi ------- equation for Pi's
# Gi <- (pi^di*(1 - pi))/(1 - pi^di) ------- equation for Gi's
#d
d1 <- dataSource$di[1] + dataSource$di[2] + dataSource$di[3]
d2 <- dataSource$di[4]
d3 <- dataSource$di[5]
# this uses p1's defined above
p1 <- (p1a*p1b*p1c) # this stage as the survival is from the multiplication of p1a, p1b and p1c
#add ps
# construct the matrix using defined parameters above
matrix2 <- matrix(0, nrow = 3, ncol = 3)
dimnames(matrix2) <- list(rownames(matrix2, do.NULL = FALSE, prefix = "row"),
colnames(matrix2, do.NULL = FALSE, prefix = "col"))
matrix2[1,1] <- ((1 - (p1^(d1 - 1)))/(1 - (p1^d1)))*p1
matrix2[2,2] <- ((1 - (p2^(d2 - 1)))/(1 - (p2^d2)))*p2
matrix2[3,3] <- ((1 - (p3^(d3 - 1)))/(1 - (p3^d3)))*p3
#add f
matrix2[1,3] <- f3
#add gs
matrix2[2,1] <- (p1^d1*(1 - p1))/(1 - p1^d1)
matrix2[3,2] <- (p2^d2*(1 - p2))/(1 - p2^d2)
return(matrix2)
}
#--------------------------------------------------------------------------------------------------------------------------------
# ysameanFunc creates a matrix based on means, ie the raw values from the data source rather than drawing from distributions
ysameanFunc <- function (dataSource)
{
#ps
p1a<- dataSource$pi[1]
p1b<- dataSource$pi[2]
p1c<- dataSource$pi[3]
p2 <- dataSource$pi[4]
p3 <- dataSource$pi[5]
#f
f3 <- dataSource$f[5] #should 3.3 be divided by 2
# Pi <- ((1 - (pi^(di - 1)))/(1 - (pi^di)))*pi ------- equation for Pi's
# Gi <- (pi^di*(1 - pi))/(1 - pi^di) ------- equation for Gi's
#d
d1 <- dataSource$di[1] + dataSource$di[2] + dataSource$di[3]
d2 <- dataSource$di[4]
d3 <- dataSource$di[5]
# this uses p1's defined above
p1 <- (p1a*p1b*p1c) # this stage as the survival is from the multiplication of p1a, p1b and p1c
#add ps
# construct the matrix using defined parameters above
matrix2 <- matrix(0, nrow = 3, ncol = 3)
matrix2[1,1] <- ((1 - (p1^(d1 - 1)))/(1 - (p1^d1)))*p1
matrix2[2,2] <- ((1 - (p2^(d2 - 1)))/(1 - (p2^d2)))*p2
matrix2[3,3] <- ((1 - (p3^(d3 - 1)))/(1 - (p3^d3)))*p3
#add f
matrix2[1,3] <- f3
#add gs
matrix2[2,1] <- (p1^d1*(1 - p1))/(1 - p1^d1)
matrix2[3,2] <- (p2^d2*(1 - p2))/(1 - p2^d2)
return(matrix2)
}
#--------------------------------------------------------------------------------------------------------------------------------
# ysaFuncDD creates a function to calculate a matrix model with density-dependent fecundity - need to pass in the current
# population vector n and threshold for density-dependent effects. Also specify whether to make it stochastic or just use mean
# values.
ysaFuncDD <- function (dataSource, n, threshold, stochastic = FALSE)
{
if (stochastic) {
#ps
p1a<- betaval((dataSource$pi[1]), (dataSource$piSD[1]), fx=runif(1))
p1b<- betaval((dataSource$pi[2]), (dataSource$piSD[2]), fx=runif(1))
p1c<- betaval((dataSource$pi[3]), (dataSource$piSD[3]), fx=runif(1))
p2 <- betaval((dataSource$pi[4]), (dataSource$piSD[4]), fx=runif(1))
p3 <- betaval((dataSource$pi[5]), (dataSource$piSD[5]), fx=runif(1))
# F
# N > M -> (M*F)/N
# N <= M -> F
f3 <- rnorm(1, mean = (dataSource$f[5]), sd = (dataSource$fSD[5]))
} else {
#ps
p1a<- dataSource$pi[1]
p1b<- dataSource$pi[2]
p1c<- dataSource$pi[3]
p2 <- dataSource$pi[4]
p3 <- dataSource$pi[5]
#f
f3 <- dataSource$f[5]
}
# Pi <- ((1 - (pi^(di - 1)))/(1 - (pi^di)))*pi ------- equation for Pi's
# Gi <- (pi^di*(1 - pi))/(1 - pi^di) ------- equation for Gi's
#d
d1 <- dataSource$di[1] + dataSource$di[2] + dataSource$di[3]
d2 <- dataSource$di[4]
d3 <- dataSource$di[5]
# this uses p1's defined above
p1 <- (p1a*p1b*p1c) # this stage as the survival is from the multiplication of p1a, p1b and p1c
#add ps
# construct the matrix using defined parameters above
matrix2 <- matrix(0, nrow = 3, ncol = 3)
matrix2[1,1] <- ((1 - (p1^(d1 - 1)))/(1 - (p1^d1)))*p1
matrix2[2,2] <- ((1 - (p2^(d2 - 1)))/(1 - (p2^d2)))*p2
matrix2[3,3] <- ((1 - (p3^(d3 - 1)))/(1 - (p3^d3)))*p3
#add f - including density dependence based on number of breeders
if (n[3] > threshold) {
matrix2[1,3] <- f3*threshold/n[3]
} else {
matrix2[1,3] <- f3
}
#add gs
matrix2[2,1] <- (p1^d1*(1 - p1))/(1 - p1^d1)
matrix2[3,2] <- (p2^d2*(1 - p2))/(1 - p2^d2)
return(matrix2)
}