Two ways tables

Tables thường được yêu cầu trình bày khi phân tích mối quan hệ giữa 2 biến số rời rạc (categorical variables).

Data về bệnh diabetes type 2 được sử dụng trong bài minh hoạ này.

library(stats)
library(tidyverse)
library("mlbench")
data("PimaIndiansDiabetes2")

Trước hết chúng ta tạo ra các biến số categorical từ các biến continuous.

[1] "pregnant" "glucose"  "pressure" "triceps"  "insulin"  "mass"    
[7] "pedigree" "age"      "diabetes"

Lập các bảng như sau.

table(df$agegr, df$outcome)
       
          0   1
  old   173 178
  young 327  90
table(df$preg, df$outcome)
              
                 0   1
  non-standard 189 155
  standard     311 113
# thêm cột sum
addmargins(table(df$agegr, df$outcome))
       
          0   1 Sum
  old   173 178 351
  young 327  90 417
  Sum   500 268 768
addmargins(table(df$preg, df$outcome))
              
                 0   1 Sum
  non-standard 189 155 344
  standard     311 113 424
  Sum          500 268 768
# tính phần trăm các ô
prop.table(table(df$agegr, df$outcome))
       
                0         1
  old   0.2252604 0.2317708
  young 0.4257812 0.1171875
prop.table(table(df$preg, df$outcome))
              
                       0         1
  non-standard 0.2460938 0.2018229
  standard     0.4049479 0.1471354

Three ways tables

Trong thực hành phân tích dữ liệu, nhiều trường hợp chúng ta phân tích mối quan hệ giữa 2 categorical variables nhưng có sự nghi ngờ bị ảnh hưởng bởi một biến số categorical khác. Hiện tượng này gọi là confounding hoặc interaction.

Để làm rõ sự ảnh hưởng của biến số thứ ba, chúng ta phải lập bảng có sự tham gia của 3 biến số đó. Sau đó phân tích và so sánh những RRs, ORs để xem chúng thay đổi, tác động đến 2 biến số ban đầu như thế nào.

Gọi là hiệu chỉnh về biến số thứ ba (adjusted for the third variables)

tb1 <- xtabs(~ agegr + outcome + preg, data = df)
ftable(tb1)
              preg non-standard standard
agegr outcome                           
old   0                     132       41
      1                     135       43
young 0                      57      270
      1                      20       70
prop.table(ftable(tb1))
              preg non-standard   standard
agegr outcome                             
old   0              0.17187500 0.05338542
      1              0.17578125 0.05598958
young 0              0.07421875 0.35156250
      1              0.02604167 0.09114583

Để tính RRs và ORs chúng ta cần thêm cột sum cho thuận lợi tính toán hơn, sử dụng hàm addmargins()

tb2 <- addmargins(tb1)
tb2
, , preg = non-standard

       outcome
agegr     0   1 Sum
  old   132 135 267
  young  57  20  77
  Sum   189 155 344

, , preg = standard

       outcome
agegr     0   1 Sum
  old    41  43  84
  young 270  70 340
  Sum   311 113 424

, , preg = Sum

       outcome
agegr     0   1 Sum
  old   173 178 351
  young 327  90 417
  Sum   500 268 768
prop.table(tb2, 1)
, , preg = non-standard

       outcome
agegr            0          1        Sum
  old   0.09401709 0.09615385 0.19017094
  young 0.03417266 0.01199041 0.04616307
  Sum   0.06152344 0.05045573 0.11197917

, , preg = standard

       outcome
agegr            0          1        Sum
  old   0.02920228 0.03062678 0.05982906
  young 0.16187050 0.04196643 0.20383693
  Sum   0.10123698 0.03678385 0.13802083

, , preg = Sum

       outcome
agegr            0          1        Sum
  old   0.12321937 0.12678063 0.25000000
  young 0.19604317 0.05395683 0.25000000
  Sum   0.16276042 0.08723958 0.25000000

Với kết quả ở trên chúng ta tính được RRs, ORs trong sự hiện diện hoặc không hiện diện của biến số thứ 3, trong ví dụ này là preg.

Nếu (RRcrude - RRadjusted)/RRadjusted >= 10 % thì chúng ta nói biến số thứ 3 là một confounder.

Cochran–Mantel–Haenszel Test cho 3-way table

mantelhaen.test(tb1)

    Mantel-Haenszel chi-squared test with continuity correction

