case2101: Island Size and Bird Extinctions

In Sleuth3: Data Sets from Ramsey and Schafer's "Statistical Sleuth (3rd Ed)"

Description

In a study of the Krunnit Islands archipelago, researchers presented results of extensive bird surveys taken over four decades. They visited each island several times, cataloguing species. If a species was found on a specific island in 1949, it was considered to be at risk of extinction for the next survey of the island in 1959. If it was not found in 1959, it was counted as an “extinction”, even though it might reappear later. This data frame contains data on island size, number of species at risk to become extinct and number of extinctions.

Usage

case2101

Format

A data frame with 18 observations on the following 4 variables.

Island

Name of Island

Area

Area of Island

AtRisk

Number of species at risk

Extinct

Number of extinctions

Details

Scientists agree that preserving certain habitats in their natural states is necessary to slow the accelerating rate of species extinctions. But they are divided on how to construct such reserves. Given a finite amount of available land, is it better to have many small reserves or a few large one? Central to the debate on this question are observational studies of what has happened in island archipelagos, where nearly the same fauna tries to survive on islands of different sizes.

Source

Ramsey, F.L. and Schafer, D.W. (2013). The Statistical Sleuth: A Course in Methods of Data Analysis (3rd ed), Cengage Learning.

References

Väisänen, R.A. and Järvinen, O. (1977). Dynamics of Protected Bird Communities in a Finnish Archipelago, Journal of Animal Ecology 46: 891–908.

Examples

str(case2101)
attach(case2101)
      
## EXPLORATION AND MODEL BUILDING 
proportionExtinct <- Extinct/AtRisk
oddsExtinct  <- proportionExtinct/(1 - proportionExtinct)
logitExtinct <- log(oddsExtinct)   # Logit = Log Odds
logArea <- log(Area)
plot(logitExtinct ~ logArea)

binResponse  <- cbind(Extinct,AtRisk-Extinct)
myGlm1 <- glm(binResponse ~ logArea, family=binomial)
summary(myGlm1)
logArea2 <- logArea^2
myGlm2 <- update(myGlm1, ~ . + logArea2)
summary(myGlm2) # p-value for quadratic term: 0.77


## INFERENCE AND INTERPRETATION
myGlm3 <- update(myGlm1, ~ . - logArea)
anova(myGlm3, myGlm1) # Drop in deviance statistic = 33.277 on 1 d.f.
1 - pchisq(33.277,1) # p-value = 7.992234e-09
beta <- myGlm1$coef
1 - 2^beta[2]  # 0.1861153
1 - 2^confint(myGlm1,2) #0.2462041 0.1247743 
# Interpretation: Associated with each doubling of island area is a 19% 
# reduction in the odds of extinction (95% confidence interval: 12% to 25% 
# reduction).


## GRAPHICAL DISPLAY FOR PRESENTATION 
plot(oddsExtinct ~ Area, log="xy", ylab="Observed Odds of Extinction; log scale",
  xlab=expression(paste("Island Area (km"^"2","); log scale")),
  main="Extinctions of Bird Species in the Krunnit Island Archipelago",
  pch=21, lwd=2, bg="green", cex=2)   # Plot odds of extinction vs island area
dummyArea <- seq(min(Area),max(Area),length=50)
lp <- beta[1] + beta[2]*log(dummyArea)
odds <- exp(lp)
lines(odds ~ dummyArea,lwd=2)

plot(proportionExtinct ~ Area, log="xy", 
  ylab="Proportions of 1949 Species not Found in 1959",
  xlab=expression(paste("Island Area (km"^"2","); log scale")),
  main="Proportions of 1949 Bird Species Extinct in 1959 on 18 Krunnit Archipelago Islands",
  pch=21, lwd=2, bg="green", cex=2)  # Plot probability of extinction vs area
dummyArea  <- seq(min(Area),max(Area),length=50)
lp <- beta[1] + beta[2]*log(dummyArea)
myProbability <- exp(lp)/(1 + exp(lp))
lines(myProbability ~ dummyArea,lwd=2,col="blue")
legend(.08,.055,legend="Estimated Probability of Extinction",lty=1,lwd=2,col="blue")

detach(case2101)

Example output

'data.frame':	18 obs. of  4 variables:
 $ Island : Factor w/ 18 levels "Hietakraasukka",..: 16 6 11 2 1 3 4 7 15 12 ...
 $ Area   : num  185.8 105.8 30.7 8.5 4.8 ...
 $ AtRisk : int  75 67 66 51 28 20 43 31 28 32 ...
 $ Extinct: int  5 3 10 6 3 4 8 3 5 6 ...

Call:
glm(formula = binResponse ~ logArea, family = binomial)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.71726  -0.67722   0.09726   0.48365   1.49545  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -1.19620    0.11845 -10.099  < 2e-16 ***
logArea     -0.29710    0.05485  -5.416 6.08e-08 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 45.338  on 17  degrees of freedom
Residual deviance: 12.062  on 16  degrees of freedom
AIC: 75.394

Number of Fisher Scoring iterations: 4


Call:
glm(formula = binResponse ~ logArea + logArea2, family = binomial)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.70543  -0.64658   0.02695   0.49182   1.47740  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -1.21118    0.12971  -9.337  < 2e-16 ***
logArea     -0.31780    0.09047  -3.513 0.000444 ***
logArea2     0.00699    0.02430   0.288 0.773642    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 45.338  on 17  degrees of freedom
Residual deviance: 11.979  on 15  degrees of freedom
AIC: 77.311

Number of Fisher Scoring iterations: 4

Analysis of Deviance Table

Model 1: binResponse ~ 1
Model 2: binResponse ~ logArea
  Resid. Df Resid. Dev Df Deviance
1        17     45.338            
2        16     12.062  1   33.277
[1] 7.992234e-09
  logArea 
0.1861153 
Waiting for profiling to be done...
    2.5 %    97.5 % 
0.2462041 0.1247743 

Sleuth3 documentation built on May 2, 2019, 6:41 a.m.