http://www.industrytap.com/making-heavens-open-cloud-seeding-drones/22011
(From Ramsey, F.L. and Schafer, D. W. (2013). The Statistical Sleuth, Brooks/Cole: Boston, MA.)
An experiment was conducted in southern Florida between 1968 and 1972 to test a hypothesis that massive injection of silver iodide (AgI) into cumulus clouds could lead to increased rainfall. On each of 52 days that were deemed suitable for cloud seeding, a random mechanism was used to decide whether to seed the target cloud on that day or to leave it unseeded as a control. An airplane flew through the cloud in both cases, since the experimenters and the pilot themselves were aware of whether on any particular day the seeding mechanism in the plane was loaded or not [with AgI]. Precipitation was measured as the total rain volume falling from the cloud base following the airplane seeding run, as measured by radar, in units of acre-feet.
Your task is to determine, using a subset of the data, whether cloud seeding had an effect on rainfall.
The R data file STAT1000Test1.RData contains the data frame RainSeed, which consists of rainfall measurements (Rainfall) for the two treatment conditions (Seeded and Unseeded). I have also extracted the rainfall amounts corresponding to these two conditions in separate vectors of the same name.
rm(list = ls()) # This removes any other objects in your workspace
load("S2_2016_STAT1000Test1.RData")
- Plot the rainfall data in two different ways that give you some sense of their distribution. Make sure your plots are appropriately labelled.
# Plot 1
boxplot(Rainfall ~ Treatment, data = RainSeed)

# Plot 2
hist(Seeded, ylab= 'rainfall', main = 'seeded rainfall histogram')