data:  tb1
Mantel-Haenszel X-squared = 43.214, df = 1, p-value = 4.906e-11
alternative hypothesis: true common odds ratio is not equal to 1
95 percent confidence interval:
 0.1988202 0.4239000
sample estimates:
common odds ratio 
          0.29031 

p < 0.0001 cho thấy preg là một confounder

Reference: https://sphweb.bumc.bu.edu/otlt/mph-modules/bs/bs704-ep713_confounding-em/bs704-ep713_confounding-em_print.html

LS0tCnRpdGxlOiAiV29ya2luZyBXaXRoIFRhYmxlcyIKYXV0aG9yOiAiVGhpZXUgTmd1eWVuIgpkYXRlOiAiOS8yOC8yMDIxIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQpgYGAKCiMjIFR3byB3YXlzIHRhYmxlcwoKVGFibGVzIHRoxrDhu51uZyDEkcaw4bujYyB5w6p1IGPhuqd1IHRyw6xuaCBiw6B5IGtoaSBwaMOibiB0w61jaCBt4buRaSBxdWFuIGjhu4cgZ2nhu69hIDIgYmnhur9uIHPhu5EgcuG7nWkgcuG6oWMgKGNhdGVnb3JpY2FsIHZhcmlhYmxlcykuCgpEYXRhIHbhu4EgYuG7h25oIGRpYWJldGVzIHR5cGUgMiDEkcaw4bujYyBz4butIGThu6VuZyB0cm9uZyBiw6BpIG1pbmggaG/huqEgbsOgeS4KCmBgYHtyIH0KbGlicmFyeShzdGF0cykKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoIm1sYmVuY2giKQpkYXRhKCJQaW1hSW5kaWFuc0RpYWJldGVzMiIpCgpgYGAKClRyxrDhu5tjIGjhur90IGNow7puZyB0YSB04bqhbyByYSBjw6FjIGJp4bq/biBz4buRIGNhdGVnb3JpY2FsIHThu6sgY8OhYyBiaeG6v24gY29udGludW91cy4gCgoKYGBge3IgIGVjaG89RkFMU0V9CgpkZiA8LSBQaW1hSW5kaWFuc0RpYWJldGVzMgpuYW1lcyhkZikKCiMgdGhheSDEkeG7lWkgZ2nDoSB0cuG7iyBj4bunYSBiaeG6v24gc+G7kSBkaWFiZXRlcyB0aMOgbmggMCB2w6AgMQpkZiRvdXRjb21lW2RmJGRpYWJldGVzID09ICJuZWciXSA8LSAwCmRmJG91dGNvbWVbZGYkZGlhYmV0ZXMgPT0gInBvcyJdIDwtIDEKCiMgbmjDs20gdHXhu5FpCmRmJGFnZWdyW2RmJGFnZSA8PSAzMF0gPC0gInlvdW5nIgpkZiRhZ2VncltkZiRhZ2UgPiAzMF0gPC0gIm9sZCIKCiMgbmjDs25tIHbhu4Egc+G7kSBjb24gxJHDoyBzYW5oCmRmJHByZWdbZGYkcHJlZ25hbnQgPD0gM10gPC0gInN0YW5kYXJkIgpkZiRwcmVnW2RmJHByZWduYW50ID4gM10gPC0gIm5vbi1zdGFuZGFyZCIKYGBgCgpM4bqtcCBjw6FjIGLhuqNuZyBuaMawIHNhdS4KCmBgYHtyfQp0YWJsZShkZiRhZ2VnciwgZGYkb3V0Y29tZSkKdGFibGUoZGYkcHJlZywgZGYkb3V0Y29tZSkKCiMgdGjDqm0gY+G7mXQgc3VtCmFkZG1hcmdpbnModGFibGUoZGYkYWdlZ3IsIGRmJG91dGNvbWUpKQphZGRtYXJnaW5zKHRhYmxlKGRmJHByZWcsIGRmJG91dGNvbWUpKQojIHTDrW5oIHBo4bqnbiB0csSDbSBjw6FjIMO0CnByb3AudGFibGUodGFibGUoZGYkYWdlZ3IsIGRmJG91dGNvbWUpKQpwcm9wLnRhYmxlKHRhYmxlKGRmJHByZWcsIGRmJG91dGNvbWUpKQpgYGAKCiMjIFRocmVlIHdheXMgdGFibGVzCgpUcm9uZyB0aOG7sWMgaMOgbmggcGjDom4gdMOtY2ggZOG7ryBsaeG7h3UsIG5oaeG7gXUgdHLGsOG7nW5nIGjhu6NwIGNow7puZyB0YSBwaMOibiB0w61jaCBt4buRaSBxdWFuIGjhu4cgZ2nhu69hIDIgY2F0ZWdvcmljYWwgdmFyaWFibGVzIG5oxrBuZyBjw7Mgc+G7sSBuZ2hpIG5n4budIGLhu4sg4bqjbmggaMaw4bufbmcgYuG7n2kgbeG7mXQgYmnhur9uIHPhu5EgY2F0ZWdvcmljYWwga2jDoWMuIEhp4buHbiB0xrDhu6NuZyBuw6B5IGfhu41pIGzDoCBjb25mb3VuZGluZyBob+G6t2MKaW50ZXJhY3Rpb24uCgrEkOG7gyBsw6BtIHLDtSBz4buxIOG6o25oIGjGsOG7n25nIGPhu6dhIGJp4bq/biBz4buRIHRo4bupIGJhLCBjaMO6bmcgdGEgcGjhuqNpIGzhuq1wIGLhuqNuZyBjw7Mgc+G7sSB0aGFtIGdpYSBj4bunYSAzIGJp4bq/biBz4buRIMSRw7MuIFNhdSDEkcOzIHBow6JuIHTDrWNoIHbDoCBzbyBzw6FuaCBuaOG7r25nIFJScywgT1JzIMSR4buDIHhlbSBjaMO6bmcgdGhheSDEkeG7lWksIHTDoWMgxJHhu5luZyDEkeG6v24gMiBiaeG6v24gc+G7kSBiYW4gxJHhuqd1IG5oxrAgdGjhur8gbsOgby4KCkfhu41pIGzDoCBoaeG7h3UgY2jhu4luaCB24buBIGJp4bq/biBz4buRIHRo4bupIGJhIChhZGp1c3RlZCBmb3IgdGhlIHRoaXJkIHZhcmlhYmxlcykKCgoKYGBge3J9CnRiMSA8LSB4dGFicyh+IGFnZWdyICsgb3V0Y29tZSArIHByZWcsIGRhdGEgPSBkZikKZnRhYmxlKHRiMSkKcHJvcC50YWJsZShmdGFibGUodGIxKSkKYGBgCgrEkOG7gyB0w61uaCBSUnMgdsOgIE9ScyBjaMO6bmcgdGEgY+G6p24gdGjDqm0gY+G7mXQgc3VtIGNobyB0aHXhuq1uIGzhu6NpIHTDrW5oIHRvw6FuIGjGoW4sIHPhu60gZOG7pW5nIGjDoG0gYWRkbWFyZ2lucygpCgpgYGB7cn0KdGIyIDwtIGFkZG1hcmdpbnModGIxKQp0YjIKcHJvcC50YWJsZSh0YjIsIDEpCmBgYAoKVuG7m2kga+G6v3QgcXXhuqMg4bufIHRyw6puIGNow7puZyB0YSB0w61uaCDEkcaw4bujYyBSUnMsIE9ScyB0cm9uZyBz4buxIGhp4buHbiBkaeG7h24gaG/hurdjIGtow7RuZyBoaeG7h24gZGnhu4duIGPhu6dhIGJp4bq/biBz4buRIHRo4bupIDMsIHRyb25nIHbDrSBk4bulIG7DoHkgbMOgIHByZWcuCgpO4bq/dSAoUlJjcnVkZSAtIFJSYWRqdXN0ZWQpL1JSYWRqdXN0ZWQgPj0gMTAgJSB0aMOsIGNow7puZyB0YSBuw7NpIGJp4bq/biBz4buRIHRo4bupIDMgbMOgIG3hu5l0IGNvbmZvdW5kZXIuCgojIyMgQ29jaHJhbuKAk01hbnRlbOKAk0hhZW5zemVsIFRlc3QgY2hvIDMtd2F5IHRhYmxlCgpgYGB7cn0KbWFudGVsaGFlbi50ZXN0KHRiMSkKYGBgCgpwIDwgMC4wMDAxIGNobyB0aOG6pXkgcHJlZyBsw6AgbeG7mXQgY29uZm91bmRlciAKClJlZmVyZW5jZTogaHR0cHM6Ly9zcGh3ZWIuYnVtYy5idS5lZHUvb3RsdC9tcGgtbW9kdWxlcy9icy9iczcwNC1lcDcxM19jb25mb3VuZGluZy1lbS9iczcwNC1lcDcxM19jb25mb3VuZGluZy1lbV9wcmludC5odG1s