QUESTION 65: The data file contains valueas for breast cnxcer mortality from 1950 to 1960(y) and the adult white female population in 1960(x) for 301 counties in North Carolina, South Carolina and Georgia.

Reading in the Cancer Data

Cancer <- read.csv(url("http://statistics.csueastbay.edu/~jkerr/STAT65012/cancer.txt"), header=FALSE, col.names=c("Mortality","Female"))
N <- length(Cancer$Mortality)

Part (a): Make a histogram of the population values for cancer mortality.

graphics.off()
x11()
hist(Cancer$Mortality, freq=FALSE, main='Histogram of the Population Values for Cancer Mortality.')

Part (b): What are the population mean and total cancer mortality?

       What are the population variance and the standard deviation?
cat('(b), The Mortality Population mean is ', mean(Cancer$Mortality), 'whereas the Total is ', sum(Cancer$Mortality), 'with variance ', var(Cancer$Mortality), 'and standard devation ', sd(Cancer$Mortality), '\n')
(b), The Mortality Population mean is  39.85714 whereas the Total is  11997 with variance  2598.736 and standard devation  50.9778 

Part (c): Simulate the sampling distribution of the mean of a sample of 25 observations of cancer mortality.

c = numeric(100)
for (i in 1:100){
    c[i] = mean(sample(Cancer$Mortality, 25, replace=FALSE))
}
x11()
hist(c, freq=FALSE, main='Sampling Distribution of the Mean')

Part (d): Draw a simple random sample of size 25 and use it to estimate the mean and total cancer mortality.

samp = sample(Cancer$Mortality, 25, replace=FALSE)
cat('(d), The mean estimate is ', mean(samp), 'and the estimate of the total is ', sum(samp), '\n')
(d), The mean estimate is  44.16 and the estimate of the total is  1104 

Part (e): Estimate the population variance and standard deviation from the sample of (d)

cat('(e), the variance estimate is ', var(samp), 'and the estimate of the standard deviation is ', sd(samp), '\n')
(e), the variance estimate is  2772.057 and the estimate of the standard deviation is  52.65032 

Part (f): Form 95% confidence intervals for the population mean and the total from the sample of (d).

      Do the intervals cover the population values?
      