- Comment on the plots that you produced above. What, if any, noticeable features are present?
Answer: The boxplot optically suggests that seeded days have a higher rainfall, and also has a larger spread.
The histograms also support this, with data recorded of up to 2000 for seeded but only 1400 for unseeded.
There are obvious outliers for both data sets.
- Your boss asks you to carry out a \(t\)-test to determine whether seeding led to increased rainfall. Explain to your boss why a \(t\)-test might not be appropriate here.
Answer: The data has several obvious outliers which make a t-test innapropriate.
- Begrudgingly, you carry out the \(t\)-test.
- What hypotheses would you be testing?
Answer: The null hypothesis will be that both data sets have the same mean.
The alternative will be that seeded has a greater mean than unseeded.
- What are the results of the \(t\)-test?
t.test(Seeded, Unseeded, alternative ='greater')
Welch Two Sample t-test
data: Seeded and Unseeded
t = 1.0278, df = 23.637, p-value = 0.1572
alternative hypothesis: true difference in means is greater than 0
95 percent confidence interval:
-108.3462 Inf
sample estimates:
mean of x mean of y
347.5615 184.8000
- You explain to your boss that a rank-based nonparametric procedure might be more appropriate.
- Which one would you choose?
Answer:rank-sum test
- State the hypotheses being tested, carry out the test showing all intermediate steps, and state your conclusion.
Answer:Ho = uS ~= uU
Ha = uS > uU
# Carry out rank-based test here
U <- tapply(rank(RainSeed$Rainfall), RainSeed$Treatment, sum) - 13*7
U
Seeded Unseeded
137 32
pval <- pwilcox(32,13,13)
pval
[1] 0.003037517
- Check your result using the built-in R function for the test you’ve chosen.
# Check result here
wilcox.test(Seeded,Unseeded, alternative = 'greater')
Wilcoxon rank sum test
data: Seeded and Unseeded
W = 137, p-value = 0.003038
alternative hypothesis: true location shift is greater than 0
Answer:
- Does it yield a different result from the \(t\)-test? Explain why.
Answer: Yes, as the median is not as susceptible to outliers as the mean is (the rank will remain the same no matter how large or small certain outliers are)
- You decide to try a permutation test, but because there are many possible permutations, you randomly choose only 10000 of them for the test. The distribution (
PermDistMeanSample) is based on the difference ‘Seeded’ - ‘Unseeded’.
- What is the \(p\)-value of the permutation test?
# Carry out calculations here
meandiff <- mean(Seeded) - mean(Unseeded)
mean(PermDistMeanSample >= meandiff)
[1] 0.1728
- How might you modify the permutation test so that it yields a \(p\)-value closer to that of the rank-based test you performed above?
Answer:
LS0tDQp0aXRsZTogIlNUQVQxMDAwIFJlZ3Jlc3Npb24gJiBOb25wYXJhbWV0cmljIEluZmVyZW5jZSINCmF1dGhvcjogIlRlc3QgMSwgU2VtZXN0ZXIgMiwgMjAxNiINCmRhdGU6ICIyNiBBdWd1c3QgMjAxNiINCm91dHB1dDoNCiAgd29yZF9kb2N1bWVudDogZGVmYXVsdA0KICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQNCiAgaHRtbF9ub3RlYm9vazoNCiAgICBoaWdobGlnaHQ6IGhhZGRvY2sNCiAgICB0aGVtZTogcmVhZGFibGUNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gRkFMU0UsIGV2YWwgPSBGQUxTRSwgY29tbWVudD1OQSx0aWR5PVRSVUUpDQpgYGANCg0KDQohW10oU2VlZGluZy5wbmcpDQoNCmh0dHA6Ly93d3cuaW5kdXN0cnl0YXAuY29tL21ha2luZy1oZWF2ZW5zLW9wZW4tY2xvdWQtc2VlZGluZy1kcm9uZXMvMjIwMTENCg0KKEZyb20gUmFtc2V5LCBGLkwuIGFuZCBTY2hhZmVyLCBELiBXLiAoMjAxMykuICpUaGUgU3RhdGlzdGljYWwgU2xldXRoKiwgQnJvb2tzL0NvbGU6IEJvc3RvbiwgTUEuKQ0KDQpBbiBleHBlcmltZW50IHdhcyBjb25kdWN0ZWQgaW4gc291dGhlcm4gRmxvcmlkYSBiZXR3ZWVuIDE5NjggYW5kIDE5NzIgdG8gdGVzdCBhIGh5cG90aGVzaXMgdGhhdCBtYXNzaXZlIGluamVjdGlvbiBvZiBzaWx2ZXIgaW9kaWRlIChBZ0kpIGludG8gY3VtdWx1cyBjbG91ZHMgY291bGQgbGVhZCB0byBpbmNyZWFzZWQgcmFpbmZhbGwuIE9uIGVhY2ggb2YgNTIgZGF5cyB0aGF0IHdlcmUgZGVlbWVkIHN1aXRhYmxlIGZvciBjbG91ZCBzZWVkaW5nLCBhIHJhbmRvbSBtZWNoYW5pc20gd2FzIHVzZWQgdG8gZGVjaWRlIHdoZXRoZXIgdG8gc2VlZCB0aGUgdGFyZ2V0IGNsb3VkIG9uIHRoYXQgZGF5IG9yIHRvIGxlYXZlIGl0IHVuc2VlZGVkIGFzIGEgY29udHJvbC4gQW4gYWlycGxhbmUgZmxldyB0aHJvdWdoIHRoZSBjbG91ZCBpbiBib3RoIGNhc2VzLCBzaW5jZSB0aGUgZXhwZXJpbWVudGVycyBhbmQgdGhlIHBpbG90IHRoZW1zZWx2ZXMgd2VyZSBhd2FyZSBvZiB3aGV0aGVyIG9uIGFueSBwYXJ0aWN1bGFyIGRheSB0aGUgc2VlZGluZyBtZWNoYW5pc20gaW4gdGhlIHBsYW5lIHdhcyBsb2FkZWQgb3Igbm90IFt3aXRoIEFnSV0uIFByZWNpcGl0YXRpb24gd2FzIG1lYXN1cmVkIGFzIHRoZSB0b3RhbCByYWluIHZvbHVtZSBmYWxsaW5nIGZyb20gdGhlIGNsb3VkIGJhc2UgZm9sbG93aW5nIHRoZSBhaXJwbGFuZSBzZWVkaW5nIHJ1biwgYXMgbWVhc3VyZWQgYnkgcmFkYXIsIGluIHVuaXRzIG9mIGFjcmUtZmVldC4NCg0KWW91ciB0YXNrIGlzIHRvIGRldGVybWluZSwgdXNpbmcgYSBzdWJzZXQgb2YgdGhlIGRhdGEsIHdoZXRoZXIgY2xvdWQgc2VlZGluZyBoYWQgYW4gZWZmZWN0IG9uIHJhaW5mYWxsLg0KDQpUaGUgKlIqIGRhdGEgZmlsZSBgU1RBVDEwMDBUZXN0MS5SRGF0YWAgY29udGFpbnMgdGhlIGRhdGEgZnJhbWUgYFJhaW5TZWVkYCwgd2hpY2ggY29uc2lzdHMgb2YgcmFpbmZhbGwgbWVhc3VyZW1lbnRzIChgUmFpbmZhbGxgKSBmb3IgdGhlIHR3byB0cmVhdG1lbnQgY29uZGl0aW9ucyAoYFNlZWRlZGAgYW5kIGBVbnNlZWRlZGApLiBJIGhhdmUgYWxzbyBleHRyYWN0ZWQgdGhlIHJhaW5mYWxsIGFtb3VudHMgY29ycmVzcG9uZGluZyB0byB0aGVzZSB0d28gY29uZGl0aW9ucyBpbiBzZXBhcmF0ZSB2ZWN0b3JzIG9mIHRoZSBzYW1lIG5hbWUuDQoNCmBgYHtyfQ0Kcm0obGlzdCA9IGxzKCkpICMgVGhpcyByZW1vdmVzIGFueSBvdGhlciBvYmplY3RzIGluIHlvdXIgd29ya3NwYWNlDQpsb2FkKCJTMl8yMDE2X1NUQVQxMDAwVGVzdDEuUkRhdGEiKQ0KYGBgDQoNCihhKSBQbG90IHRoZSByYWluZmFsbCBkYXRhIGluIHR3byBkaWZmZXJlbnQgd2F5cyB0aGF0IGdpdmUgeW91IHNvbWUgc2Vuc2Ugb2YgdGhlaXIgZGlzdHJpYnV0aW9uLiBNYWtlIHN1cmUgeW91ciBwbG90cyBhcmUgYXBwcm9wcmlhdGVseSBsYWJlbGxlZC4NCg0KYGBge3J9DQojIFBsb3QgMQ0KYm94cGxvdChSYWluZmFsbCB+IFRyZWF0bWVudCwgZGF0YSA9IFJhaW5TZWVkKQ0KYGBgDQoNCmBgYHtyfQ0KIyBQbG90IDINCmhpc3QoU2VlZGVkLCB5bGFiPSAncmFpbmZhbGwnLCBtYWluID0gJ3NlZWRlZCByYWluZmFsbCBoaXN0b2dyYW0nKQ0KaGlzdChVbnNlZWRlZCkNCmBgYA0KDQooYikgQ29tbWVudCBvbiB0aGUgcGxvdHMgdGhhdCB5b3UgcHJvZHVjZWQgYWJvdmUuIFdoYXQsIGlmIGFueSwgbm90aWNlYWJsZSBmZWF0dXJlcyBhcmUgcHJlc2VudD8NCg0KQW5zd2VyOiBUaGUgYm94cGxvdCBvcHRpY2FsbHkgc3VnZ2VzdHMgdGhhdCBzZWVkZWQgZGF5cyBoYXZlIGEgaGlnaGVyIHJhaW5mYWxsLCBhbmQgYWxzbyBoYXMgYSBsYXJnZXIgc3ByZWFkLiANCg0KVGhlIGhpc3RvZ3JhbXMgYWxzbyBzdXBwb3J0IHRoaXMsIHdpdGggZGF0YSByZWNvcmRlZCBvZiB1cCB0byAyMDAwIGZvciBzZWVkZWQgYnV0IG9ubHkgMTQwMCBmb3IgdW5zZWVkZWQuDQoNClRoZXJlIGFyZSBvYnZpb3VzIG91dGxpZXJzIGZvciBib3RoIGRhdGEgc2V0cy4gDQoNCg0KKGMpIFlvdXIgYm9zcyBhc2tzIHlvdSB0byBjYXJyeSBvdXQgYSAkdCQtdGVzdCB0byBkZXRlcm1pbmUgd2hldGhlciBzZWVkaW5nIGxlZCB0byBpbmNyZWFzZWQgcmFpbmZhbGwuIEV4cGxhaW4gdG8geW91ciBib3NzIHdoeSBhICR0JC10ZXN0IG1pZ2h0IG5vdCBiZSBhcHByb3ByaWF0ZSBoZXJlLg0KDQpBbnN3ZXI6IFRoZSBkYXRhIGhhcyBzZXZlcmFsIG9idmlvdXMgb3V0bGllcnMgd2hpY2ggbWFrZSBhIHQtdGVzdCBpbm5hcHJvcHJpYXRlLg0KDQooZCkgQmVncnVkZ2luZ2x5LCB5b3UgY2Fycnkgb3V0IHRoZSAkdCQtdGVzdC4gDQoNCmBgYHtyfQ0KIyBDYXJyeSBvdXQgdC10ZXN0IGhlcmUNCg0KYGBgDQoNCiAgaS4gV2hhdCBoeXBvdGhlc2VzIHdvdWxkIHlvdSBiZSB0ZXN0aW5nPyANCiAgDQogIEFuc3dlcjogVGhlIG51bGwgaHlwb3RoZXNpcyB3aWxsIGJlIHRoYXQgYm90aCBkYXRhIHNldHMgaGF2ZSB0aGUgc2FtZSBtZWFuLg0KICANCiAgVGhlIGFsdGVybmF0aXZlIHdpbGwgYmUgdGhhdCBzZWVkZWQgaGFzIGEgZ3JlYXRlciBtZWFuIHRoYW4gdW5zZWVkZWQuDQogIA0KICBpaS4gV2hhdCBhcmUgdGhlIHJlc3VsdHMgb2YgdGhlICR0JC10ZXN0Pw0KICANCiANCmBgYHtyfQ0KIHQudGVzdChTZWVkZWQsIFVuc2VlZGVkLCBhbHRlcm5hdGl2ZSA9J2dyZWF0ZXInKQ0KYGBgDQoNCg0KKGUpIFlvdSBleHBsYWluIHRvIHlvdXIgYm9zcyB0aGF0IGEgcmFuay1iYXNlZCBub25wYXJhbWV0cmljIHByb2NlZHVyZSBtaWdodCBiZSBtb3JlIGFwcHJvcHJpYXRlLiANCg0KICBpLiBXaGljaCBvbmUgd291bGQgeW91IGNob29zZT8gDQogIA0KICBBbnN3ZXI6cmFuay1zdW0gdGVzdA0KICANCiAgaWkuIFN0YXRlIHRoZSBoeXBvdGhlc2VzIGJlaW5nIHRlc3RlZCwgY2Fycnkgb3V0IHRoZSB0ZXN0IHNob3dpbmcgYWxsIGludGVybWVkaWF0ZSBzdGVwcywgYW5kIHN0YXRlIHlvdXIgY29uY2x1c2lvbi4gDQogIA0KICBBbnN3ZXI6SG8gPSB1UyB+PSB1VQ0KICANCiAgSGEgPSB1UyA+IHVVDQoNCmBgYHtyfQ0KIyBDYXJyeSBvdXQgcmFuay1iYXNlZCB0ZXN0IGhlcmUNClUgPC0gdGFwcGx5KHJhbmsoUmFpblNlZWQkUmFpbmZhbGwpLCBSYWluU2VlZCRUcmVhdG1lbnQsIHN1bSkgLSAxMyo3DQpVDQoNCnB2YWwgPC0gcHdpbGNveCgzMiwxMywxMykNCg0KcHZhbA0KYGBgDQogIA0KICBpaWkuIENoZWNrIHlvdXIgcmVzdWx0IHVzaW5nIHRoZSBidWlsdC1pbiAqUiogZnVuY3Rpb24gZm9yIHRoZSB0ZXN0IHlvdSd2ZSBjaG9zZW4uDQogIA0KYGBge3J9DQojIENoZWNrIHJlc3VsdCBoZXJlDQp3aWxjb3gudGVzdChTZWVkZWQsVW5zZWVkZWQsIGFsdGVybmF0aXZlID0gJ2dyZWF0ZXInKQ0KYGBgDQogIA0KICBBbnN3ZXI6DQogIA0KICBpdi4gRG9lcyBpdCB5aWVsZCBhIGRpZmZlcmVudCByZXN1bHQgZnJvbSB0aGUgJHQkLXRlc3Q/IEV4cGxhaW4gd2h5Lg0KICANCiAgQW5zd2VyOiBZZXMsIGFzIHRoZSBtZWRpYW4gaXMgbm90IGFzIHN1c2NlcHRpYmxlIHRvIG91dGxpZXJzIGFzIHRoZSBtZWFuIGlzICh0aGUgcmFuayB3aWxsIHJlbWFpbiB0aGUgc2FtZSBubyBtYXR0ZXIgaG93IGxhcmdlIG9yIHNtYWxsIGNlcnRhaW4gb3V0bGllcnMgYXJlKQ0KDQoNCihmKSBZb3UgZGVjaWRlIHRvIHRyeSBhIHBlcm11dGF0aW9uIHRlc3QsIGJ1dCBiZWNhdXNlIHRoZXJlIGFyZSBtYW55IHBvc3NpYmxlIHBlcm11dGF0aW9ucywgeW91IHJhbmRvbWx5IGNob29zZSBvbmx5IDEwMDAwIG9mIHRoZW0gZm9yIHRoZSB0ZXN0LiBUaGUgZGlzdHJpYnV0aW9uIChgUGVybURpc3RNZWFuU2FtcGxlYCkgaXMgYmFzZWQgb24gdGhlIGRpZmZlcmVuY2UgJ1NlZWRlZCcgLSAnVW5zZWVkZWQnLg0KDQogIGkuIFdoYXQgaXMgdGhlICRwJC12YWx1ZSBvZiB0aGUgcGVybXV0YXRpb24gdGVzdD8NCiAgDQpgYGB7cn0NCiMgQ2Fycnkgb3V0IGNhbGN1bGF0aW9ucyBoZXJlDQoNCm1lYW5kaWZmIDwtIG1lYW4oU2VlZGVkKSAtIG1lYW4oVW5zZWVkZWQpDQptZWFuKFBlcm1EaXN0TWVhblNhbXBsZSA+PSBtZWFuZGlmZikNCg0KYGBgDQogIA0KICBpaS4gSG93IG1pZ2h0IHlvdSBtb2RpZnkgdGhlIHBlcm11dGF0aW9uIHRlc3Qgc28gdGhhdCBpdCB5aWVsZHMgYSAkcCQtdmFsdWUgY2xvc2VyIHRvIHRoYXQgb2YgdGhlIHJhbmstYmFzZWQgdGVzdCB5b3UgcGVyZm9ybWVkIGFib3ZlPw0KICANCiAgQW5zd2VyOg==