iPod Sales Problem

First, input data from 2-way table as variables and calculate total proportions for all sellers who disclose and all sellers who hide the problem:

TotalDisclose = 61
TotalHide = 158
n = 219
propDisclose = TotalDisclose/n
propHide = TotalHide/n
GroupSize = 73
gDisclose = 2
pDisclose = 23
nDisclose = 36
gHide = 71
pHide = 50
nHide = 37
obsCounts = matrix(c(gDisclose,pDisclose,nDisclose,gHide,pHide,nHide),nrow=2,ncol=3,byrow=TRUE)
obsCounts
     [,1] [,2] [,3]
[1,]    2   23   36
[2,]   71   50   37

1. Compute Expected counts

If we multiply the total number of observations in each group by the total proportion of sellers who disclose or hide the problem, we get the expected counts for each observation.

expgDisclose = propDisclose*GroupSize
exppDisclose = propDisclose*GroupSize
expnDisclose = propDisclose*GroupSize
expgHide = propHide*GroupSize
exppHide = propHide*GroupSize
expnHide = propHide*GroupSize
expCounts = matrix(c(expgDisclose,exppDisclose,expnDisclose,expgHide,exppHide,expnHide),nrow=2,ncol=3,byrow=TRUE)
expCounts
         [,1]     [,2]     [,3]
[1,] 20.33333 20.33333 20.33333
[2,] 52.66667 52.66667 52.66667

2. State Hypotheses

\(H_0\): Question asked and whether seller discloses the problem are independent, any differences in observed and expected counts are due to random chance. \(H_a\): Question asked and whether seller discloses problem are NOT independent, they are related in some way.

3. Assume \(H_0\), construct distribution for test statistic (\(\chi^2\) value)

