-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPrac5_solution.Rmd
134 lines (112 loc) · 5.66 KB
/
Prac5_solution.Rmd
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
---
title: Exercise 5<br> Point transect sampling
author: Centre for Research into Ecological and Environmental Modelling <br> **University of St Andrews**
date: Introduction to distance sampling<br> August/September 2022
output:
rmdformats::readthedown:
highlight: tango
bibliography: references.bib
csl: apa.csl
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)
```
::: {.alert .alert-success}
<strong>Solutions</strong> Point transect exercises
:::
# Simulated data
The code for accessing and checking these data and fitting various models is shown below.
```{r, fig.width=4, fig.height=4, message=FALSE}
library(Distance)
data("PTExercise")
head(PTExercise, n=3)
conversion.factor <- convert_units("meter", NULL, "hectare")
# Fit half-normal detection function, no truncation
PTExercise.hn <- ds(data=PTExercise, transect="point", key="hn", convert_units=conversion.factor)
plot(PTExercise.hn, pdf=TRUE, main="Simulated pt transect data\nHalf normal key function")
```
## Truncation of 20m
```{r, trunc20, message=FALSE}
# Half normal, no adjustments
PTExercise.hn.t20m <- ds(data=PTExercise, transect="point", key="hn", truncation=20,
convert_units=conversion.factor)
# Hazard rate, no adjustments
PTExercise.hr.t20m <- ds(data=PTExercise, transect="point", key="hr", truncation=20,
convert_units=conversion.factor)
# Uniform, cosine adjustments
PTExercise.uf.cos.t20m <- ds(data=PTExercise, transect="point", key="unif",
adjustment="cos", truncation=20,convert_units=conversion.factor)
```
```{r, echo=F}
# Same caveat as with previous exercises, do not get excited
# about the code in this chunk; it is not necessary for your
# understanding of distance sampling.
pt.tab <- data.frame(DetectionFunction=c("Half-normal","Half-normal",
"Hazard rate","Uniform"),
Adjustments=c("None","None","None","Cosine"), Truncation=c(34.2,20,20,20),
AIC=rep(NA,4), Density=rep(NA,4), D.CV=rep(NA,4), Lower.CI=rep(NA,4), Upper.CI=rep(NA,4))
get.results.f <- function(fit.model) {
return(c(AIC=summary(fit.model$ddf)$aic,
D=fit.model$dht$individuals$D$Estimate,
D.CV=fit.model$dht$individuals$D$cv,
lCL=fit.model$dht$individuals$D$lcl,
uCL=fit.model$dht$individuals$D$ucl))
}
pt.tab[1,4:8] <- get.results.f(PTExercise.hn)
pt.tab[2,4:8] <- get.results.f(PTExercise.hn.t20m)
pt.tab[3,4:8] <- get.results.f(PTExercise.hr.t20m)
pt.tab[4,4:8] <- get.results.f(PTExercise.uf.cos.t20m)
knitr::kable(pt.tab, caption="Results from simulated point transect data.", digits=3)
```
## Plots of probability density functions to inspect fit
```{r, echo=FALSE, eval=FALSE}
# Plot detection functions
par(mfrow=c(2,2))
plot(PTExercise.hn, main="Half normal, no truncation")
plot(PTExercise.hn.t20m, main="Half normal, truncation 20m")
plot(PTExercise.hr.t20m, main="Hazard rate, truncation 20m")
plot(PTExercise.uf.cos.t20m, main="Uniform with cosine, truncation 20m")
```
```{r, fig.height=6}
par(mfrow=c(2,2))
plot(PTExercise.hn, main="Half normal, no truncation", pdf=TRUE)
plot(PTExercise.hn.t20m, main="Half normal, truncation 20m", pdf=TRUE)
plot(PTExercise.hr.t20m, main="Hazard rate, truncation 20m", pdf=TRUE)
plot(PTExercise.uf.cos.t20m, main="Uniform with cosine, truncation 20m", pdf=TRUE)
```
We see a fair degree of variability between analyses - reliable analysis of point transect data is more difficult than for line transect data. We see greater loss in precision from truncating data relative to line transect sampling, but if we do not truncate data, different models can give widely differing estimates.
# Wren data (Optional)
In the code provided below, each data set is loaded and detection functions selected in Buckland [-@buckland2006] are fitted.
```{r, echo=T, eval=T}
data("wren_5min")
data("wren_snapshot")
conversion.factor <- convert_units("meter", NULL, "hectare")
wren5min.uf.cos.t110 <- ds(data=wren_5min, key="unif", adjustment="cos",
transect="point", truncation=110,
convert_units=conversion.factor)
wrensnap.hr.cos.t110 <- ds(data=wren_snapshot, key="hr", adjustment=NULL,
transect="point", truncation=110,
convert_units=conversion.factor)
```
```{r, echo=F}
# Harvest results
n <- 2
wren.tab <- data.frame(Method=c("Five minute","Snapshot"), Density=rep(NA,n),
Lower.CI=rep(NA,n), Upper.CI=rep(NA,n))
get.results.f <- function(fit.model) { return(c(D=fit.model$dht$individuals$D$Estimate,
lCL=fit.model$dht$individuals$D$lcl,
uCL=fit.model$dht$individuals$D$ucl))
}
wren.tab[1,2:4] <- get.results.f(wren5min.uf.cos.t110)
wren.tab[2,2:4] <- get.results.f(wrensnap.hr.cos.t110)
knitr::kable(wren.tab, caption="Winter wren density estimates from 5 minute counts and snapshot moment.", digits=3)
```
## Probability density functions for Buckland's winter wren point transects
```{r, fig.height=4}
# Plot detection functions
par(mfrow=c(1,2))
plot(wren5min.uf.cos.t110, main="5 minute count")
plot(wrensnap.hr.cos.t110, main="Snapshot moment")
```
As the detection distance histograms indicate, winter wren showed evidence of observer avoidance, more than other species in the Montrave study. We show the detection function graph rather than the PDF to emphasise the evasive movement aspect of the data. If you conduct the goodness of fit test, using `gof_ds()`, you will find that the models still suitably fit the data.
# References