Results for Health paper - Final Images

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.

  1. Photos of a whale in good vs poor health to illustrate visual health assessment parameters. (Roz will provide these.)
  2. Time series of observed and estimated health for EG# 1014.
  3. Estimated health profiles for population subgroups (1985-2008). The sample sizes are given in the top panel.
  4. A coarse overview plot of all sub-group health on a single panel.
  5. Boxplot of sub-group health (1980-2008).
  6. Population health
  7. Mean health of resting and available females successfully calved versus those that did not successfully calve.

And then a supplementary plot: 1. Illustration of 3 year calving cycle

So let’s get started first by loading in the data:

Figure 2

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:

  1. Decrease the “anomaly” panel by ~ ¼,
  2. change “calving to “calf” so it fits better in the panel label.
  3. For entanglement window, i.e. the time frame during which the animal became entangled, instead of the dashed line, use the light grey line like in the calving plot. Similarly, for the time carrying gear, use the dark grey line (sensu the calving plot).

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.

Figure 3

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

Figure 4

This is the new plot of population & sub-population level health.

## quartz_off_screen 
##                 2

Figure 5

This is the boxplot of sub-population level health.

## quartz_off_screen 
##                 2

Figure 6

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')

Figure 7

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

Figure S1

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

Health of Nulliparous Females

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

Tally of Data

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