Fact: If variables are independent (\(H_0\) true), \(\chi^2\) test statistic follows a \(\chi^2\) distribution with \[df = ((# explanatory variable categories)-1) * ((# response variable categories)-1)\] Explanatory Variable: question asked

  • # Categories = 3
  • df = 3-1 = 2

Response Variable: whether seller discloses problem

  • # Categories = 2
  • df = 2-1 = 1

A \(\chi^2\) distribution with df = 2 can be graphed using R-Studio:

curve(dchisq(x,df=2),from=0,to=50, xlab = expression(paste(chi^2," Values")),ylab="Frequency")

4. Compute Test Statistic (\(\chi^2\))

For each combination of explanatory and response variable, calculate a \(\chi^2\) value using this following equation: \[\frac{(observed-expected)^2}{expected}\]

XgDisclose = ((gDisclose-expgDisclose)^2)/expgDisclose
XgDisclose
[1] 16.53005
XpDisclose = ((pDisclose-exppDisclose)^2)/exppDisclose
XpDisclose
[1] 0.3497268
XnDisclose = ((nDisclose-expnDisclose)^2)/expnDisclose
XnDisclose
[1] 12.07104
XgHide = ((gHide-expgHide)^2)/expgHide
XgHide
[1] 6.381857
XpHide = ((pHide-exppHide)^2)/exppHide
XpHide
[1] 0.1350211
XnHide = ((nHide-expnHide)^2)/expnHide
XnHide
[1] 4.660338

If we add all of these values together, we get the \(\chi^2\) test statistic for this problem:

ChiSquare = XgDisclose+XpDisclose+XnDisclose+XgHide+XpHide+XnHide
ChiSquare
[1] 40.12803

5. Find p-value

Using the \(\chi^2\) value found in Step 4, we can calculate the probability of our sample data occurring by random chance under the assumption that \(H_0\) is true. This p-value is the area under the sample distribution at our test statistic or greater.

Using R-Studio’s ‘pchisq’ function, we can calculate the area under this curve at or above our test statistic.

1-pchisq(ChiSquare,df=2)
[1] 1.933339e-09

Our p-value is 1.93e-09.

6. Make Conclusions

  • Since \(p\approx0<\alpha=0.05\), we reject \(H_0\).
  • We conclude that question asked and whether a seller discloses the problem are NOT independent.
  • Question asked is related to whether the seller discloses the problem.
  • As long as the buyers were randomly assigned which question to ask, we can make a cause and effect conclusion:
    • Question asked causes a difference in number of sellers who disclose the problem with the product.

R-Studio can also calculate everything for us

First, create a matrix out of our 2-way table of observed counts:

ipodtable <- matrix(c(2,23,36,71,50,37),nrow=2,ncol=3,byrow=TRUE)
ipodtable
     [,1] [,2] [,3]
[1,]    2   23   36
[2,]   71   50   37

Run \(\chi^2\) Test

chisq.test(ipodtable,correct=FALSE)

    Pearson's Chi-squared test

data:  ipodtable
X-squared = 40.128, df = 2, p-value = 1.933e-09

This results in the same conclusion as before. The p-value and \(\chi^2\) value are also the same as what is calculated above.


Another Example

Let’s take another look at the stent study calculation:

prop.test(c(45,28),n=c(224,227),alternative="two.sided",conf.level=0.99,correct=FALSE)

    2-sample test for equality of proportions without continuity
    correction

data:  c(45, 28) out of c(224, 227)
X-squared = 4.9974, df = 1, p-value = 0.02539
alternative hypothesis: two.sided
99 percent confidence interval:
 -0.01142506  0.16651474
sample estimates:
   prop 1    prop 2 
0.2008929 0.1233480 

Returns a \(\chi^2\) value that can be used to make conclusions in the same way as iPod Sales problem. This function also returns a \(\chi^2\) value and when we calculate pchisq for that value, we get the same p-value.

Now let’s create a 2-way table with our stent study data:\n

stenttable <- matrix(c(45,28,179,199),nrow=2,ncol=2,byrow=TRUE)
stenttable
     [,1] [,2]
[1,]   45   28
[2,]  179  199

Now run the \(\chi^2\) test for independence

chisq.test(stenttable,correct = FALSE)

    Pearson's Chi-squared test

data:  stenttable
X-squared = 4.9974, df = 1, p-value = 0.02539

Returns the same values as previous prop.test. \(\chi^2\) Test for Independence and 2-proportion test can be interchangeable when there are 2 categories for 2 variables (like in the stent study). We would not be able to run a 2-proportion test for the iPod sales problem. If we have two categorical variables with two categories each, 2-sample z-test dpes tje same thing as a \(\chi^2\) test for independence.

LS0tCnRpdGxlOiAkXGNoaV4yJCBUZXN0IGZvciBJbmRlcGVuZGVuY2UKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyBpUG9kIFNhbGVzIFByb2JsZW0KRmlyc3QsIGlucHV0IGRhdGEgZnJvbSAyLXdheSB0YWJsZSBhcyB2YXJpYWJsZXMgYW5kIGNhbGN1bGF0ZSB0b3RhbCBwcm9wb3J0aW9ucyBmb3IgYWxsIHNlbGxlcnMgd2hvIGRpc2Nsb3NlIGFuZCBhbGwgc2VsbGVycyB3aG8gaGlkZSB0aGUgcHJvYmxlbTpcbgpgYGB7cn0KVG90YWxEaXNjbG9zZSA9IDYxClRvdGFsSGlkZSA9IDE1OApuID0gMjE5CnByb3BEaXNjbG9zZSA9IFRvdGFsRGlzY2xvc2Uvbgpwcm9wSGlkZSA9IFRvdGFsSGlkZS9uCkdyb3VwU2l6ZSA9IDczCmdEaXNjbG9zZSA9IDIKcERpc2Nsb3NlID0gMjMKbkRpc2Nsb3NlID0gMzYKZ0hpZGUgPSA3MQpwSGlkZSA9IDUwCm5IaWRlID0gMzcKb2JzQ291bnRzID0gbWF0cml4KGMoZ0Rpc2Nsb3NlLHBEaXNjbG9zZSxuRGlzY2xvc2UsZ0hpZGUscEhpZGUsbkhpZGUpLG5yb3c9MixuY29sPTMsYnlyb3c9VFJVRSkKb2JzQ291bnRzCmBgYAojIyAxLiBDb21wdXRlIEV4cGVjdGVkIGNvdW50cwpJZiB3ZSBtdWx0aXBseSB0aGUgdG90YWwgbnVtYmVyIG9mIG9ic2VydmF0aW9ucyBpbiBlYWNoIGdyb3VwIGJ5IHRoZSB0b3RhbCBwcm9wb3J0aW9uIG9mIHNlbGxlcnMgd2hvIGRpc2Nsb3NlIG9yIGhpZGUgdGhlIHByb2JsZW0sIHdlIGdldCB0aGUgZXhwZWN0ZWQgY291bnRzIGZvciBlYWNoIG9ic2VydmF0aW9uLgpgYGB7cn0KZXhwZ0Rpc2Nsb3NlID0gcHJvcERpc2Nsb3NlKkdyb3VwU2l6ZQpleHBwRGlzY2xvc2UgPSBwcm9wRGlzY2xvc2UqR3JvdXBTaXplCmV4cG5EaXNjbG9zZSA9IHByb3BEaXNjbG9zZSpHcm91cFNpemUKZXhwZ0hpZGUgPSBwcm9wSGlkZSpHcm91cFNpemUKZXhwcEhpZGUgPSBwcm9wSGlkZSpHcm91cFNpemUKZXhwbkhpZGUgPSBwcm9wSGlkZSpHcm91cFNpemUKZXhwQ291bnRzID0gbWF0cml4KGMoZXhwZ0Rpc2Nsb3NlLGV4cHBEaXNjbG9zZSxleHBuRGlzY2xvc2UsZXhwZ0hpZGUsZXhwcEhpZGUsZXhwbkhpZGUpLG5yb3c9MixuY29sPTMsYnlyb3c9VFJVRSkKZXhwQ291bnRzCmBgYAoKIyMgMi4gU3RhdGUgSHlwb3RoZXNlcwokSF8wJDogUXVlc3Rpb24gYXNrZWQgYW5kIHdoZXRoZXIgc2VsbGVyIGRpc2Nsb3NlcyB0aGUgcHJvYmxlbSBhcmUgKippbmRlcGVuZGVudCoqLCBhbnkgZGlmZmVyZW5jZXMgaW4gb2JzZXJ2ZWQgYW5kIGV4cGVjdGVkIGNvdW50cyBhcmUgZHVlIHRvIHJhbmRvbSBjaGFuY2UuXG4KJEhfYSQ6IFF1ZXN0aW9uIGFza2VkIGFuZCB3aGV0aGVyIHNlbGxlciBkaXNjbG9zZXMgcHJvYmxlbSBhcmUgKipOT1QgaW5kZXBlbmRlbnQqKiwgdGhleSBhcmUgcmVsYXRlZCBpbiBzb21lIHdheS5cbgoKIyMgMy4gQXNzdW1lICRIXzAkLCBjb25zdHJ1Y3QgZGlzdHJpYnV0aW9uIGZvciB0ZXN0IHN0YXRpc3RpYyAoJFxjaGleMiQgdmFsdWUpCioqRmFjdCoqOiBJZiB2YXJpYWJsZXMgYXJlIGluZGVwZW5kZW50ICgkSF8wJCB0cnVlKSwgJFxjaGleMiQgdGVzdCBzdGF0aXN0aWMgZm9sbG93cyBhICRcY2hpXjIkIGRpc3RyaWJ1dGlvbiB3aXRoCiQkZGYgPSAoKCMgZXhwbGFuYXRvcnkgdmFyaWFibGUgY2F0ZWdvcmllcyktMSkgKiAoKCMgcmVzcG9uc2UgdmFyaWFibGUgY2F0ZWdvcmllcyktMSkkJFxuCioqRXhwbGFuYXRvcnkgVmFyaWFibGUqKjogcXVlc3Rpb24gYXNrZWQKIAogLSAqIyBDYXRlZ29yaWVzKiA9IDMgXG4KIC0gKmRmKiA9IDMtMSA9IDIgXG4KCioqUmVzcG9uc2UgVmFyaWFibGUqKjogd2hldGhlciBzZWxsZXIgZGlzY2xvc2VzIHByb2JsZW0gCgogIC0gKiMgQ2F0ZWdvcmllcyogPSAyCiAgLSAqZGYqID0gMi0xID0gMQoKQSAkXGNoaV4yJCBkaXN0cmlidXRpb24gd2l0aCBkZiA9IDIgY2FuIGJlIGdyYXBoZWQgdXNpbmcgUi1TdHVkaW86ICAKYGBge3J9CmN1cnZlKGRjaGlzcSh4LGRmPTIpLGZyb209MCx0bz01MCwgeGxhYiA9IGV4cHJlc3Npb24ocGFzdGUoY2hpXjIsIiBWYWx1ZXMiKSkseWxhYj0iRnJlcXVlbmN5IikKYGBgCgojIyA0LiBDb21wdXRlIFRlc3QgU3RhdGlzdGljICgkXGNoaV4yJClcbgpGb3IgZWFjaCBjb21iaW5hdGlvbiBvZiBleHBsYW5hdG9yeSBhbmQgcmVzcG9uc2UgdmFyaWFibGUsIGNhbGN1bGF0ZSBhICRcY2hpXjIkIHZhbHVlIHVzaW5nIHRoaXMgZm9sbG93aW5nIGVxdWF0aW9uOiBcbgokJFxmcmFjeyhvYnNlcnZlZC1leHBlY3RlZCleMn17ZXhwZWN0ZWR9JCQKYGBge3J9ClhnRGlzY2xvc2UgPSAoKGdEaXNjbG9zZS1leHBnRGlzY2xvc2UpXjIpL2V4cGdEaXNjbG9zZQpYZ0Rpc2Nsb3NlClhwRGlzY2xvc2UgPSAoKHBEaXNjbG9zZS1leHBwRGlzY2xvc2UpXjIpL2V4cHBEaXNjbG9zZQpYcERpc2Nsb3NlClhuRGlzY2xvc2UgPSAoKG5EaXNjbG9zZS1leHBuRGlzY2xvc2UpXjIpL2V4cG5EaXNjbG9zZQpYbkRpc2Nsb3NlClhnSGlkZSA9ICgoZ0hpZGUtZXhwZ0hpZGUpXjIpL2V4cGdIaWRlClhnSGlkZQpYcEhpZGUgPSAoKHBIaWRlLWV4cHBIaWRlKV4yKS9leHBwSGlkZQpYcEhpZGUKWG5IaWRlID0gKChuSGlkZS1leHBuSGlkZSleMikvZXhwbkhpZGUKWG5IaWRlCmBgYApJZiB3ZSBhZGQgYWxsIG9mIHRoZXNlIHZhbHVlcyB0b2dldGhlciwgd2UgZ2V0IHRoZSAkXGNoaV4yJCB0ZXN0IHN0YXRpc3RpYyBmb3IgdGhpcyBwcm9ibGVtOiBcbgpgYGB7cn0KQ2hpU3F1YXJlID0gWGdEaXNjbG9zZStYcERpc2Nsb3NlK1huRGlzY2xvc2UrWGdIaWRlK1hwSGlkZStYbkhpZGUKQ2hpU3F1YXJlCmBgYAoKIyMgNS4gRmluZCBwLXZhbHVlClVzaW5nIHRoZSAkXGNoaV4yJCB2YWx1ZSBmb3VuZCBpbiAqU3RlcCA0Kiwgd2UgY2FuIGNhbGN1bGF0ZSB0aGUgcHJvYmFiaWxpdHkgb2Ygb3VyIHNhbXBsZSBkYXRhIG9jY3VycmluZyBieSByYW5kb20gY2hhbmNlIHVuZGVyIHRoZSBhc3N1bXB0aW9uIHRoYXQgJEhfMCQgaXMgdHJ1ZS4gVGhpcyBwLXZhbHVlIGlzIHRoZSBhcmVhIHVuZGVyIHRoZSBzYW1wbGUgZGlzdHJpYnV0aW9uIGF0IG91ciB0ZXN0IHN0YXRpc3RpYyBvciBncmVhdGVyLiAgCmBgYHtyIGVjaG89RkFMU0V9CmN1cnZlKGRjaGlzcSh4LGRmPTIpLGZyb209MCx0bz01MCwgeGxhYiA9IGV4cHJlc3Npb24ocGFzdGUoY2hpXjIsIiBWYWx1ZXMiKSkseWxhYj0iRnJlcXVlbmN5IikKcG9pbnRzKHg9Q2hpU3F1YXJlLHk9MCxjb2w9ImJsdWUiLHBjaD0yMCkKdGV4dChDaGlTcXVhcmUsMC4wNSxsYWJlbHMgPSAiVGVzdCBTdGF0aXN0aWMiLGNleD0wLjUsY29sPSJibHVlIikKYGBgClVzaW5nIFItU3R1ZGlvJ3MgJ3BjaGlzcScgZnVuY3Rpb24sIHdlIGNhbiBjYWxjdWxhdGUgdGhlIGFyZWEgdW5kZXIgdGhpcyBjdXJ2ZSBhdCBvciBhYm92ZSBvdXIgdGVzdCBzdGF0aXN0aWMuCmBgYHtyfQoxLXBjaGlzcShDaGlTcXVhcmUsZGY9MikKYGBgCk91ciBwLXZhbHVlIGlzIDEuOTNlLTA5LgoKIyMgNi4gTWFrZSBDb25jbHVzaW9ucwogIC0gU2luY2UgJHBcYXBwcm94MDxcYWxwaGE9MC4wNSQsIHdlIHJlamVjdCAkSF8wJC4gIAogIC0gV2UgY29uY2x1ZGUgdGhhdCBxdWVzdGlvbiBhc2tlZCBhbmQgd2hldGhlciBhIHNlbGxlciBkaXNjbG9zZXMgdGhlIHByb2JsZW0gYXJlICoqTk9UIGluZGVwZW5kZW50KiouIAogIC0gUXVlc3Rpb24gYXNrZWQgaXMgcmVsYXRlZCB0byB3aGV0aGVyIHRoZSBzZWxsZXIgZGlzY2xvc2VzIHRoZSBwcm9ibGVtLiAKICAtIEFzIGxvbmcgYXMgdGhlIGJ1eWVycyB3ZXJlIHJhbmRvbWx5IGFzc2lnbmVkIHdoaWNoIHF1ZXN0aW9uIHRvIGFzaywgd2UgY2FuIG1ha2UgYSBjYXVzZSBhbmQgZWZmZWN0IGNvbmNsdXNpb246IAogICAgLSBRdWVzdGlvbiBhc2tlZCBjYXVzZXMgYSBkaWZmZXJlbmNlIGluIG51bWJlciBvZiBzZWxsZXJzIHdobyBkaXNjbG9zZSB0aGUgcHJvYmxlbSB3aXRoIHRoZSBwcm9kdWN0LgoKLS0tCgojIyMgUi1TdHVkaW8gY2FuIGFsc28gY2FsY3VsYXRlIGV2ZXJ5dGhpbmcgZm9yIHVzCkZpcnN0LCBjcmVhdGUgYSBtYXRyaXggb3V0IG9mIG91ciAyLXdheSB0YWJsZSBvZiBvYnNlcnZlZCBjb3VudHM6XG4KYGBge3J9Cmlwb2R0YWJsZSA8LSBtYXRyaXgoYygyLDIzLDM2LDcxLDUwLDM3KSxucm93PTIsbmNvbD0zLGJ5cm93PVRSVUUpCmlwb2R0YWJsZQpgYGAKIyMjIyBSdW4gJFxjaGleMiQgVGVzdApgYGB7cn0KY2hpc3EudGVzdChpcG9kdGFibGUsY29ycmVjdD1GQUxTRSkKYGBgClRoaXMgcmVzdWx0cyBpbiB0aGUgc2FtZSBjb25jbHVzaW9uIGFzIGJlZm9yZS4gVGhlIHAtdmFsdWUgYW5kICRcY2hpXjIkIHZhbHVlIGFyZSBhbHNvIHRoZSBzYW1lIGFzIHdoYXQgaXMgY2FsY3VsYXRlZCBhYm92ZS4gCgotLS0KCiMgQW5vdGhlciBFeGFtcGxlCkxldCdzIHRha2UgYW5vdGhlciBsb29rIGF0IHRoZSBzdGVudCBzdHVkeSBjYWxjdWxhdGlvbjpcbgpgYGB7cn0KcHJvcC50ZXN0KGMoNDUsMjgpLG49YygyMjQsMjI3KSxhbHRlcm5hdGl2ZT0idHdvLnNpZGVkIixjb25mLmxldmVsPTAuOTksY29ycmVjdD1GQUxTRSkKYGBgClJldHVybnMgYSAkXGNoaV4yJCB2YWx1ZSB0aGF0IGNhbiBiZSB1c2VkIHRvIG1ha2UgY29uY2x1c2lvbnMgaW4gdGhlIHNhbWUgd2F5IGFzIGlQb2QgU2FsZXMgcHJvYmxlbS4gVGhpcyBmdW5jdGlvbiBhbHNvIHJldHVybnMgYSAkXGNoaV4yJCB2YWx1ZSBhbmQgd2hlbiB3ZSBjYWxjdWxhdGUgcGNoaXNxIGZvciB0aGF0IHZhbHVlLCB3ZSBnZXQgdGhlIHNhbWUgcC12YWx1ZS4gCgpOb3cgbGV0J3MgY3JlYXRlIGEgMi13YXkgdGFibGUgd2l0aCBvdXIgc3RlbnQgc3R1ZHkgZGF0YTpcbgpgYGB7cn0Kc3RlbnR0YWJsZSA8LSBtYXRyaXgoYyg0NSwyOCwxNzksMTk5KSxucm93PTIsbmNvbD0yLGJ5cm93PVRSVUUpCnN0ZW50dGFibGUKYGBgCgpOb3cgcnVuIHRoZSAkXGNoaV4yJCB0ZXN0IGZvciBpbmRlcGVuZGVuY2UgCmBgYHtyfQpjaGlzcS50ZXN0KHN0ZW50dGFibGUsY29ycmVjdCA9IEZBTFNFKQpgYGAKUmV0dXJucyB0aGUgc2FtZSB2YWx1ZXMgYXMgcHJldmlvdXMgcHJvcC50ZXN0LiAkXGNoaV4yJCBUZXN0IGZvciBJbmRlcGVuZGVuY2UgYW5kIDItcHJvcG9ydGlvbiB0ZXN0IGNhbiBiZSBpbnRlcmNoYW5nZWFibGUgd2hlbiB0aGVyZSBhcmUgMiBjYXRlZ29yaWVzIGZvciAyIHZhcmlhYmxlcyAobGlrZSBpbiB0aGUgc3RlbnQgc3R1ZHkpLiBXZSB3b3VsZCBub3QgYmUgYWJsZSB0byBydW4gYSAyLXByb3BvcnRpb24gdGVzdCBmb3IgdGhlIGlQb2Qgc2FsZXMgcHJvYmxlbS4KSWYgd2UgaGF2ZSB0d28gY2F0ZWdvcmljYWwgdmFyaWFibGVzIHdpdGggdHdvIGNhdGVnb3JpZXMgZWFjaCwgMi1zYW1wbGUgei10ZXN0IGRwZXMgdGplIHNhbWUgdGhpbmcgYXMgYSAkXGNoaV4yJCB0ZXN0IGZvciBpbmRlcGVuZGVuY2Uu