sdxbar = sqrt(var(samp)/25*(1-25/301))
sdxbar
[1] 9.695443
cat('((f), \n','A CI for the mean is \n (', mean(samp) -1.96*sdxbar,',', mean(samp)+1.96*sdxbar, ') \n')
((f), 
 A CI for the mean is 
 ( 24.39675 , 63.92325 ) 
cat('A CI for the total is \n (', 301*mean(samp) -1.96*301*sdxbar,',', 301*mean(samp)+1.96*301*sdxbar, ') \n')
A CI for the total is 
 ( 7343.421 , 19240.9 ) 

Part (g) : Repeat parts (d) through (f) for a sample size 100

samp = sample(Cancer$Mortality, 100, replace=FALSE)
samp
  [1]   6  11  12  13  37  34  51   3  59   9  17   0  35 236  46
 [16] 267   1  91  33  20  69  47 145   6  13  13   3  60  37  11
 [31]  66   5  72  12  27   4  41  90   8 244  29  24  11  24  27
 [46]  23  15  55  17  30  14  88  15  16  77  20 117  73  11  36
 [61]   3  12   4   9  27  32  42  30  10  26  16  41   4  17   8
 [76] 163  45  21  18   7  15  10  12  66  30  37   5 127   1  23
 [91]   5  12  11 103  12  16  63 167  70  27
cat('(g), \n the estimate of the mean is ', mean(samp), 'and the estimate of the total is ', sum(samp), '\n')
(g), 
 the estimate of the mean is  40.23 and the estimate of the total is  4023 
cat('The variance estimate is ', var(samp), 'and the estimate of the standard deviation is ', sd(samp), '\n')
The variance estimate is  2562.906 and the estimate of the standard deviation is  50.62515 
sdxbar = sqrt(var(samp)/25*(1-25/301))
sdxbar
[1] 9.695443
cat('A CI for the mean is \n (', mean(samp) -1.96*sdxbar,',', mean(samp)+1.96*sdxbar, ') \n')
A CI for the mean is 
 ( 21.22693 , 59.23307 ) 
cat('A CI for the total is \n (', 301*mean(samp) -1.96*301*sdxbar,',', 301*mean(samp)+1.96*301*sdxbar, ') \n')
A CI for the total is 
 ( 6389.307 , 17829.15 ) 

Part (i): Simulate the sampling distribution ratio estimators of mean cancer mortality based on a simple random sample size of 25. Compare this result to that of Part (c)

d = e = numeric(100)
for (i in 1:100){
    j = sample(1:N, 25 , replace=FALSE)
    d[i] = mean(Cancer$Mortality[j])/mean(Cancer$Female[j])*mean(Cancer$Female)
}
d
  [1] 38.15240 40.89760 43.95836 40.58202 39.41910 38.41363
  [7] 39.33495 39.32256 41.92111 40.31226 42.99267 41.21637
 [13] 42.60476 43.68683 35.95339 41.37712 39.32311 41.03023
 [19] 42.34080 35.62929 32.80578 44.05012 44.47511 38.74844
 [25] 40.15742 42.20169 43.51888 38.88297 38.51299 37.08890
 [31] 39.70523 40.74819 39.55563 38.25036 39.49280 42.02282
 [37] 42.19977 39.36714 38.04093 38.99459 36.27532 37.67923
 [43] 41.59181 39.44719 38.14552 39.09272 43.16982 43.59040
 [49] 40.80089 40.28861 38.74162 40.98429 41.96745 40.39247
 [55] 38.81621 40.18486 38.95019 41.59613 41.40039 39.43862
 [61] 35.63055 38.67316 43.71671 42.50469 41.03244 40.78019
 [67] 38.80527 40.10426 35.68050 38.91007 40.20016 39.35046
 [73] 37.27795 40.40142 45.52198 44.12525 36.97069 39.55491
 [79] 39.26207 34.83981 40.98078 39.12503 39.34630 44.57584
 [85] 37.85070 36.68134 34.66507 40.98935 38.11079 40.84179
 [91] 39.84139 40.76611 40.94539 41.95381 39.55925 37.51121
 [97] 41.57982 41.99816 36.61487 40.63078
cat('The new sampling distribution appears much less variable than that of part (c) \n')
The new sampling distribution appears much less variable than that of part (c) 

Part (j) : Draw a simple random sample of size 25 and estimate the population mean and total cancer mortality by calculating ratio estimates. How do these estimates compare to those formed in the usual way in part (d) from the same data?

j = sample(1:N, 25 , replace=FALSE)
j
 [1] 110 257 115 279  45  66 187 265  42 121 289  53 260 155 136
[16] 191 237  10  50 100 148 185 249   1 131
ratio.mean =  mean(Cancer$Mortality[j])/mean(Cancer$Female[j])*mean(Cancer$Female)
ratio.mean
[1] 38.02448
ratio.total = mean(Cancer$Mortality[j])/mean(Cancer$Female[j])*mean(Cancer$Female)*N
ratio.total
[1] 11445.37
partd.mean = mean(Cancer$Mortality[j])
partd.mean
[1] 34.72
partd.total = partd.mean*N
partd.total
[1] 10450.72
cat('The estimates are close but both estimates based on the ratio are larger than their part (d) counterparts, resulting in estimates closer to the population values \n')
The estimates are close but both estimates based on the ratio are larger than their part (d) counterparts, resulting in estimates closer to the population values 
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoqKlFVRVNUSU9OIDY1OiBUaGUgZGF0YSBmaWxlIGNvbnRhaW5zIHZhbHVlYXMgZm9yIGJyZWFzdCBjbnhjZXIgbW9ydGFsaXR5IGZyb20gMTk1MCB0byAxOTYwKHkpIGFuZCB0aGUgYWR1bHQgd2hpdGUgZmVtYWxlIHBvcHVsYXRpb24gaW4gMTk2MCh4KSBmb3IgMzAxIGNvdW50aWVzIGluIE5vcnRoIENhcm9saW5hLCBTb3V0aCBDYXJvbGluYSBhbmQgR2VvcmdpYS4qKiANCg0KKipSZWFkaW5nIGluIHRoZSBDYW5jZXIgRGF0YSoqDQoNCmBgYHtyfQ0KQ2FuY2VyIDwtIHJlYWQuY3N2KHVybCgiaHR0cDovL3N0YXRpc3RpY3MuY3N1ZWFzdGJheS5lZHUvfmprZXJyL1NUQVQ2NTAxMi9jYW5jZXIudHh0IiksIGhlYWRlcj1GQUxTRSwgY29sLm5hbWVzPWMoIk1vcnRhbGl0eSIsIkZlbWFsZSIpKQ0KYGBgDQoNCmBgYHtyfQ0KTiA8LSBsZW5ndGgoQ2FuY2VyJE1vcnRhbGl0eSkNCmBgYA0KDQoNCiNQYXJ0IChhKTogTWFrZSBhIGhpc3RvZ3JhbSBvZiB0aGUgcG9wdWxhdGlvbiB2YWx1ZXMgZm9yIGNhbmNlciBtb3J0YWxpdHkuDQoNCmBgYHtyfQ0KZ3JhcGhpY3Mub2ZmKCkNCmBgYA0KDQpgYGB7cn0NCngxMSgpDQpgYGANCg0KYGBge3J9DQpoaXN0KENhbmNlciRNb3J0YWxpdHksIGZyZXE9RkFMU0UsIG1haW49J0hpc3RvZ3JhbSBvZiB0aGUgUG9wdWxhdGlvbiBWYWx1ZXMgZm9yIENhbmNlciBNb3J0YWxpdHkuJykNCmBgYA0KDQoNCiNQYXJ0IChiKTogV2hhdCBhcmUgdGhlIHBvcHVsYXRpb24gbWVhbiBhbmQgdG90YWwgY2FuY2VyIG1vcnRhbGl0eT8NCiAgICAgICAgICAgV2hhdCBhcmUgdGhlIHBvcHVsYXRpb24gdmFyaWFuY2UgYW5kIHRoZSBzdGFuZGFyZCBkZXZpYXRpb24/DQoNCmBgYHtyfQ0KY2F0KCcoYiksIFRoZSBNb3J0YWxpdHkgUG9wdWxhdGlvbiBtZWFuIGlzICcsIG1lYW4oQ2FuY2VyJE1vcnRhbGl0eSksICd3aGVyZWFzIHRoZSBUb3RhbCBpcyAnLCBzdW0oQ2FuY2VyJE1vcnRhbGl0eSksICd3aXRoIHZhcmlhbmNlICcsIHZhcihDYW5jZXIkTW9ydGFsaXR5KSwgJ2FuZCBzdGFuZGFyZCBkZXZhdGlvbiAnLCBzZChDYW5jZXIkTW9ydGFsaXR5KSwgJ1xuJykNCmBgYA0KDQoNCiNQYXJ0IChjKTogU2ltdWxhdGUgdGhlIHNhbXBsaW5nIGRpc3RyaWJ1dGlvbiBvZiB0aGUgbWVhbiBvZiBhIHNhbXBsZSBvZiAyNSBvYnNlcnZhdGlvbnMgb2YgY2FuY2VyIG1vcnRhbGl0eS4NCg0KYGBge3J9DQpjID0gbnVtZXJpYygxMDApDQpmb3IgKGkgaW4gMToxMDApew0KCWNbaV0gPSBtZWFuKHNhbXBsZShDYW5jZXIkTW9ydGFsaXR5LCAyNSwgcmVwbGFjZT1GQUxTRSkpDQp9DQp4MTEoKQ0KaGlzdChjLCBmcmVxPUZBTFNFLCBtYWluPSdTYW1wbGluZyBEaXN0cmlidXRpb24gb2YgdGhlIE1lYW4nKQ0KYGBgDQoNCg0KI1BhcnQgKGQpOiBEcmF3IGEgc2ltcGxlIHJhbmRvbSBzYW1wbGUgb2Ygc2l6ZSAyNSBhbmQgdXNlIGl0IHRvIGVzdGltYXRlIHRoZSBtZWFuIGFuZCB0b3RhbCBjYW5jZXIgbW9ydGFsaXR5Lg0KDQpgYGB7cn0NCnNhbXAgPSBzYW1wbGUoQ2FuY2VyJE1vcnRhbGl0eSwgMjUsIHJlcGxhY2U9RkFMU0UpDQpgYGANCg0KYGBge3J9DQpjYXQoJyhkKSwgVGhlIG1lYW4gZXN0aW1hdGUgaXMgJywgbWVhbihzYW1wKSwgJ2FuZCB0aGUgZXN0aW1hdGUgb2YgdGhlIHRvdGFsIGlzICcsIHN1bShzYW1wKSwgJ1xuJykNCmBgYA0KDQoNCiNQYXJ0IChlKTogRXN0aW1hdGUgdGhlIHBvcHVsYXRpb24gdmFyaWFuY2UgYW5kIHN0YW5kYXJkIGRldmlhdGlvbiBmcm9tIHRoZSBzYW1wbGUgb2YgKGQpDQoNCmBgYHtyfQ0KY2F0KCcoZSksIHRoZSB2YXJpYW5jZSBlc3RpbWF0ZSBpcyAnLCB2YXIoc2FtcCksICdhbmQgdGhlIGVzdGltYXRlIG9mIHRoZSBzdGFuZGFyZCBkZXZpYXRpb24gaXMgJywgc2Qoc2FtcCksICdcbicpDQpgYGANCg0KDQojUGFydCAoZik6IEZvcm0gOTUlIGNvbmZpZGVuY2UgaW50ZXJ2YWxzIGZvciB0aGUgcG9wdWxhdGlvbiBtZWFuIGFuZCB0aGUgdG90YWwgZnJvbSB0aGUgc2FtcGxlIG9mIChkKS4NCiAgICAgICAgICBEbyB0aGUgaW50ZXJ2YWxzIGNvdmVyIHRoZSBwb3B1bGF0aW9uIHZhbHVlcz8NCiAgICAgICAgICANCmBgYHtyfQ0Kc2R4YmFyID0gc3FydCh2YXIoc2FtcCkvMjUqKDEtMjUvMzAxKSkNCmBgYA0KDQpgYGB7cn0NCnNkeGJhcg0KYGBgDQoNCmBgYHtyfQ0KY2F0KCcoKGYpLCBcbicsJ0EgQ0kgZm9yIHRoZSBtZWFuIGlzIFxuICgnLCBtZWFuKHNhbXApIC0xLjk2KnNkeGJhciwnLCcsIG1lYW4oc2FtcCkrMS45NipzZHhiYXIsICcpIFxuJykNCmBgYA0KDQpgYGB7cn0NCmNhdCgnQSBDSSBmb3IgdGhlIHRvdGFsIGlzIFxuICgnLCAzMDEqbWVhbihzYW1wKSAtMS45NiozMDEqc2R4YmFyLCcsJywgMzAxKm1lYW4oc2FtcCkrMS45NiozMDEqc2R4YmFyLCAnKSBcbicpDQpgYGANCg0KDQojUGFydCAoZykgOiBSZXBlYXQgcGFydHMgKGQpIHRocm91Z2ggKGYpIGZvciBhIHNhbXBsZSBzaXplIDEwMA0KDQpgYGB7cn0NCnNhbXAgPSBzYW1wbGUoQ2FuY2VyJE1vcnRhbGl0eSwgMTAwLCByZXBsYWNlPUZBTFNFKQ0KYGBgDQoNCmBgYHtyfQ0Kc2FtcA0KYGBgDQoNCmBgYHtyfQ0KY2F0KCcoZyksIFxuIHRoZSBlc3RpbWF0ZSBvZiB0aGUgbWVhbiBpcyAnLCBtZWFuKHNhbXApLCAnYW5kIHRoZSBlc3RpbWF0ZSBvZiB0aGUgdG90YWwgaXMgJywgc3VtKHNhbXApLCAnXG4nKQ0KYGBgDQoNCmBgYHtyfQ0KY2F0KCdUaGUgdmFyaWFuY2UgZXN0aW1hdGUgaXMgJywgdmFyKHNhbXApLCAnYW5kIHRoZSBlc3RpbWF0ZSBvZiB0aGUgc3RhbmRhcmQgZGV2aWF0aW9uIGlzICcsIHNkKHNhbXApLCAnXG4nKQ0KYGBgDQoNCmBgYHtyfQ0Kc2R4YmFyID0gc3FydCh2YXIoc2FtcCkvMjUqKDEtMjUvMzAxKSkNCmBgYA0KDQpgYGB7cn0NCnNkeGJhcg0KYGBgDQoNCmBgYHtyfQ0KY2F0KCdBIENJIGZvciB0aGUgbWVhbiBpcyBcbiAoJywgbWVhbihzYW1wKSAtMS45NipzZHhiYXIsJywnLCBtZWFuKHNhbXApKzEuOTYqc2R4YmFyLCAnKSBcbicpDQpgYGANCg0KYGBge3J9DQpjYXQoJ0EgQ0kgZm9yIHRoZSB0b3RhbCBpcyBcbiAoJywgMzAxKm1lYW4oc2FtcCkgLTEuOTYqMzAxKnNkeGJhciwnLCcsIDMwMSptZWFuKHNhbXApKzEuOTYqMzAxKnNkeGJhciwgJykgXG4nKQ0KYGBgDQoNCg0KI1BhcnQgKGkpOiBTaW11bGF0ZSB0aGUgc2FtcGxpbmcgZGlzdHJpYnV0aW9uIHJhdGlvIGVzdGltYXRvcnMgb2YgbWVhbiBjYW5jZXIgbW9ydGFsaXR5ICBiYXNlZCBvbiBhIHNpbXBsZSByYW5kb20gc2FtcGxlIHNpemUgb2YgMjUuIENvbXBhcmUgdGhpcyByZXN1bHQgdG8gdGhhdCBvZiBQYXJ0IChjKQ0KDQpgYGB7cn0NCmQgPSBlID0gbnVtZXJpYygxMDApDQpmb3IgKGkgaW4gMToxMDApew0KCWogPSBzYW1wbGUoMTpOLCAyNSAsIHJlcGxhY2U9RkFMU0UpDQoJZFtpXSA9IG1lYW4oQ2FuY2VyJE1vcnRhbGl0eVtqXSkvbWVhbihDYW5jZXIkRmVtYWxlW2pdKSptZWFuKENhbmNlciRGZW1hbGUpDQp9DQpgYGANCg0KYGBge3J9DQpkDQpgYGANCg0KYGBge3J9DQpjYXQoJ1RoZSBuZXcgc2FtcGxpbmcgZGlzdHJpYnV0aW9uIGFwcGVhcnMgbXVjaCBsZXNzIHZhcmlhYmxlIHRoYW4gdGhhdCBvZiBwYXJ0IChjKSBcbicpDQpgYGANCg0KDQojUGFydCAoaikgOiBEcmF3IGEgc2ltcGxlIHJhbmRvbSBzYW1wbGUgb2Ygc2l6ZSAyNSBhbmQgZXN0aW1hdGUgdGhlIHBvcHVsYXRpb24gbWVhbiBhbmQgdG90YWwgY2FuY2VyIG1vcnRhbGl0eSBieSBjYWxjdWxhdGluZyByYXRpbyBlc3RpbWF0ZXMuIEhvdyBkbyB0aGVzZSBlc3RpbWF0ZXMgY29tcGFyZSB0byB0aG9zZSBmb3JtZWQgaW4gdGhlIHVzdWFsIHdheSBpbiBwYXJ0IChkKSBmcm9tIHRoZSBzYW1lIGRhdGE/DQoNCmBgYHtyfQ0KaiA9IHNhbXBsZSgxOk4sIDI1ICwgcmVwbGFjZT1GQUxTRSkNCmBgYA0KDQpgYGB7cn0NCmoNCmBgYA0KDQpgYGB7cn0NCnJhdGlvLm1lYW4gPSAgbWVhbihDYW5jZXIkTW9ydGFsaXR5W2pdKS9tZWFuKENhbmNlciRGZW1hbGVbal0pKm1lYW4oQ2FuY2VyJEZlbWFsZSkNCmBgYA0KDQpgYGB7cn0NCnJhdGlvLm1lYW4NCmBgYA0KDQpgYGB7cn0NCnJhdGlvLnRvdGFsID0gbWVhbihDYW5jZXIkTW9ydGFsaXR5W2pdKS9tZWFuKENhbmNlciRGZW1hbGVbal0pKm1lYW4oQ2FuY2VyJEZlbWFsZSkqTg0KYGBgDQoNCmBgYHtyfQ0KcmF0aW8udG90YWwNCmBgYA0KDQpgYGB7cn0NCnBhcnRkLm1lYW4gPSBtZWFuKENhbmNlciRNb3J0YWxpdHlbal0pDQpgYGANCg0KYGBge3J9DQpwYXJ0ZC5tZWFuDQpgYGANCg0KYGBge3J9DQpwYXJ0ZC50b3RhbCA9IHBhcnRkLm1lYW4qTg0KYGBgDQoNCmBgYHtyfQ0KcGFydGQudG90YWwNCmBgYA0KDQpgYGB7cn0NCmNhdCgnVGhlIGVzdGltYXRlcyBhcmUgY2xvc2UgYnV0IGJvdGggZXN0aW1hdGVzIGJhc2VkIG9uIHRoZSByYXRpbyBhcmUgbGFyZ2VyIHRoYW4gdGhlaXIgcGFydCAoZCkgY291bnRlcnBhcnRzLCByZXN1bHRpbmcgaW4gZXN0aW1hdGVzIGNsb3NlciB0byB0aGUgcG9wdWxhdGlvbiB2YWx1ZXMgXG4nKQ0KYGBgDQoNCg0K