home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 16 / 016.d81 / fisher (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1985-01-01  |  10.1 KB  |  372 lines
  1. 10 rem
  2. 11 print"[147]"chr$(142):poke53281,0:poke53280,6
  3. 12 printspc(8)"loadstar 2x2 statistics":print""spc(9)"written by al vekovius
  4. 13 [153]" converted to the c-64 by alan gardner"
  5. 14 [153]""[166]12)"copyright 1985"
  6. 15 [153]"    loadstar is not public domain."
  7. 16 [153]"  please respect the author's rights."
  8. 17 [153]"        press a key to continue.":[151]198,0:[146]198,1:[161]r$
  9. 20 [137]500:nd[178]0
  10. 100 [143]   plot routine
  11. 110 [151]783,0:[151]781,vt:[151]782,ht
  12. 120 [158]65520
  13. 130 [142]
  14. 500 [143]   main menu
  15. 510 [153]"load":[151]53281,0:[151]53280,5
  16. 520 [153]"2x2 loadstar statistics"
  17. 530 [153]"1> input data"
  18. 540 [153]"2> view your data"
  19. 550 [153]"3> view expected values"
  20. 560 [153]"4> chi-square test"
  21. 570 [153]"5> fisher's exact test"
  22. 580 [153]"6> mcnemar's test"
  23. 581 [153]"7> see examples"
  24. 582 [153]"8> exit"
  25. 590 :
  26. 600 [153]"make a selection ";:[151]198,0:[146]198,1:[161]r$
  27. 605 [139]r$[179]"1"[176]r$[177]"8"[167][153]:[153]"onononon";:[151]53280,[187](1)[172]15:[137]600
  28. 606 [139]r$[178]"7"[167][141]8541:[137]700:[143]        save those values
  29. 607 [139]r$[178]"8"[167]20000
  30. 610 [145][197](r$)[141]7000,4500,8200,6000,4000,9500
  31. 620 [137]500
  32. 700 [143]   example menu
  33. 701 [153]"load":[153]"examples menu"
  34. 702 [153]"1.  example of chi-square test"
  35. 704 [153]"2.  example of fisher's test"
  36. 706 [153]"3.  example of mcnemar's test"
  37. 708 [153]"4.  return to main menu"
  38. 710 :
  39. 720 [153]"make a selection":[151]198,0:[146]198,1:[161]r$
  40. 721 [139]r$[179]"1"[176]r$[177]"4"[167][153]"onononon";:[151]53280,[187](1)[172]15:[137]720
  41. 730 [139]r$[178]"1"[167]flag[178]1:[141]1920:[137]12000
  42. 734 [139]r$[178]"2"[167]flag[178]2:[141]1910:[137]12000
  43. 736 [139]r$[178]"3"[167]flag[178]3:[141]1930:[137]12000
  44. 760 [141]8651:[141]7400:[141]8000:[141]8500
  45. 761 [143]  get values, margins, display values, save values
  46. 770 [137]500
  47. 900 :
  48. 1000 [143]  compute factorial
  49. 1005 [139]n[178]1[176]n[178]0[167]s[178]1:[137]1050
  50. 1010 s[178]1
  51. 1020 [129]k[178]2[164]n
  52. 1030 s[178]k[172]s
  53. 1040 [130]
  54. 1050 [142]
  55. 1090 :
  56. 1900 [143]   example
  57. 1910 b$[178]"fisher's exact example":x$(1)[178]"alive":x$(2)[178]"died"
  58. 1911 y$(1)[178]"gam glob":y$(2)[178]"pasteur":n(1,1)[178]11:n(1,2)[178]1:n(2,1)[178]2:n(2,2)[178]3
  59. 1912 [142]
  60. 1913 :
  61. 1920 b$[178]"chi-square example":x$(1)[178]"male":x$(2)[178]"female"
  62. 1921 y$(1)[178]"democrat":y$(2)[178]"republican":n(1,1)[178]15:n(1,2)[178]10:n(2,1)[178]7:n(2,2)[178]10
  63. 1922 [142]
  64. 1923 :
  65. 1930 b$[178]"mcnemar's test":x$(1)[178]"test2 +":x$(2)[178]"test2 -"
  66. 1931 y$(1)[178]"test1 +":y$(2)[178]"test1 -":n(1,1)[178]32:n(1,2)[178]10:n(2,1)[178]7:n(2,2)[178]26
  67. 1932 [142]
  68. 1933 :
  69. 1940 :
  70. 1999 [142]
  71. 2000 [143]   draw 2 x 2 table
  72. 2005 [153]"load"b$
  73. 2006 d$[178]""
  74. 2010 [129]i[178]6[164]19:[153][202](d$,1,i)[166]10)"peek";[166]10)"peek"[166]10)"peek"
  75. 2020 [130]
  76. 2030 [129]x[178]1[164]3:[153]"":[129]p[178]1[164]4[172]x[170]2:[153]"";:     [130]
  77. 2032 [153][166]9)"---------------------------"
  78. 2034 [130]
  79. 2040 [153]""y$(1)
  80. 2050 [153]""y$(2)
  81. 2060 [153]""x$(1)
  82. 2070 [153]""x$(2)
  83. 2080 [153]
  84. 2100 [142]
  85. 3000 vt[178]9:ht[178]14:[141]100
  86. 3002 [153]d(1,1);:ht[178]24:[141]100:[153]d(1,2);:ht[178]33:[141]100:[153]r(1)
  87. 3010 vt[178]13:ht[178]14:[141]100
  88. 3012 [153]d(2,1);:ht[178]24:[141]100:[153]d(2,2);:ht[178]33:[141]100:[153]r(2)
  89. 3020 vt[178]17:ht[178]14:[141]100
  90. 3022 [153]c(1);:ht[178]24:[141]100:[153]c(2);:ht[178]33:[141]100:[153]t
  91. 3090 [142]
  92. 3500 vt[178]9:ht[178]14:[141]100:[153]d(1,1):ht[178]24:[141]100:[153]""d(1,2)"wait";:ht[178]33:[141]100
  93. 3501 [153]r(1)
  94. 3510 vt[178]13:ht[178]14:[141]100:[153]""d(2,1)"wait":ht[178]24:[141]100:[153]d(2,2);:ht[178]33:[141]100
  95. 3511 [153]r(2)
  96. 3520 vt[178]17:ht[178]14:[141]100:[153]c(1);:ht[178]24:[141]100:[153]c(2):ht[178]33:[141]100:[153]t
  97. 3600 :
  98. 3999 [142]
  99. 4000 [143]  fisher's exact test
  100. 4001 [139]t[178]0[167][141]15000:[137]4110
  101. 4002 prob[178]0:tag[178]0
  102. 4005 [139]t[177]33[167][153]"load cannot compute this function with the"
  103. 4006 [139]t[177]33[167][153]""[166]12)"current data.":[129]dl[178]1[164]3000:[130]:[137]4100
  104. 4010 [141]5100
  105. 4020 [141]5000
  106. 4030 prob[178]prob[170]x[173]p
  107. 4035 b$[178]"fisher's exact test"
  108. 4039 tag[178]0
  109. 4040 [139]n(li,lj)[178]0[167][141]2000:[141]3000:x[178]prob:tag[178]1
  110. 4042 [139]tag[178]1[167]vt[178]20:ht[178]0:[141]100:[153]" p=";:[141]11000:
  111. 4043 [139]tag[178]1[167][153]"       press any key to continue":[151]198,0:[146]198,1
  112. 4044 [139]tag[178]1[167][161]r$:[153]:[137]4100
  113. 4050 [141]5200
  114. 4060 [137]4020
  115. 4100 [141]8600
  116. 4110 [142]
  117. 4200 :
  118. 4500 [143] view data
  119. 4501 [139]t[178]0[167][141]15000:[137]4540
  120. 4510 b$[178]"":[141]2000
  121. 4520 [141]3000
  122. 4530 [153]"       press a key to continue":[151]198,0:[146]198,1:[161]r$
  123. 4540 [142]
  124. 4600 :
  125. 5000 [143]  print fisher
  126. 5005 p[178]1
  127. 5010 [129]i[178]1[164]2:[129]j[178]1[164]2:n[178]n(i,j):[141]1000:p[178]p[172]s:[130]j,i
  128. 5020 [129]i[178]1[164]2
  129. 5030 n[178]c(i):[141]1000:cf(i)[178]s
  130. 5040 n[178]r(i):[141]1000:rf(i)[178]s
  131. 5050 [130]i
  132. 5060 n[178]t:[141]1000:tf[178]s
  133. 5070 x[178](cf(1)[172]cf(2)[173]tf)[172]rf(1)[172]rf(2)
  134. 5080 exact[178]x[173]p
  135. 5090 [142]
  136. 5095 :
  137. 5100 [143]  set up fisher
  138. 5105 m[178]9999
  139. 5110 [139]m[177]r(1)[167] m[178]r(1):x[178]1
  140. 5120 [139]m[177]r(2)[167] m[178]r(2):x[178]2
  141. 5130 [139]m[177]c(1)[167] m[178]c(1):x[178]3
  142. 5140 [139]m[177]c(2)[167] m[178]c(2):x[178]4
  143. 5150 [139]x[179]3[167]a1[178]n(x,1)[173]c(1):a2[178]n(x,2)[173]c(2)
  144. 5160 [139]x[177]2[167]a1[178]n(1,x[171]2)[173]r(1):a2[178]n(2,x[171]2)[173]r(2)
  145. 5170 [139]x[179]3[167]li[178]x:lj[178]1:[139]a2[179]a1[167]lj[178]2
  146. 5180 [139]x[177]2[167]lj[178]x[171]2:li[178]1:[139]a2[179]a1[167]li[178]2
  147. 5190 [142]
  148. 5195 :
  149. 5200 [143]  set up next pass fisher
  150. 5210 [129]i[178]1[164]2:[129]j[178]1[164]2
  151. 5230 [139]i[178]li[175]j[178]lj[167]n(i,j)[178]n(i,j)[171]1:[137]5290
  152. 5240 [139]i[179][177]li[175]j[179][177]lj[167]n(i,j)[178]n(i,j)[171]1:[137]5290
  153. 5250 n(i,j)[178]n(i,j)[170]1
  154. 5290 [130]j:[130]i
  155. 5300 [142]
  156. 5400 :
  157. 6000 [143] chi square and yates
  158. 6005 [139]t[178]0[167][141]15000:[137]6900
  159. 6006 b$[178]"chi-square test"
  160. 6010 cn[178]n(1,1)[172]n(2,2)[171]n(2,1)[172]n(1,2)
  161. 6020 yt[178][182](cn)[171]t[173]2
  162. 6030 prod[178]c(1)[172]c(2)[172]r(1)[172]r(2)
  163. 6040 csq[178]cn[174]2[172]t[173]prod
  164. 6050 yts[178]yt[174]2[172]t[173]prod
  165. 6060 [141]8000:[141]2000:[141]3000
  166. 6100 [153]"chi-square :"csq
  167. 6110 a[178]csq:[141]10000
  168. 6120 [153]a$
  169. 6125 [153]
  170. 6130 [153]"yates ="yts
  171. 6140 a[178]yts:[141]10000
  172. 6150 [153]a$
  173. 6160 [151]198,0:[146]198,1:[161]r$
  174. 6900 [153]:[142]
  175. 6999 :
  176. 7000 [143]   input data
  177. 7010 x$(1)[178]" col 1":x$(2)[178]" col 2":          y$(1)[178]" row 1":y$(2)[178]" row 2"
  178. 7020 [153]"load"
  179. 7025 [141]2000
  180. 7030 ht[178]10:vt[178]20:[141]100:[153]"do you want new labels"
  181. 7031 vt[178]21:ht[178]10:[141]100:[153]"for this table (y/n)";:
  182. 7032 [151]198,0:[146]198,1:[161]r$:[153]
  183. 7040 [139]r$[178]"y"[167][141]7300:[137]7020
  184. 7045 [139]r$[178]"n"[167]7200
  185. 7050 [153]"onononon";:[137]7032
  186. 7100 :
  187. 7200 [143]  get data values
  188. 7201 nd[178]1:vt[178]1:ht[178]1:[141]100:[153]"put your data in the appropriate cell"
  189. 7220 vt[178]9:ht[178]14:[141]100:[133]n$:n(1,1)[178][197](n$)
  190. 7230 vt[178]9:ht[178]24:[141]100:[133]n$:n(1,2)[178][197](n$)
  191. 7240 vt[178]13:ht[178]14:[141]100:[133]n$:n(2,1)[178][197](n$)
  192. 7250 vt[178]13:ht[178]24:[141]100:[133]n$:n(2,2)[178][197](n$)
  193. 7260 vt[178]18:ht[178]10:[141]100:[153]"satisfied (y/n)";:[151]198,0:[146]198,1:[161]r$
  194. 7270 [139]n(1,1)[177]16[176]n(1,2)[177]16[176]n(2,1)[177]16[176]n(2,2)[177]16[167][141]16000:[137]7000
  195. 7272 [139]n(1,1)[179]0[176]n(1,2)[179]0[176]n(2,1)[179]0[176]n(2,2)[179]0[167][141]17000:[137]7000
  196. 7275 [141]7400:[141]8000:[141]8100
  197. 7288 [141]8500
  198. 7290 [142]
  199. 7295 :
  200. 7300 [143]  input labels
  201. 7310 [153]"load"
  202. 7320 [133] "label for row 1 ";y$(1):[139][195](y$(1))[177]8[167]y$(1)[178][200](y$(1),8)
  203. 7330 [133] "label for row 2 ";y$(2):[139][195](y$(2))[177]8[167]y$(2)[178][200](y$(2),8)
  204. 7340 [133] "label for col 1 ";x$(1):[139][195](x$(1))[177]8[167]x$(1)[178][200](x$(1),8)
  205. 7350 [133] "label for col 2 ";x$(2):[139][195](x$(2))[177]8[167]x$(2)[178][200](x$(2),8)
  206. 7360 [142]
  207. 7390 :
  208. 7400 [143]  calculate margins
  209. 7405 r(1)[178]n(1,1)[170]n(1,2):r(2)[178]n(2,1)[170]n(2,2)
  210. 7410 c(1)[178]n(1,1)[170]n(2,1):c(2)[178]n(1,2)[170]n(2,2)
  211. 7420 t[178]c(1)[170]c(2)
  212. 7499 [142]
  213. 7500 :
  214. 8000 [143]  get display values
  215. 8010 [129]i[178]1[164]2:[129]j[178]1[164]2:d(i,j)[178]n(i,j):[130]j,i
  216. 8020 [142]
  217. 8030 :
  218. 8100 [143]   expected values
  219. 8105 ex[178]0
  220. 8110 b$[178]"expected values"
  221. 8120 [129]i[178]1[164]2:[129]j[178]1[164]2
  222. 8130 e(i,j)[178]r(i)[172]c(j)[173]t:e(i,j)[178][181](e(i,j)[172]100[170].5)[173]100
  223. 8135 [139]e(i,j)[179]5[167]ex[178]1
  224. 8140 [130]j,i
  225. 8150 [142]
  226. 8160 :
  227. 8200 [143]  print expected values
  228. 8205 [139]t[178]0[167][141]15000:[137]8280
  229. 8230 [129]i[178]1[164]2:[129]j[178]1[164]2:d(i,j)[178]e(i,j):[130]j,i
  230. 8240 [141]2000
  231. 8245 [141]3000
  232. 8250 [139]ex[178]1[167]vt[178]20:ht[178]0:[141]100
  233. 8251 [139]ex[178]1[167][153]"you have an expected values less than 5"
  234. 8260 [153]"       press a key to continue":[151]198,0:[146]198,1:[161]r$:[153]
  235. 8270 [141]8000
  236. 8280 [142]
  237. 8300 :
  238. 8500 [143]   hold values
  239. 8510 [129]i[178]1[164]2:[129]j[178]1[164]2
  240. 8520 t(i,j)[178]n(i,j)
  241. 8530 [130]j,i
  242. 8540 [142]
  243. 8541 [143]   hold values for examples
  244. 8542 [129]i[178]1[164]2:[129]j[178]1[164]2
  245. 8543 l(i,j)[178]n(i,j)
  246. 8544 [130]j,i
  247. 8545 l1$[178]y$(1):l2$[178]y$(2):l3$[178]x$(1):l4$[178]x$(2)
  248. 8546 [142]
  249. 8550 :
  250. 8600 [143]   retrieve values
  251. 8610 [129]i[178]1[164]2:[129]j[178]1[164]2
  252. 8620 n(i,j)[178]t(i,j)
  253. 8630 [130]j,i
  254. 8640 [142]
  255. 8650 :
  256. 8651 [143]   retrieve values for examples
  257. 8652 [129]i[178]1[164]2:[129]j[178]1[164]2
  258. 8653 n(i,j)[178]l(i,j)
  259. 8654 [130]j,i
  260. 8655 y$(1)[178]l1$:y$(2)[178]l2$:x$(1)[178]l3$:x$(2)[178]l4$
  261. 8656 [142]
  262. 8700 :
  263. 9000 [143]  corr binomial prob
  264. 9010 m1[178]n(1,2):m2[178]n(2,1):m3[178]m1[170]m2
  265. 9020 lt[178]m1
  266. 9030 [139]m2[179]m1[167]lt[178]m2
  267. 9040 bi[178]1
  268. 9045 [139]lt[178]0[167]9110
  269. 9050 n[178]m3:[141]1000:m4[178]s
  270. 9060 [129]j[178]1[164]lt
  271. 9070 n[178]j:[141]1000:jf[178]s
  272. 9080 n[178]m3[171]j:[141]1000:js[178]s
  273. 9090 bi[178]bi[170]m4[173](jf[172]js)
  274. 9100 [130]j
  275. 9110 bi[178]bi[173]2[174]m3
  276. 9120 [142]
  277. 9130 :
  278. 9500 [143]  mcnemar's test
  279. 9505 [139]t[178]0[167][141]15000:[137]9550
  280. 9510 mc[178](n(1,2)[171]n(2,1))[174]2[173](n(1,2)[170]n(2,1))
  281. 9520 mc[178][181](mc[172]10000[170].5)[173]10000:a[178]mc:[141]10000
  282. 9525 b$[178]"mcnemar's test"
  283. 9530 [141]2000:[141]3000:vt[178]20:ht[178]0:[141]100:[153]"chi square ="mc:[153]a$
  284. 9535 [141]9000:[153]"one tail binomial prob. =";:x[178]bi:[141]11000
  285. 9540 [151]198,0:[146]198,1:[161]r$:[153]
  286. 9550 [142]
  287. 9600 :
  288. 10000 [143]  chi square table df=1
  289. 10010 a$[178]"not significant at .05 level"
  290. 10020 [139]a[177]3.84[167]a$[178]"significant at the .05 level"
  291. 10030 [139]a[177]5.02[167]a$[178]"significant at the .025 level"
  292. 10040 [139]a[177]6.63[167]a$[178]"significant at the .010 level"
  293. 10050 [139]a[177]7.88[167]a$[178]"significant at the .005 level"
  294. 10060 [139]a[177]10.8[167]a$[178]"significant at the .0001 level"
  295. 10070 [142]
  296. 10080 :
  297. 11000 [143]   print routine
  298. 11005 [153]".";
  299. 11010 [129]i[178]1[164]6
  300. 11020 x[178]10[172]x:xx[178][181](x):s$[178][196](xx):s$[178][202](s$,2):x[178]x[171]xx
  301. 11030 [153]s$;
  302. 11040 [130]
  303. 11050 [153]
  304. 11060 [142]
  305. 11070 :
  306. 12000 [143]  example of fisher
  307. 12003 [141]8500: [143]   save values
  308. 12005 [153]"load":[139]flag[179][177]2[167]12020
  309. 12010 [153][163]4)"an example of fisher's exact test"
  310. 12012 [153]"  seventeen persons had been bitten in  the head or neck by the same";
  311. 12013 [153]" rabid wolf in iran (bull. world health organ.1955).
  312. 12014 print"  the standard pasteur vaccine treatmentwas given.  in addition, 12";
  313. 12015 print" persons alsoreceived one or more doses of antirabies";
  314. 12016 print"gamma globulin.  the results are summar-ized as follows:"
  315. 12018 vt=23:ht=5:gosub100:print"press any key to continue";:poke198,0:wait198,1
  316. 12019 getr$:goto12050
  317. 12020 ifflag<>1then12031
  318. 12021 printtab(5)"an example of chi-square test":print"  suppose that 42 people are";
  319. 12022 print" called at  random to determine whether there is anyrelationship";
  320. 12023 print" between a person's sex and whether he will vote democratic or  "
  321. 12024 print"republican in the next electon.":print"results are as follows:  of the 25"
  322. 12025 print"men contacted, 15 will vote democratic  and 10 will vote republican."
  323. 12026 print"of the 17 women contacted, 7 will vote  democratic[160]and 10 will vote";
  324. 12027 print" republican.":print"  the question is whether there is a    difference";
  325. 12028 print" between males and females    based on the findings represented."
  326. 12029 vt=24:ht=5:gosub100:print"press any key to continue";:poke198,0:wait198,1
  327. 12030 getr$:goto12050
  328. 12031 printtab(6)"an example of mcnemar's test":print"  suppose that two diagnostic";
  329. 12032 print" tests are both applied to 75 men.":print"when the tests do not agree,";
  330. 12033 print" do they do so in the same way?  that is, do the"
  331. 12034 print"cases when test 1 is positive and test 2"
  332. 12035 print"[145]is negative occur in equal numbers to   the cases when test 1 is";
  333. 12036 print" negative and   test 2 is positive?"
  334. 12038 vt=23:ht=5:gosub100:print"press any key to continue":poke198,0:wait198,1
  335. 12039 getr$
  336. 12050 gosub8000:gosub7400:gosub2000
  337. 12052 ifflag=3thengosub3500:goto12070
  338. 12055 gosub3000
  339. 12070 vt=23:ht=1:gosub100:print"press a key to examine expected values"
  340. 12072 poke198,0:wait198,1:getr$:gosub8105
  341. 12080 fori=1to2:forj=1to2:d(i,j)=e(i,j):nextj,i
  342. 12090 gosub2000:gosub3000
  343. 12100 ifflag=2thenprint:print"since at least one expected value is    less than 5, ";
  344. 12101 ifflag=2thenprint" chi-square is not valid.  fisher's exact test is the";
  345. 12102 ifflag=2thenprint" test to use."
  346. 12110 vt=23:ht=5:gosub100:print"press any key to continue":poke198,0:wait198,1
  347. 12111 getr$:
  348. 12120 ifflag=2thengosub8000:gosub4000:goto12200
  349. 12130 ifflag=1thengosub6000:goto12200
  350. 12140 gosub9500
  351. 12200 goto700
  352. 15000 rem   no data entered yet!
  353. 15005 print"[147] sorry! there is no data entered yet.."
  354. 15010 print"please press a key"
  355. 15020 poke198,0:wait198,1:getr$
  356. 15030 return
  357. 16000 rem   values to big
  358. 16010 print"[147]       your values are too big..."
  359. 16012 print"     please keep them less than 16."
  360. 16020 print"  press a key to re-enter the values."
  361. 16030 poke198,0:wait198,1:getr$
  362. 16040 return
  363. 17000 rem   values to small
  364. 17020 print"[147]      no negative values please..."
  365. 17030 print"  press a key to re-enter the values."
  366. 17040 poke198,0:wait198,1:getr$
  367. 17050 return
  368. 20000 rem   return to ls
  369. 20010 print"[147]load"chr$(34)"hello"chr$(34)",8":print"run"
  370. 20020 poke631,13:poke632,13:poke198,2:
  371. 20030 end
  372.