The goal of this is to make the final images for the Rolland et al. health paper. I’ll print them within the document, but also make individual pdfs of them - as before.
Here is the list of figures we’ll build.
Change for this round is to remove data from 2009 in the post hoc analysis.
And then a supplementary plot: 1. Illustration of 3 year calving cycle
So let’s get started first by loading in the data:
n.b. This will be made in a separate file, as I already have a dedicated script for this.
This figure is the plot of EG1014 with these alterations:
In the case of Staccato, she had three events that we’re plotting, none of which had gear carrying:
| Event Number | Beginning of Window | End of Window | Severity |
|---|---|---|---|
| 1 | 1975-07-06 | 1977-03-28 | Minor |
| 2 | 1995-04-03 | 1996-03-01 | Minor |
| 3 | 1996-04-09 | 1999-01-17 | Minor |
For the second and third events, you can see that there is no gap between them (at the scale at which we are plotting). So I think we just happen to have an issue where the events are indeed to close that the size of the circle overlaps. I can change the size of the circle to lessen that effect, or artificially shorten the window to aid detail. Or we just note it in the figure caption.
This is sub-population level health, specifically the time series images but reworked as two multi-panel figures. The structure/content of these will echo figure 4, with adult males, old & young juveniles in one figure, and all the females in the other figure.
## quartz_off_screen
## 2
## quartz_off_screen
## 2
This is the new plot of population & sub-population level health.
## quartz_off_screen
## 2
This is the boxplot of sub-population level health.
## quartz_off_screen
## 2
This is population level health.
## quartz_off_screen
## 2
## quartz_off_screen
## 2
We can also test to see if there is a correlation between the NAO and the health values:
library(stats)
ccf(hplot$health, hplot$naoVal, na.action = na.pass, lag.max = 36, ylab = 'Cross-correlation')
This is the Available-resting vs available-successful plot.
We want to look at the summary of the random effects analysis for the test of health of all available females in one year and the next to see their pregnancy status in the following year:
## Loading required package: Matrix
## Loading required package: Rcpp
## Visit http://strengejacke.de/sjPlot for illustrative examples of sjPlot-functions.
## Linear mixed model fit by REML ['lmerMod']
## Formula: health ~ svec + (1 | year)
## Data: allfemc
##
## REML criterion at convergence: 4993.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6255 -0.3724 0.2433 0.6512 1.8694
##
## Random effects:
## Groups Name Variance Std.Dev.
## year (Intercept) 10.42 3.227
## Residual 99.18 9.959
## Number of obs: 668, groups: year, 24
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 73.2262 0.8540 85.75
## svec 1.1783 0.8737 1.35
##
## Correlation of Fixed Effects:
## (Intr)
## svec -0.430
## $year
## (Intercept)
## 1985 1.43210596
## 1986 3.63646391
## 1987 3.38404841
## 1988 3.46482612
## 1989 3.34101180
## 1990 0.97651045
## 1991 0.08362022
## 1992 1.32077154
## 1993 1.99777092
## 1994 1.78273131
## 1995 1.16725125
## 1996 1.99698052
## 1997 -2.94883824
## 1998 -3.32867047
## 1999 -1.50048748
## 2000 -0.25114622
## 2001 0.73558421
## 2002 0.33495588
## 2003 1.09678963
## 2004 -3.14616667
## 2005 -5.82313415
## 2006 -4.54065555
## 2007 -4.50283891
## 2008 -0.70948444
## Plotting random effects...
## Plotting random effects...
## quartz_off_screen
## 2
## quartz_off_screen
## 2
## quartz_off_screen
## 2
This is the supplemental plot of the calving cycle. Should we consider this in colour since it will be a supplemental doc?
## quartz_off_screen
## 2
The idea here is to simply tally the health of the animals in the nulliparous group. It’s a relatively small handful of animals, so I’ll just start with a density plot that summarises them, and then a faceted density plot that has all the animals individually plotted.
nullhealth <- newhgibbsNonRepFem / ng
nhealth <- numeric(0)
for(i in 1:nrow(nullfem)){
dsub <- nullhealth[which(row.names(nullhealth) == nullfem[i, 'EGNo']), ]
df <- data.frame(id = nullfem$EGNo[i], health = dsub[c(nullfem[i, 'MinDateInt']:nullfem[i, 'MaxDateInt'])])
nhealth <- rbind(nhealth, df)
}
# hthresh <- 32.5
# mpophealth[mpophealth < hthresh] <- NA
summary(nhealth)
## id health
## Min. :1027 Min. : 0.04176
## 1st Qu.:1267 1st Qu.:70.04698
## Median :1706 Median :78.73716
## Mean :1621 Mean :74.12051
## 3rd Qu.:1968 3rd Qu.:82.08846
## Max. :2042 Max. :88.91673
p <- ggplot(nhealth, aes(x = health, y = ..density..))+
geom_histogram(fill = 'cornsilk', colour = 'grey60', size = 0.2)+
geom_density()+
# facet_grid(group ~ .)+
labs(x = 'Estimated Health')+
theme_bw()
p
pfac <- p + facet_wrap(~ id, ncol = 3, scales = "free_y")
pfac
Ok, this is in response to one of the reviewers’ requests. What I’m tallying is the total number of animals, sightings, and then the number of missing data observations for each of the body and skin data (we only imputed health for these). I’m not sure what is the best way to present these, so this is my first start. Open to suggestions.
tobs <- lastSight - firstSight
sum(tobs)
## [1] 102005
| Metric | Value |
|---|---|
| Total No. of Animals | 4 |
| Total No. of Sightings | 48529 |
| Observations of Body Condition | 8,963 |
| % Missing Observations - Body | 91.2131758 |
| Observations of Skin Condition | 13,397 |
| % Missing Observations - Skin | 86.8663301 |
We also want the summaries of the numbers of animals in each of the different groups. That is shown here:
| Pop Category | Number Unique Animals |
|---|---|
| Young Juveniles | 292 |
| Old Juveniles | 255 |
| Adult Males | 184 |
| Pregnant Females | 150 |
| Available Females | 158 |
| Resting Females | 156 |
| Lactating Females | 156 |